#Example code from Perl for System Administration by David #N. Blank-Edelman
#O'Reilly and Associates, 1st Edition, ISBN 1-56592-609-9

#*
#* show the process list on NT/2000 using PULIST from the NT Resource Kit
#*

$pulistexe = "\\bin\\PULIST.EXE"; # location of the executable
open(PULIST,"$pulistexe|") or die "Can't execute $pulistexe:$!\n";

scalar <PULIST>; # drop the first title line
while(defined($_=<PULIST>)){
    ($pname,$pid,$puser) = /^(\S+)\s*(\d+)\s*(.+)/;
    print "$pname:$pid:$puser\n";

close(PULIST);
-------
#*
#* show the list of process ids and names under NT/2000 using Win32::IProc
#*
use Win32::IProc;

$pobj=new Win32::IProc or die "Unable to create process object: $!\n";

$pobj->EnumProcesses(\@processlist) or 
  die "Unable to get process list:$!\n";

foreach $process (@processlist){
  $pid  = $process->{ProcessId};
  $name = $process->{ProcessName};
  write;
}

format STDOUT_TOP =
Process ID      Process Name
==========      ===============================
.
format STDOUT =
@<<<<<<<        @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$pid,           $name
.
-------
#*
#* show the process time info under NT/2000 using Win32::Iproc
#*

use Win32::IProc qw(PROCESS_QUERY_INFORMATION INHERITED DIGITAL);

$pobj = new Win32::IProc;

$pobj->Open($ARGV[0],PROCESS_QUERY_INFORMATION,INHERITED,\$handle) or
  warn "Can't get handle:".$pobj->LastError()."\n";

# DIGITAL = pretty-printed times
$pobj->GetStatus($handle,\$statusinfo,DIGITAL); 

$pobj->CloseHandle($handle);

while (($procname,$value)=each %$statusinfo){
  print "$procname: $value\n";
}
-------
#*
#* show the process ids and names under NT/2000 using Win32::Setupsup
#*
use Win32::Setupsup;

$machine = ""; # query the list on the current machine

Win32::Setupsup::GetProcessList($machine, \@processlist, \@threadlist) or 
  die "process list error: ".Win32::Setupsup::GetLastError()."\n";

pop(@processlist); # remove the bogus entry always appended to the list
foreach $processlist (@processlist){
  $pid  = $processlist->{pid};
  $name = $processlist->{name};
  write;
}

format STDOUT_TOP =
Process ID      Process Name
==========      ===============================
.
format STDOUT =
@<<<<<<<        @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$pid,           $name
.
-------
-------
#*
#* retrieve a WMI Win32_Process object (the hard way)
#*
use Win32::OLE('in');

$server = ''; # connect to local machine

# get a SWbemLocator object
$lobj = Win32::OLE->new('WbemScripting.SWbemLocator') or 
  die "can't create locator object: ".Win32::OLE->LastError()."\n";

# set the impersonate level to "impersonate"
$lobj->{Security_}->{impersonationlevel} = 3;

# use it to get a an SWbemServices object 
$sobj = $lobj->ConnectServer($server, 'root\cimv2') or 
  die "can't create server object: ".Win32::OLE->LastError()."\n";

# get the schema object
$procschm = $sobj->Get('Win32_Process'); 
-------
#*
#* retrieve a WMI Win32_Process object (the easy way)
#*
use Win32::OLE('in');

$procschm = Win32::OLE->GetObject(                    
  'winmgmts:{impersonationLevel=impersonate}!Win32_Process')
     or die "can't create server object: ".Win32::OLE->LastError()."\n"; 
-------
#*
#* show the properties and methods of the Win32_Process object by querying 
#* the schema 
#*
use Win32::OLE('in');

# connect to namespace, set the impersonate level, and retrieve the 
# Win32_process object just by using a display name
$procschm = Win32::OLE->GetObject(
             'winmgmts:{impersonationLevel=impersonate}!Win32_Process')
     or die "can't create server object: ".Win32::OLE->LastError()."\n"; 

print "--- Properties ---\n";
print join("\n",map {$_->{Name}}(in $procschm->{Properties_}));
print "--- Methods ---\n";
print join("\n",map {$_->{Name}}(in $procschm->{Methods_}));
-------
#*
#* retrieve the list of currently running processes using WMI under NT/2000
#*

use Win32::OLE('in');

# perform all of the initial steps in one swell foop

$sobj = Win32::OLE->GetObject(
                      'winmgmts:{impersonationLevel=impersonate}')
      or die "can't create server object: ".Win32::OLE->LastError()."\n"; 

foreach $process (in $sobj->InstancesOf("Win32_Process")){
  print $process->{Name}." is pid #".$process->{ProcessId},"\n";
}
-------
#*
#* retrieve the process id/user list under UNIX by looking at /proc
#*

opendir(PROC,"/proc") or die "Unable to open /proc:$!\n";
while (defined($_= readdir(PROC))){
    next if ($_ eq "." or $_ eq "..");
    next unless /^\d+$/; # filter out any random non-pid files
    print "$_\t". getpwuid((lstat "/proc/$_")[4])."\n";
}
closedir(PROC);
-------
#*
#* retrieve a list of process ids/owners under UNIX using Proc::ProcessTable
#*

use Proc::ProcessTable;

$tobj = new Proc::ProcessTable;
$proctable = $tobj->table();
for (@$proctable){
    print $_->pid."\t". getpwuid($_->uid)."\n";
}
-------
#*
#* look and log processes named "eggdrop" under UNIX
#*

use Proc::ProcessTable;

open(LOG,">>$logfile") or die "Can't open logfile for append:$!\n";

$t = new Proc::ProcessTable;
foreach $p (@{$t->table}){    
    if ($p->fname() =~ /eggdrop/i){
	print LOG time."\t".getpwuid($p->uid)."\t".$p->fname()."\n";
    }             
}
close(LOG);
-------
#*
#* collect stats on running processes under UNIX and dump them once an hour
#*

use Proc::ProcessTable;

$interval    = 600; # sleep interval of 5 minutes
$partofhour  =   0; # keep track of where in hour we are

$tobj = new Proc::ProcessTable; # create new process object

# forever loop, collecting stats every $intervar secs 
# and dumping them once an hour
while(1){
    &collectstats;
    &dumpandreset if ($partofhour >= 3600);
    sleep($interval);
}

# collect the process statistics
sub collectstats {
    my($process);
    foreach $process (@{$tobj->table}){
	    
        # we should ignore ourself
        next if ($process->pid() == $$);
        
        # save this process info for our next run
        push(@last,$process->pid(),$process->fname());

        # ignore this process if we saw it last iteration
        next if ($last{$process->pid()} eq $process->fname());

        # else, remember it
        $collection{$process->fname()}++;
    }
    # set the last hash using the current table for our next run
    %last = @last;
    $partofhour += $interval;
}

# dump out the results and reset our counters
sub dumpandreset{
    print scalar localtime(time).("-"x50)."\n";
    for (sort reverse_value_sort keys %collection){
        write;
    }

    # reset counters
    undef %collection;
    $partofhour = 0;
}

# (reverse) sort by values in %collection and by key name
sub reverse_value_sort{
    return $collection{$b} <=> $collection{$a} || $a cmp $b;
}

format STDOUT =
@<<<<<<<<<<<<<  @>>>>
$_,             $collection{$_}
.

format STDOUT_TOP =
Name            Count
--------------  -----
.
-------