#!/afs/athena/contrib/perl/perl
#
# pt -- print process tree
# 	Tom Christiansen <tchrist@convex.com>
#	version 1.0, Tue Jun 30 18:29:49 CDT 1992
#
# run ps and display process hierarchy indented
# under parents.
#
# Options:
# 	[-l level]	limits level of children printed
# 	[-i indent]	change indent level from default

$PS = "ps";			# a path to ps, usually /bin
# $PS = "/usr/bsd43/bin/ps";	# relief

$DEATH_STAR_ARGS = 0;		# ARGS: ps -el, not ps wwaxl
$DEATH_STAR_STAT = 0;	 	# if STAT is field 2

$INDENT = 2;  			 # reset via -i switch

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

if ($DEATH_STAR_ARGS) {
    $PS_ARGS = "-l"; 
    $EVERYBODY = "e";
} else {
    $PS_ARGS = "xlww";
    $EVERYBODY = "a";
}

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

$maxlevel = 10_000_000;  # reset via -l switch

sub usage {
    local($msg) = shift;
    print STDERR "$0: $msg\n" if $msg;
    die "usage: $0 [-l maxlevel] [-i indent] [ps args] [pid list]\n";
} 

while (defined($_ = shift)) {  # curse pid 0
    if (/-l(.*)/) {
	$maxlevel = $1 || shift || &usage("Need maxlevel for -l switch");
	next;
    } 
    if (/-i(.*)/) {
	$INDENT = $1 || shift || &usage("Need indent for -i switch");
	next;
    } 
    if (/^(\d+)$/) {
	$pids{$1}++;
	next;
    } 
    $PS_ARGS .= "$_ ";
} 

$PS_ARGS =~ s/^(-?)/${1}${EVERYBODY}/ if %pids;

open(PS, "$PS $PS_ARGS |") || die "can't fork: $!";
<PS>; # header

printf("%-8s %5s %5s %7s %s\n", 'USER', "PID", "TTY", "TIME","COMMAND");

while (<PS>) {
    ($uid, $pid, $ppid) = $DEATH_STAR_STAT   # cursed be
	    ? /^\s*[\da-f]+\s+\S+\s+([\-\d]+)\s+(\d+)\s+(\d+)/
	    : /^\s*[\da-f]+\s+([\-\d]+)\s+(\d+)\s+(\d+)/;
    ($tty, $time, $command) = /(\S+)\s+(\d+:\d+)\s+(.*)$/;
    die "can't parse line from ps: $_\nbailing out" 
	unless grep(defined,$uid,$pid,$ppid,$command) == 4;
    $lines{$pid} = sprintf("%-8s %5d %5s %7s#%s\n", 
		&id($uid), $pid, $tty, $time, $command);
    unless ($pid == $ppid) {
	$parent{$pid} = $ppid;
	$children{$ppid} .= "$pid ";
    }
} 
close(PS) || warn "ps exited badly!\n";

@pids = keys %pids;
if (@pids) {
    foreach $pid (@pids) {
	&save_the_children($pid);
	&save_our_parent($pid);
    } 
    # &keepline(0);
    %lines = %nlines;
} 

sub bynum { $a - $b; } 

# find the heads of the chains...
@pids = grep(!defined $lines{$parent{$_}},keys %lines);

for $pid (sort bynum @pids) {
    &children($pid); 
} 

exit $?;

sub children {
    local($pid) = $_[0];
    local($_) = $lines{$pid};
    substr($_, index($_, '#'), 1) = ' ' x (1+ $INDENT * $level);
    print;
    if ($level++ < $maxlevel) {
	local(@kids) = split(' ',$children{$pid});
	for $pid (@kids) {
	    &children($pid);
	}
    } 
    $level--;
} 

sub id {
    local($id) = shift;
    $name{$id} = (getpwuid($id))[0] unless defined $name{$id};
    $name{$id} || $id;
} 

sub save_the_children {
    local($parent) = shift;
    foreach $kid (split(' ',$children{$parent})) {
	&save_the_children($kid);
    } 
    &keepline($parent);
} 
    
sub save_our_parent {
    local($kid) = shift;
    local($dad) = $parent{$kid};
    &keepline($kid);
    if ($dad || $dad eq '0') { # beware $dad == 0
	&save_our_parent($dad);
    }
} 

sub keepline {
    $nlines{$_[0]}  = $lines{$_[0]} 
	unless defined $nlines{$_[0]};
} 
