#! /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