#! /usr/local/bin/perl

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

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

sub opt($$) { push @opt, "-$_[0]$_[1]" }

GetOptions \%opt,
    qw'a b=s C d D=i e f F j k+ l L N P S T v W',
    'I' => sub { push @opt, '-u', $ENV{LOGNAME} || $ENV{USER} },
    '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,

    'help|?' => sub { print STDERR <<'EOF'; exit };
usage: p[ -aefIjlLrkdv -o<opt> -u<user> -p<pid> -t<tty> -K<sig> -D<seconds> -b<bsdopt>][ pattern ...]
    -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
    -F	sorted by father process, shown as a tree
    -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 patterns
    -b	call bsd/ucb ps with bsd options
EOF

push @opt, "-$opt"
    if $opt = join '', grep $opt{$_}, qw'a e f j l L';
$optD = defined( $opt{D} ) ? $opt{D} : 1;

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

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

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

AGAIN:
# 5.8.0: $ps = open PS, '-|', $cmd, @opt;
$ps = open PS, '-|' or
    exec $cmd, @opt;

AGAIN0:
my $found = 2;
if( @time ) {
    <PS>;
} else {
    $head = <PS>;
    $delcol = index $head, ' C ';
    $pidcol = index $head, '  PID';
    $head =~ s/ C //;
    $sortcol = 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 ' : '';
    $cmdcol = index $head, 'CMD';
    $cmdcol = index $head, 'COMMAND' if $cmdcol == -1;
}
@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} ) {
	%ps = ();
	$ps{int substr $_, $pidcol} = $_
	    for @ps;
	if( %oldps ) {		# previous round output something
	    $sep = sprintf '*** ' . substr( localtime $time[0], 4, 15 ) . ".%06d ***\n", $time[1]
		if @time;
	    $last = -1;
	    for( sort { $a <=> $b } keys %ps, keys %oldps ) {
		next unless $last < $_;
		$last = $_;
		if( $ps{$_} ) {
		    next if $ps{$_} eq $oldps{$_};
		    print $sep, $oldps{$_} ? '  ' : '+ ', $ps{$_};
		} else {
		    print "$sep- $oldps{$_}";
		}
		$sep = '';
	    }
	} elsif( @ps ) {
	    print '  ', $head if !@time;
	    print '  ', $ps{$_} for sort { $a <=> $b } keys %ps;
	}
	%oldps = %ps;
    } elsif( @ps ) {		# found some
	%ps = ();
	$ps{int substr $_, $pidcol} = $_
	    for @ps;
	if( @time ) {
	    printf '*** ' . substr( localtime $time[0], 4, 15 ) . ".%06d ***\n", $time[1];
	} else {
	    print $head;
	}
	print $ps{$_} for sort { $a <=> $b } keys %ps;
    }
    if( $optD ) {
	sleep $optD;
	@time = gettimeofday;
	goto AGAIN;
    } else {
	@time = gettimeofday;
	goto AGAIN0;
    }
}

exit unless @ps;

# normal single shot operation
print $head;
if( $opt{F} ) {
    $ppidcol = index $head, ' PPID';
    my( %val, %father, %children );
    for( @ps ) {
	my $pid = int substr $_, $pidcol;
	my $ppid = int substr $_, $ppidcol;
	$val{$pid} = $_;
	next if $pid == $ppid;	# On many systems 0 has a father 0.
	$father{$pid} = $ppid;
	$children{$ppid} ||= [];
	push @{$children{$ppid}}, $pid;
    }
    sub children {
	my( $mark, @ps ) = @_;
	my $n = @ps;
	for( $sortcol > 0 ? sort { substr( $val{$a}, $sortcol ) cmp substr $val{$b}, $sortcol } @ps : sort @ps ) {
	    --$n;
	    substr( $val{$_}, $cmdcol, 0 ) = substr( $mark, 0, -2 ).'+ ' if $mark;
	    print $val{$_};
	    if( @{$children{$_}} ) {
		substr( $mark, -2, 1 ) = $n ? '|' : ' ' if $mark;
		children( "$mark| ", @{$children{$_}} );
	    }
	}
    }
    children( '', grep !exists( $val{$father{$_}} ), keys %val );
} else {
    print $sortcol > 0 ? sort { substr( $a, $sortcol ) cmp substr $b, $sortcol } @ps : sort @ps;
}


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]/);
    }
    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 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