#!/usr/local/bin/perl
# -*-Fundamental-*-

#  DRAFT! DRAFT! DRAFT!
#  This revision is not intended for public consumption!
#  USE AT YOUR OWN (CONSIDERABLE) RISK
#

use Carp;
use strict;
$| = 1;

my $Myname;
($Myname = $0) =~ s%^.*/%%;

my $Usage = <<LIT;
$Myname: usage:

  $Myname [ -p4d_pid <regexp> ] [ -p4d_pid <pid> ] [-p4d_log <logpath> ] <tailsize>
		
LIT


sub usage
{
  print STDERR $Usage;
  exit 1;
}


sub help
{
  print STDERR <<LIT;
$Usage

$Myname combines information from a Perforce server host's process
list and the perforce server log file, and prints a list of current
perforce processes.

LIT
  exit 1;
}

my %p4d;
my %log;

my $ps_head;

sub process_ent
{
  my ($line) = @_;
  my @l = split(/\s+/, $line);

  if ($l[4] =~ /:/) { return; }

  if (defined($p4d{$l[4]}))
    {
      if ($l[5] eq "completed")
        { delete ($log{$l[4]}); }
      else
        { $log{$l[4]} = $line; }
    }
}

# option switch variables get defaults here...

my $P4d_pid;
my $P4d_log;
my $Ntailn = "1500";
my $P4d_i;
my @Args;
my $Args;

while ($#ARGV >= 0)
  {
    if ($ARGV[0] eq "-p4d_i")
      { shift; if ($ARGV[0] < 0) { &usage; } $P4d_i = $ARGV[0]; shift; next; }

    elsif ($ARGV[0] eq "-p4d_pid")
      { shift; if ($ARGV[0] < 0) { &usage; } $P4d_pid = $ARGV[0]; shift; next; }

    elsif ($ARGV[0] eq "-p4d_log")
      { shift; if ($ARGV[0] < 0) { &usage; } $P4d_log = $ARGV[0]; shift; next; }

    elsif ($ARGV[0] eq "-help")
      { &help; }
    if ($Args ne "") { $Args .= " "; }
    push(@Args, $ARGV[0]);
    shift;
  }

if ($#Args >= 0)
  {
    $Ntailn = shift @Args;
    $Ntailn =~ s/^-//; # backwards compatability
  }

#  We want, for each supported platform, a ps command that will, for
#  at _least_ the target p4d and all of it's children, produce output
#  where the first line is a header, and subseqent lines are process
#  info, with the first two columns being split-able pid and ppid;
#  This will yeild the output parseable by the generic parsing
#  code. For systems where this can't be achieved, you'll need to add
#  special-case parsing code for your system.
#
#  Feel free to custmize for whatever ps output fields might be
#  useful, after the pid and ppid.
#

my $Ps_cmd;
my $Ntail;

my $uname = `uname -a`;
chomp $uname;
my (@U) = split(/\s+/, $uname);

if ($U[0] eq "OSF1")
  {
    $Ps_cmd = "ps -o pid -o comm -o lstart -o rssize -o time -o args";
    $Ntail = "-$Ntailn";
    die "I don't really do OSF1 again yet"; 
  }
elsif ($U[0] eq "Linux" && $U[2] eq "2.4.2-2")
  {
    $Ps_cmd = "ps -eo pid,ppid,comm,lstart,rssize,time,args";
    $Ntail = "--lines=$Ntailn";
  }
elsif ($U[0] eq "FreeBSD" && $U[2] eq "4.1-RELEASE")
  {
    $Ps_cmd = "ps -axo pid,ppid,lstart,rsz,time,command";
    $Ntail = "-n $Ntailn";
  }
else
  { die "I don't know how to run on this <$uname>"; }

if (! $Ps_cmd) { die "Undetermined \$Ps_cmd"; }
if (! $Ntail)  { die "Undetermined \$Ntail"; }

if (-e "/u/p4/.p4d.p4netapp.pid")
#
#  (If we're at NetApp, for example...)
#
  {
    open(PID, "</u/p4/.p4d.p4netapp.pid") || die "open /u/p4/.p4d.p4netapp.pid";
    $P4d_pid = <PID>; chomp $P4d_pid;
  }

if (! $P4d_pid) { die "Undetermined \$P4d_pid"; }

open(PS, "$Ps_cmd |") || die "open $Ps_cmd";

while (<PS>)
  {
    chomp;
    if (/^\s*PID/i) { $ps_head = $_; }
    $_ =~ s/^\s*//;
    my ($pid, $ppid) = split(/\s+/, $_);

    # Weed out all processes except this server's p4d's:
    #
    if (! ($pid eq $P4d_pid || $ppid eq $P4d_pid)) { next; }
    if ($P4d_i && $_ !~ /$P4d_i/) { next; }

    $p4d{$pid} = $_;
  }
close PS;

my $tail_cmd = "tail $Ntail $P4d_log";

open(TAIL, "$tail_cmd |") || die "open \$tail_cmd";

my $line = "";
while (<TAIL>)
  {
    chomp;

    if (/Perforce server (message|error|info):/)
      {
        if ($line) { &process_ent($line); }
        $line = ""; next; 
      }

    $_ =~ s/\s+/ /;
    $line .= "$_";
  }

if ($line) { &process_ent($line); }

#print "$ps_head\n";

foreach my $pid (sort {$a <=> $b} (keys(%p4d)))
  {
    if ($pid eq $P4d_pid || ! defined($log{$pid}))
      {
        printf "%5d%s%s\n", $pid, ($pid eq $P4d_pid ? "*" : " "), substr($p4d{$pid}, 0, 80);
        next;
      }

    $log{$pid} =~ s/^\s+//;  
    my @args;
    my $args;
    my ($day, $time, $PID, $P, $who, @args) = split(/\s+/, $log{$pid});
    $args = join(" ", @args);
#print "$log{$pid}\n";
    my $client;
    ($who, $client) = split(/@/, $who);
    $args = substr($args, 0, 50);
    printf "%5d %8s %8s %10s %s %s\n", $pid, $day, $time, $who, $client, $args;
  }