#!/usr/bin/env perl

## psgrep - print selected lines of ps output by
##          compiling user queries into code
##
## 11/01/02 45017    Sherbert    Choose ps based on OS and for OPUS needs
## 11/02/02 45017    Sherbert    Requiring user to be last param
## 03/24/03 45017    Sherbert    Cleaned up long lines.
## 09/08/03 45017    Sherbert    Required to add ".pl" to file names
## 12/23/03 49783    Sontag      Add lines for AIX
##

use strict;


# each field from the PS header
my @fieldnames_linux = qw(PID CPU MEM VSZ STARTED CMD);
my @fieldnames_tru64 = qw(PID CPU MEM VSZ STARTED CMD);
my @fieldnames_sunos = qw(PID CPU MEM VSZ STIME COMMAND);
my @fieldnames_aix   = qw(PID CPU MEM VSZ STARTED COMMAND);

# determine the unpack format needed (hard-coded for Linux ps)
my $fmt_linux = cut2fmt(8, 14, 20, 26, 30, 34, 41, 47, 59, 63, 67, 72);
# my $fmt_tru64 = cut2fmt(6, 10, 15, 21, 28, 35);
my $fmt_tru64 = cut2fmt(8, 12, 16, 21, 29);
my $fmt_sunos = cut2fmt(8, 13, 18, 23, 32);
my $fmt_aix   = cut2fmt(7, 13, 18, 24, 33);

my %fields;                         # where the data will store
my @fieldnames;
my ($fmt, $pipe_cmd) ;
my $user = (pop @ARGV) || ($ENV{"USER"});

## If I don't use the "-u \$USER" then the command only applies to the current
## session BUT I wanted to be able to specify which user I want to see
## processes for.  
if ( `/bin/uname -s` =~ /OSF1/ ) {
    @fieldnames = @fieldnames_tru64;
    $fmt = $fmt_tru64;
    $pipe_cmd = "/usr/bin/ps -o pid,pcpu,pmem,vsz,start,cmd -u $user |" ;
} elsif ( `/bin/uname -s` =~ /SunOS/ ) {
    @fieldnames = @fieldnames_sunos;
    $fmt = $fmt_sunos;
    $pipe_cmd = "/bin/ps -o pid,pcpu,pmem,vsz,stime,args -u $user |" ;
} elsif ( `/bin/uname -s` =~ /Linux/ ) {
    @fieldnames = @fieldnames_linux;
    $fmt = $fmt_linux;
    $pipe_cmd = "/bin/ps -o pid,pcpu,pmem,vsz,start,cmd -u $user |" ;
} elsif ( `/bin/uname -s` =~ /AIX/ ) {
    @fieldnames = @fieldnames_aix;
    $fmt = $fmt_aix;
    $pipe_cmd = "/bin/ps -o pid,pcpu,pmem,vsz,start,args -u $user |" ;
} else {
    die "OS unsupported by opusgrep.";
}

## Cannot print Usage statment until @fieldnames is defined...
## First check user value

## I hope that I can correctly determine that user has been provided by
## assuming that the criterion will always have special characters at
## beginning and end... and that user names will always be only letters
if ( $user !~ /^\w+$/ ) {
    print STDERR "\nuser is $user \n";
    print STDERR "user $user does not look like a user to me \n";
    PrintUsage(@fieldnames);
}

## Then make sure parameters were specified on the command line
PrintUsage(@fieldnames) unless @ARGV;

# Create function aliases for uid, size, UID, SIZE, etc.
# Empty parens on closure args needed for void prototyping.
for my $name (@fieldnames) {
    no strict 'refs';
    *$name = *{lc $name} = sub () { $fields{$name} };
}

## This is the 'grep':
my $code = "sub is_desirable { " . join(" and ", @ARGV) . 
    " and not /pscluster/ " . ## Do not catch this code in the ps output
    " and not /opusgrep/ } "; ## Do not catch this code in the ps output
# print "*--* ",  $code, "\n";  ## trace
unless (eval $code.1) {
    die "Error in code: $@\n\t$code\n";
}

open(PS, $pipe_cmd )              || die "cannot fork: $!";
print scalar <PS>;                  # emit header line
while (<PS>) {
    @fields{@fieldnames} = trim(unpack($fmt, $_));
    print if is_desirable();        # line matches their criteria
}
close(PS)                           || die "ps failed!";

# convert cut positions to unpack format
sub cut2fmt {
    my(@positions) = @_;
    my $template  = '';
    my $lastpos   = 1;
    for my $place (@positions) {
        $template .= "A" . ($place - $lastpos) . " ";
        $lastpos   = $place;
    }
    $template .= "A*";
    return $template;
}

sub trim {
    my @strings = @_;
    for (@strings) {
        s/^\s+//;
        s/\s+$//;
    }
    return wantarray ? @strings : $strings[0];
}

## # the following was used to determine column cut points.
## # sample input data follows
## #123456789012345678901234567890123456789012345678901234567890123456789012345
## #         1         2         3         4         5         6         7
## # Positioning:
## #       8     14    20    26  30  34     41    47          59  63  67   72
## #       |     |     |     |   |   |      |     |           |   |   |    |
## __END__
##  FLAGS   UID   PID  PPID PRI  NI   SIZE   RSS WCHAN       STA TTY TIME COMMAN
##    100     0     1     0   0   0    760   432 do_select   S   ?   0:02 init
##    140     0   187     1   0   0    784   452 do_select   S   ?   0:02 syslog
## 100100   101   428     1   0   0   1436   944 do_exit     S    1  0:00 /bin/l
## 100140    99 30217   402   0   0   1552  1008 posix_lock_ S   ?   0:00 httpd
##      0   101   593   428   0   0   1780  1260 copy_thread S    1  0:00 -tcsh
## 100000   101 30639  9562  17   0    924   496             R   p1  0:00 ps axl
##      0   101 25145  9563   0   0   2964  2360 idetape_rea S   p2  0:06 trn
## 100100     0 10116  9564   0   0   1412   928 setup_frame T   p3  0:00 ssh -C
## 100100     0 26560 26554   0   0   1076   572 setup_frame T   p2  0:00 less
## 100000   101 19058  9562   0   0   1396   900 setup_frame T   p1  0:02 nvi /t

sub PrintUsage {
    my @fieldnames = @_;
    use File::Basename;
    my ($name, $unixpath, $ext) = fileparse($0, '.pl' );
    $name = $name . $ext;
	print STDERR "\nUSAGE: $name criterion ... user ";
	print STDERR "\n\tEach criterion is a Perl expression involving: ";
	print STDERR "\n\t\t@fieldnames ";
	print STDERR "\n\tAll criteria must be met for a line to be printed. ";
	print STDERR "\n\tUser *MUST* be specified so that other user's ",
                 "processes can be spied \n";
    print STDERR "\n";
	print STDERR "\nEXAMPLE: $name '/opus_[a-z]*_serv/ || /\.path/' sherbert ";
	print STDERR "\n\t $name '/opus_[a-z]*_serv/' '/event/' erith ";
	print STDERR "\n\t \n\n";
    exit;
}