#!/usr/bin/perl
# perl ps alike
# testing for nabou 1.5 or higher.
#
# (c) 2000   Thomas Linden <tom@daemon.de>
#
# $Id$


use Data::Dumper;
my $ps = new PS;
my @array;


my $arg = shift;
if ($arg =~ /^\-*he*l*p*$/) {
  print qq(
Perl PS. Shows what /bin/ps hides.
Usage: $0 [--help] [pid]

description of fields:
 PID   Process ID
 RUID  Real User ID
 EUID  Effective User ID
 RGID  Real Group ID
 EGID  Effective Group ID
 FH    Number of open filehandles
 TTY   The tty connected (0 if detached)
 EXE   Absolute filename of executed program
 CMD   \@ARGV of the program, as seen by /bin/ps

  COPYRIGHT (c) 2000 Thomas Linden <tom\@daemon.de>.
ALL RIGHTS RESERVED. NO WARRANTY. USE AT YOUR OWN RISK.
);
  exit;
}
else {
  foreach my $prc ($ps->get) {
    if ($prc->pid eq $arg) {
      print Dumper($prc);
      exit;
    }
  }
}


format STDOUT_TOP =
PID    RUID  EUID  RGID  EGID    FH TTY EXE                        CMD
-------------------------------------------------------------------------------------------------
.

format STDOUT =
@<<<< @>>>> @>>>> @>>>> @>>>> @>>>> @>> @<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@array
.

foreach my $prc ($ps->get) {
  @array = ($prc->pid, $prc->uid, $prc->euid, $prc->gid, $prc->egid, $prc->fdnum, $prc->tty, $prc->exe, $prc->cmdline);
  write;
}












################################

package Process;

sub new {
  my($this) = shift;
  my %properties = @_;
  my $class = ref($this) || $this;
  my $self = \%properties;
  bless($self,$class);
  return $self;
}

sub fd {
  my($this) = shift;
  return %{$this->{fd}};# if($this->{fdnum} > 0);
}


sub AUTOLOAD {
   my($this) = shift;
   my $SUB = $Process::AUTOLOAD;  # get to know how we were called
   $SUB =~ s/.*:://;              # remove package name!
   return (exists $this->{$SUB}) ? $this->{$SUB} : "";
}

1;




#################################

package PS;

use Data::Dumper;

sub new {
  my($this) = @_;
  my $class = ref($this) || $this;
  my $self = {};
  bless($self,$class);
  $self->gather();
  return $self;
}



sub gather {
  my($this) = @_;
  my @stat = qw(pid comm state ppid pgrp session tty tpgid flags minflt cminflt majflt
		cmajflt utime stime cutime cstime counter priority timeout itrealvalue
		starttime vsize rss rlim startcode endcode startstack kstkesp kstkeip
		signal blocked sigignore sigcatch wchan nswap cnswap exit_signal unknown);
  #                                                       does anybody know?     ^^^^^^^ !
  opendir PROC, "/proc" or die "proc filesystem not supported!\n";
  while (my $pid = readdir(PROC)) {
    next if($pid !~ /^\d\d*$/); # must be a number!
    chdir "/proc/$pid";
    $this->{cwd} = "/proc/$pid";
    my %prop;
    my @stats = split/ /, $this->read("stat");

    my $pos = 0;
    %prop = map { $stat[$pos++] => $_; } @stats;
    $prop{cmdline} = $this->read("cmdline");
    $prop{exe}     = readlink("exe");
    $prop{cwd}     = readlink("cwd");
    open STATUS, "< status" or die $!;
    while (<STATUS>) {
      chomp;
      if (/^Uid:\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)/) {
	$prop{uid}  = $1; # real      uid
	$prop{euid} = $2; # effective uid
	$prop{suid} = $3; # saved     uid
	$prop{fuid} = $4; # file      uid
      }
      if (/^Gid:\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)/) {
	$prop{gid}  = $1;
	$prop{egid} = $2;
	$prop{sgid} = $3;
	$prop{fgid} = $4;
      }
    }
    close STATUS;
    opendir FD, "fd";
    while (my $fh = readdir(FD)) {
      next if($fh =~ /^\.+?$/);
      $prop{fdnum}++;
      $prop{fd}->{$fh} = readlink("fd/$fh");
    }
    closedir FD;
    my $prc = new Process(%prop);
    push @{$this->{processes}}, $prc;
  }
  closedir PROC;
}


sub read {
  my($this, $file) = @_;
  open FILE, "< $this->{cwd}/$file" or die $!;
  local $/ = undef;
  my $inhalt = <FILE>;
  close FILE;
  chomp $inhalt;
  return $inhalt;
}


sub get {
  my($this) = @_;
  return @{$this->{processes}};
}

1;

########################################################
