#! /usr/local/bin/perl

use strict;

BEGIN {
   *gettimeofday = eval { require Time::HiRes } ?
       \&Time::HiRes::gettimeofday :
       sub { (time, 0) };
}

use Getopt::Long;
Getopt::Long::config qw(bundling no_getopt_compat);

my( $opt, @opt, %opt, @kill );
sub opt($$) { push @opt, "-$_[0]$_[1]" }
sub p_args { for( $ENV{"P_ARGS_$_[0]"} ) { defined or die "$0: \$P_ARGS_$_[0] not set\n"; push @ARGV, split } }

GetOptions \%opt,
   qw'a b=s C d D=f e E f F I j k+ l L N P S T v w W',
   'i' => sub { push @opt, '-u', $< },
   'K=s' => \@kill,
   'o=s' => sub { push @opt, ($_[1] =~ /\bpid\b/) ? "-o$_[1]" : "-opid,$_[1]" },
   'p=s' => \&opt,
   'r' => sub { push @opt, '-uroot' },
   't=s' => \&opt,
   'u=s' => \&opt,
   0  => sub { push @ARGV, '-fwdD0' },
   1  => sub { push @ARGV, '-fwd' },
   2  => sub { push @ARGV, '-fFw' },
   map( ($_ => \&p_args), 3..9 ),

   'help|?' => sub { print STDERR <<'EOF'; exit };
usage: p[ -aefIjlLrkdv -o<opt> -u<user> -p<pid> -t<tty> -K<sig> -D<seconds> -b<bsdopt>][ regexp ...]
   -i  show my processes
   -r  show root processes
   -k  kill, repeat suppresses question
   -K  kill with signal, can be repeated and -k suppresses question
   -C  sorted by CPU
   -E  sorted by executing command
   -F  sorted by father process, shown as a tree, can be combined with other sort
   -I  sorted by process ID
   -N  sorted by nice
   -P  sorted by prio
   -S  sorted by size
   -T  sorted by start time
   -d  diff (default: every second)
   -D  diff or loop time interval
   -v  vice versa, show processes not matching regexps
   -b  call bsd/ucb ps with bsd options
   -w  cut to $COLUMNS (default 132)
   -0  -fwdD0 (0secs)
   -1  -fwd (1sec)
   -2  -fFw (tree 2 width)
   -3..-9 $P_ARGS_3..$P_ARGS_9
EOF

push @opt, "-$opt"
   if $opt = join '', grep $opt{$_}, qw'a e f j l L';
my $optD = defined( $opt{D} ) ? $opt{D} : 1;
$opt{w} &&= $ENV{COLUMNS} || 132 and $ENV{COLUMNS} = $opt{w} + 4; # Gnu ps does less than COLUMNS :-(

my $re = 0;
if( @ARGV ) {
   local $" = '|';
   $re = qr/@ARGV/;
}

my $linux = 'linux' eq $^O;

my( $pidcol, $ppidcol, $delcol, $sortcol, $cmdcol, @ps, %prefix );
my $cmd = 'ps';
if( $opt{b} ) {
   $cmd = '/usr/ucb/ps' unless $linux;
   @opt = $linux ? $opt{b} : "-$opt{b}";
}

sub outputlist {
   if( $opt{F} ) {
       my( $thread, @ret, %val, %father, %children ) = ('a', '');
       for( @ps ) {
           my $pid = int substr $_, $pidcol;
           my $ppid = int substr $_, $ppidcol;
           $pid .= $thread++
               if exists $val{$pid};   # Multiple threads can have same pid.
           $val{$pid} = $_;
           next if $pid == $ppid;      # On many systems 0 has a father 0.
           $father{$pid} = $ppid;
           $children{$ppid} ||= [];
           push @{$children{$ppid}}, $pid;
       }
       my $children;
       $children = sub {
           my( $mark, @ps ) = @_;
           my $n = @ps;
           for( $sortcol > 0 ? sort { substr( $val{$a}, $sortcol ) cmp substr $val{$b}, $sortcol } @ps : sort { $val{$a} cmp $val{$b} } @ps ) {
               --$n;
               substr( $val{$_}, $cmdcol, 0 ) = substr( $mark, 0, -2 ).'+ ' if $mark;
               push @ret, $opt{d} ? substr( $val{$_}, -2 ) . substr( $val{$_}, 0, -2 ) : $val{$_};
               if( $children{$_} && @{$children{$_}} ) {
                   substr( $mark, -2, 1 ) = $n ? '|' : ' ' if $mark;
                   &$children( "$mark| ", @{$children{$_}} );
               }
           }
       };
       &$children( '', grep !exists( $val{$father{$_}} ), keys %val );
       @ret;
   } elsif( $opt{d} ) {
       map substr( $_, -2 ) . substr( $_, 0, -2 ),
           $sortcol > 0 ? sort { substr( $a, $sortcol ) cmp substr $b, $sortcol } @ps : sort @ps;
   } else {
       $sortcol > 0 ? sort { substr( $a, $sortcol ) cmp substr $b, $sortcol } @ps : sort @ps;
   }
}

sub output {
   if( $opt{w} ) {
       join '', map { $opt{w} < length && substr $_, $opt{w}, -1, ''; $_ } &outputlist;
   } else {
       join '', &outputlist;
   }
}

my( $lastoutput, @otime, @time, $odelta, $head, $ok, $pid, %oldps ) = '';

$odelta = 0, @otime = gettimeofday if $optD;
AGAIN:
# 5.8.0: my $ps = open PS, '-|', $cmd, @opt;
my $ps = open PS, '-|' or
   exec $cmd, @opt;

