use Tk;

#!/pro/bin/perl

use Tk;
use Time::localtime;

$width = 80;

to_background ();
InitTop ();

MainLoop;

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

sub to_background
{
setpriority $pid, $$, 20;
my $pid = fork;
if ($pid < 0) {
print STDERR "Unable to run in the background, cannot fork: $!\n";
exit $?;
}
$pid and exit 0;
} # to_background

sub InitTop
{
my $f;

chomp ($HOST = `hostname`);

$top = MainWindow->new (-cursor => "top_left_arrow", -name => "Top");
$top->title ("XTOP $HOST");
$top->bind ("<Key>q" => sub {$top->destroy});

$f = $top->Frame (-relief => "flat")->pack (-fill => "both", -side => "top");
$f->Label (-text => "System: $HOST")->pack (-fill => "both", -side => "left");
$sysdate = ctime (time);
$f->Label (-textvariable => \$sysdate)->pack (-fill => "both", -side => "right");

$f = $top->Frame (-relief => "flat")->pack (-fill => "both", -side => "top");
$sysload = "Load avarages: ";
$f->Label (-textvariable => \$sysload)->pack (-fill => "both", -side => "left");

$f = $top->Frame (-relief => "flat")->pack (-fill => "both", -side => "top");
$sysproc = "0 processes: 0 sleeping, 0 running, 0 zombies";
$f->Label (-textvariable => \$sysproc)->pack (-fill => "both", -side => "left");

%state = (
"0" => "nonexistent",
"A" => "active ",
"S" => "sleeping ",
"W" => "waiting ",
"R" => "running ",
"I" => "idle ",
"Z" => "terminated ",
"T" => "stopped ",
"X" => "growing ");
$ENV{UNIX95} = 1;
$pslist = $top->Scrolled ("ROText",
-scrollbars => "e",
-wrap => "none",
-height => 20,
-width => $width)->pack (
-expand => 1,
-fill => "both",
-side => "left");
$pslist->insert ("end", "PROcess list\n");
#$pslist->bind ("<Key>q" => sub {$top->destroy});

UpdateTop ();
$top->repeat (2000, \&UpdateTop);
} # InitTop

sub pslist
{
my $pcpu_ok = 1; # Got patched ps from hp (02 Mar 1999)
my @ps = $pcpu_ok
? `ps -e -otty,pid,user,pri,nice,state,vsz,time,pcpu,args`
: `ps -e -otty,pid,user,pri,nice,state,vsz,time,cpu,args`;

shift @ps; # Skip header, creating my own
# Not all unix flavours use the same -o syntax
my $hdr = " TTY PID USERNAME PRI NI STATE SIZE TIME \%CPU COMMAND\n";

my %cntproc = ();
# Positions are based on reformatted output
my @s = ( [ 52, 5], # %CPU
[ 39, 6], # SIZE
[ 45, 7], # TIME
[ 27, 2], # NICE
);
@ps = sort {
substr ($b, $s[0][0],$s[0][1]) <=> substr ($a, $s[0][0],$s[0][1]) ||
substr ($b, $s[1][0],$s[1][1]) <=> substr ($a, $s[1][0],$s[1][1]) ||
substr ($b, $s[2][0],$s[2][1]) cmp substr ($a, $s[2][0],$s[2][1]) ||
substr ($a, $s[3][0],$s[3][1]) <=> substr ($b, $s[3][0],$s[3][1]) ||
$a cmp $b;
} map {
s/^\s+//;
my @x = split m/\s+/, $_, 10;
$x[0] =~ s/\?/-/;
$cntproc{$x[5]}++;
$x[5] =~ s/(.)/$state{$1}/;
my @t = ((reverse split m/:/, $x[7]), 0, 0, 0);
$x[7] = sprintf ("%4d:%02d", $t[2] * 60 + $t[1], $t[0]);
$pcpu_ok and $x[8] *= 100.;
sprintf "%6s %6d %-8s %3d %2d %-.8s %6d%6s%5.1f %s", @x;
} @ps;
$sysproc = sprintf ("%d processes: %d sleeping, %d running, %d zombies",
scalar @ps, $cntproc{S}, $cntproc{R}, $cntproc{Z});
# unshift @ps, "0----+----1----+----2----+----3----+----4----+----5----+----6----+----7\n";
join "", $hdr, @ps;
} # pslist

sub ruptime
{
my $r;

($r = `rup localhost`) =~ s/.*l(oad.*\d)/L$1/;
# ($r = (grep m/^$HOST\b/, `ruptime`)[0]) =~
# s/.*load\s+(.*\d)\s*/Load avarage: $1/;
chomp $r;
$r;
} # ruptime

sub UpdateTop
{
$sysdate = ctime (time);
$sysload = ruptime;

$pslist->delete ("1.0", "end");
$pslist->insert ("end", &pslist);
} # UpdateTop