#!/usr/bin/perl -w

# Perl ps operations.
#
# By James Reynolds http://james.magnusviri.com, based off work of Charles Parnot
#
# To use, include this file in another script.  Like this:
#
# use lib "/path/to/perlps/parent/dir/";
#
# use Foundation;
# require "perlps.pl";
#

# optional debugger:

#use Data::Dumper;

sub ps_struct {
	my ( @params ) = @_;
	my $ps_options = "pid,ppid";
	my $num_options = 0;
	foreach my $param ( @params ) {
		$ps_options .= ",";
		SWITCH: for ($param) {
               /^ppid$/			&& do { last; };
               /^pid$/			&& do { last; };
               /^%cpu$/			&& do { $ps_options .= "%cpu"; $num_options++; last; };
               /^%mem$/			&& do { $ps_options .= "%mem"; $num_options++; last; };
               /^acflag$/		&& do { $ps_options .= "acflag"; $num_options++; last; };
               /^command$/		&& do { $ps_options .= "command"; $num_options++; last; };
               /^cpu$/			&& do { $ps_options .= "cpu"; $num_options++; last; };
               /^flags$/		&& do { $ps_options .= "flags"; $num_options++; last; };
               /^inblk$/		&& do { $ps_options .= "inblk"; $num_options++; last; };
               /^jobc$/			&& do { $ps_options .= "jobc"; $num_options++; last; };
               /^ktrace$/		&& do { $ps_options .= "ktrace"; $num_options++; last; };
               /^ktracep$/		&& do { $ps_options .= "ktracep"; $num_options++; last; };
               /^lim$/			&& do { $ps_options .= "lim"; $num_options++; last; };
               /^logname$/		&& do { $ps_options .= "logname"; $num_options++; last; };
               /^majflt$/		&& do { $ps_options .= "majflt"; $num_options++; last; };
               /^minflt$/		&& do { $ps_options .= "minflt"; $num_options++; last; };
               /^msgrcv$/		&& do { $ps_options .= "msgrcv"; $num_options++; last; };
               /^msgsnd$/		&& do { $ps_options .= "msgsnd"; $num_options++; last; };
               /^nice$/			&& do { $ps_options .= "nice"; $num_options++; last; };
               /^nivcsw$/		&& do { $ps_options .= "nivcsw"; $num_options++; last; };
               /^nsigs$/		&& do { $ps_options .= "nsigs"; $num_options++; last; };
               /^nswap$/		&& do { $ps_options .= "nswap"; $num_options++; last; };
               /^nvcsw$/		&& do { $ps_options .= "nvcsw"; $num_options++; last; };
               /^nwchan$/		&& do { $ps_options .= "nwchan"; $num_options++; last; };
               /^oublk$/		&& do { $ps_options .= "oublk"; $num_options++; last; };
               /^p_ru$/			&& do { $ps_options .= "p_ru"; $num_options++; last; };
               /^paddr$/		&& do { $ps_options .= "paddr"; $num_options++; last; };
               /^pagein$/		&& do { $ps_options .= "pagein"; $num_options++; last; };
               /^pgid$/			&& do { $ps_options .= "pgid"; $num_options++; last; };
               /^poip$/			&& do { $ps_options .= "poip"; $num_options++; last; };
               /^pri$/			&& do { $ps_options .= "pri"; $num_options++; last; };
               /^re$/			&& do { $ps_options .= "re"; $num_options++; last; };
               /^rgid$/			&& do { $ps_options .= "rgid"; $num_options++; last; };
               /^rlink$/		&& do { $ps_options .= "rlink"; $num_options++; last; };
               /^rss$/			&& do { $ps_options .= "rss"; $num_options++; last; };
               /^rsz$/			&& do { $ps_options .= "rsz"; $num_options++; last; };
               /^rtprio$/		&& do { $ps_options .= "rtprio"; $num_options++; last; };
               /^ruid$/			&& do { $ps_options .= "ruid"; $num_options++; last; };
               /^ruser$/		&& do { $ps_options .= "ruser"; $num_options++; last; };
               /^sess$/			&& do { $ps_options .= "sess"; $num_options++; last; };
               /^sig$/			&& do { $ps_options .= "sig"; $num_options++; last; };
               /^sigcatch$/		&& do { $ps_options .= "sigcatch"; $num_options++; last; };
               /^sigignore$/	&& do { $ps_options .= "sigignore"; $num_options++; last; };
               /^sigmask$/		&& do { $ps_options .= "sigmask"; $num_options++; last; };
               /^sl$/			&& do { $ps_options .= "sl"; $num_options++; last; };
               /^start$/		&& do { $ps_options .= "start"; $num_options++; last; };
               /^state$/		&& do { $ps_options .= "state"; $num_options++; last; };
               /^svgid$/		&& do { $ps_options .= "svgid"; $num_options++; last; };
               /^svuid$/		&& do { $ps_options .= "svuid"; $num_options++; last; };
               /^tdev$/			&& do { $ps_options .= "tdev"; $num_options++; last; };
               /^time$/			&& do { $ps_options .= "time"; $num_options++; last; };
               /^tpgid$/		&& do { $ps_options .= "tpgid"; $num_options++; last; };
               /^tsess$/		&& do { $ps_options .= "tsess"; $num_options++; last; };
               /^tsiz$/			&& do { $ps_options .= "tsiz"; $num_options++; last; };
               /^tt$/			&& do { $ps_options .= "tt"; $num_options++; last; };
               /^tty$/			&& do { $ps_options .= "tty"; $num_options++; last; };
               /^uprocp$/		&& do { $ps_options .= "uprocp"; $num_options++; last; };
               /^uid$/			&& do { $ps_options .= "uid"; $num_options++; last; };
               /^upr$/			&& do { $ps_options .= "upr"; $num_options++; last; };
               /^user$/			&& do { $ps_options .= "user"; $num_options++; last; };
               /^vsz$/			&& do { $ps_options .= "vsz"; $num_options++; last; };
               /^wchan$/		&& do { $ps_options .= "wchan"; $num_options++; last; };
               /^xstat$/		&& do { $ps_options .= "xstat"; $num_options++; last; };
# The next two use spaces, so they wont parse right
#               /^lstart$/		&& do { $ps_options .= "lstart"; $num_options++; last; };
#               /^ucomm$/		&& do { $ps_options .= "ucomm"; $num_options++; last; };
               die "unknown value: `$param'";
		}
	}
	my $ps = `/bin/ps -axww -o $ps_options`;

	my @rows = split /\n/,$ps;

	#get header line to know the order of the keys (not guaranteed by `ps` apparently)
	my $header= shift @rows;
	$header =~ s/^\s+//g;
	my @keys = split /\s+/, $header;
	my %index = ();
	foreach (0..$#keys) { $index{ $keys[$_] }= $_ }

	my %processes = ();
	my %children;
	foreach my $row (@rows) {
		$_ = $row;
		s/^\s+//g;
		my @values = split /\s+/;
		my %ps_columns = ();
		foreach my $key ( @keys ) {
			if ( $key eq "COMMAND" ) {
				$ps_columns{$key} = substr ( $row, index ( $row, $values[$index{$key}] ));
			} else {
				$ps_columns{$key} = $values[$index{$key}];
			}
		}
		push @{$children{$ps_columns{'PPID'}}}, $ps_columns{'PID'};
		$processes{$ps_columns{'PID'}} = \%ps_columns;
	}

	while ( my ( $key, $value ) = each %children ) {
		$bla = \$processes{$key};
		#print %$$bla;
		$$$bla{'children'} = $children{$key};
	}

	return \%processes;
}

sub ps_for_attr_and_value {
	my ( $process_stack, $attr, $findme ) = @_;
	my %new_list = ();
	while ( my ( $key1, $value1 ) = each %$process_stack ) {
		my $found = 0;
		while ( my ( $key2, $value2 ) = each %$value1 ) {
			if ( $key2 eq $attr ) {
				$_ = $value2;
				if ( /$findme/ ) {
					$found = 1;
					last;
				}
			}
		}
		if ( $found ) {
			$new_list{$key1} = $value1;
		}
	}
	return \%new_list;
}

sub pid_children_of_pid {
	my ( $process_stack, $pid, $recursive ) = @_;
	my $me = $$process_stack{$pid};
	my $children = $$me{'children'};
	my @found_pids = ();
	foreach my $child_pid ( @$children ) {
		push @found_pids, $child_pid;
		if ( $recursive ) {
			my $child = $$process_stack{$child_pid};
			if ( exists $$child{'children'} ) {
				my @more_pids = pid_children_of_pid( $process_stack, $child_pid, $recursive );
				push @found_pids, @more_pids;
			}
		}
	}
	return @found_pids;
}
sub ps_children_of_pid {
	my ( $process_stack, $pid, $recursive ) = @_;
	my @pids = pid_children_of_pid ( $process_stack, $pid, $recursive );
	my %new_list = ();
	foreach my $pid ( @pids ) {
		$new_list{$pid} = $$process_stack{$pid};
	}
	return \%new_list;
}

sub values_for_attr {
	my ( $process_stack, $attr ) = @_;
	my @values = ();
	while ( my ( $key1, $value1 ) = each %$process_stack ) {
		while ( my ( $key2, $value2 ) = each %$value1 ) {
			if ( $key2 eq $attr ) {
				push @values, $value2;
			}
		}
	}
	return @values;
}

##########
# Example code how to use:

#my $ps = ps_struct ( "%cpu","%mem","acflag","cpu","flags","jobc","ktrace","ktracep","lim","logname","start","nice","nivcsw","nsigs","nswap","nvcsw","nwchan","oublk","p_ru","paddr","pagein","pgid","pid","ppid","pri","re","rgid","rss","rsz","ruid","ruser","sess","sig","sigmask","sl","state","svgid","svuid","tdev","time","tpgid","tsess","tsiz","tt","tty","uid","upr","user","vsz","wchan","xstat","command");

#my $root_processes = ps_for_attr_and_value ( $ps, "USER", "\^root\$" );
#my $launchd = ps_for_attr_and_value ( $root_processes, "COMMAND", "launchd\$" );
#my $children_of_launchd = ps_children_of_pid ( $ps, (values_for_attr($launchd, "PID"))[0] );
#my $all_children_of_launchd = ps_children_of_pid ( $ps, (values_for_attr($launchd, "PID"))[0], 1 );

#print Dumper values_for_attr($children_of_launchd, "COMMAND");

#print Dumper values_for_attr($all_children_of_launchd, "COMMAND");

##########
# This is why I wrote it:

#my $ps = ps_struct ( "command" ); 
    
#my @kill_me = ();
#my $xgridagentd = ps_for_attr_and_value ( $ps, "COMMAND", "xgridagentd\$" );
#my $xgridagentd_pid = (values_for_attr($xgridagentd, "PID"))[0];
#if ( $xgridagentd_pid ) {
#  @kill_me = pid_children_of_pid ( $ps, $xgridagentd_pid, 1 );
#}

#system "/usr/sbin/xgridctl agent off";
#foreach my $pid ( @kill_me ) {
#  system "/bin/kill -9 $pid";
#}
#system "/usr/sbin/xgridctl agent stop";


1;