AGAIN0:
my $found = 2;
if( @time ) {
   <PS>;
} else {
   $head = <PS>;
   $delcol = index $head, ' C ';
   # This is a heuristic for wide PIDs, on such a system ours is likely greater
   $pidcol = index $head, $$ > 32767 ? '    PID' : '  PID';
   $ppidcol = index $head, $$ > 32767 ? '   PPID' : ' PPID' if $opt{F};
   $head =~ s/ C //;
   $cmdcol = index $head, 'CMD';
   $cmdcol = index $head, 'COMMAND' if $cmdcol == -1;
   $sortcol =
       $opt{E} ? $cmdcol :
       $opt{I} ? $pidcol :
       index $head,
           $opt{C} ? ($linux ? '    TIME' : ' TIME') :
           $opt{T} ? ($linux ? 'STIME' : '   STIME') :
           $opt{W} ? ($linux ? 'WCHAN' : '   WCHAN') :
           $opt{S} ? ($linux ? 'DR SZ ' : '    SZ') :
           $opt{P} ? ' PRI ' :
           $opt{N} ? ' NI ' : '';
   die "p: requested sort column not found\n" if $sortcol < 0;
}
@ps = grep {
   $ok = 1;
   s! inet(/\d+)!" in$1" . (' ' x (5 - length $1))!e;
   if( $found ) {
       $pid = int substr $_, $pidcol;
       $found--, $ok = 0 if $pid == $$ || $pid == $ps;
   }
   $ok = $opt{v} ? ($_ !~ $re) : ($_ =~ $re)
       if $re && $ok;
   substr( $_, $delcol, 3 ) = '' if $ok && $delcol > 0;
   unless( $linux ) {
       # move time which overlaps into the command field forward
       my $cor = $cmdcol - 1;
       s/^(.{$cor}([:\d]+))/ my $s = $1; $cor = ' ' x length $2; $s =~ s!(.*)$cor!$1!; $s /e;
   }
   $ok;
} <PS>;

if( $opt{d} || defined $opt{D} ) {
   close PS;
   if( !$optD ) {              # on 0 delay fire next subprocess asap
       $ps = open PS, '-|' or
           exec $cmd, @opt;
   }
   if( $opt{d} ) {
       my %ps;
       $ps{int substr $_, $pidcol} = $_
           for @ps;
       if( %oldps ) {          # previous round output something
           my $prevpid = -1;
           @ps = ();
           for( sort { $a <=> $b } keys %ps, keys %oldps ) {
               next if $prevpid == $_;
               if( $ps{$_} ) {
                   next if $ps{$_} eq $oldps{$_};
                   # Tack prefix onto end, to keep columns straight, fix it in output.
                   push @ps, $ps{$_} . ($oldps{$_} ? '  ' : '+ ');
               } else {
                   push @ps, "$oldps{$_}- ";
               }
               $prevpid = $_;
           }
       } else {
           $_ .= '  ' for @ps;
       }
       if( @ps ) {
           if( @time ) {
               printf '*** ' . substr( localtime $time[0], 4, 15 ) . ".%06d ***\n%s", $time[1], &output;
           } else {
               print '  ' . $head . &output;
           }
       }
       %oldps = %ps;
   } elsif( @ps ) {            # found some
       my $output = &output;
       if( $output ne $lastoutput ) {
           if( @time ) {
               printf '*** ' . substr( localtime $time[0], 4, 15 ) . ".%06d ***\n%s", $time[1], $output;
           } else {
               print $head . $output;
           }
           $lastoutput = $output;
       }
   }
   if( $optD ) {
       $odelta += $optD;       # Calculate delta against otime, so as to not cumulate imprecision.
       @time = gettimeofday;
       select undef, undef, undef, $odelta + $otime[0] - $time[0] + ($otime[1] - $time[1]) / 1_000_000;
       @time = gettimeofday;
       goto AGAIN;
   } else {
       @time = gettimeofday;
       goto AGAIN0;
   }
}

exit unless @ps;

# normal single shot operation
print $head . &output;

if( $opt{k} || @kill ) {
   my @pids = map { int substr $_, $pidcol } @ps;
   my $kill = ($opt{k} > 1 or $opt{k} && @kill);
   unless( $kill ) {
       local $| = 1;
       $kill = join ' -', '', @kill;
       print "kill$kill @pids? ";
       $kill = (<STDIN> =~ /^[jy]/); # Esperanto and English
   }
   if( $kill ) {
       @kill = 15 unless @kill;
       kill $_ => @pids for @kill;
       goto AGAIN;
   }
}

__END__

=head1 ps wrapper

=over 4

=item *

adapts to various variants of ps (tested on Linux, Solaris, AIX, HP/UX &
Reliant Unix)

=item *

sorts by pid or other column you specify

=item *

allows killing the selected processes with any signal

=item *

eliminates itself and ps process from output

=item *

options for all own (-i) or root's (-r) processes

=item *

allows grepping processes (optionally inversely) with Perl regexps

=item *

father mode (-F) for showing a process tree

=item *

eliminates C column, which is by definition useless

=item *

loop mode repeatedly outputs every n (fractional) seconds, specially optimized
for 0 seconds to loop as fast as possible -- interesting when grepping for
running and/or runnable processes

=item *

loop mode with diff to previous output allows tracking processes as they appear
(+) and dissapear (-) or change in some dispayed parameter

=back

=begin CPAN

=head1 README

B<ps wrapper>
B<�� >sort by pid or other column
B<�� >skip self and ps
B<�� >grep (-v)
B<�� >tree
B<�� >can kill selected processes
B<�� >loop mode (with diff)

=pod SCRIPT CATEGORIES

UNIX/System_administration

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.