This week only. Pastebin PRO Accounts Christmas Special! Don't miss out!Want more features on Pastebin? Sign Up, it's FREE!
Guest

muteW

By: a guest on Apr 24th, 2009  |  syntax: Perl  |  size: 4.28 KB  |  views: 233  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. package Process;
  2.  
  3. use strict;
  4. use warnings;
  5. use Carp;
  6. our (@ISA, $VERSION, @EXPORT_OK);
  7.  
  8. @ISA = qw(Exporter);
  9. @EXPORT_OK = qw(
  10. );
  11. $VERSION = "0.2";
  12.  
  13. sub new {
  14.         ## Store the process details in $self as a
  15.         ## reference of a hash to a hash.
  16.         my $class = shift;
  17.         my $self  = {};
  18.  
  19.         ## Get list of process using 'ps'
  20.         my @psList = `ps --no-headers -eo user,pid,ppid,tname,comm`;
  21.     return undef if $?;
  22.  
  23.         for (@psList) {
  24.                 my @psDet = split;
  25.                 my $pid = $psDet[1];
  26.  
  27.                 $self->{$pid}{UID}      = $psDet[0];
  28.                 $self->{$pid}{PPID}     = $psDet[2];
  29.                 $self->{$pid}{TERM}     = $psDet[3];
  30.                 $self->{$pid}{CMD}      = join " ", @psDet[4..$#psDet];
  31.         }
  32.  
  33.         bless $self, $class;
  34.         return $self;
  35. }
  36.  
  37. ## Returns list of process id's owned by user
  38. sub getbyuser {
  39.         my $self = shift;
  40.         my $user = shift;
  41.  
  42.         carp "No object specified" unless(ref $self);
  43.         carp "No user specified : obj->getbyuser(\"uname\")" unless($user);
  44.  
  45.         my @psList;
  46.         for my $pid (keys %$self) {
  47.                 push @psList, $pid
  48.                   if( $self->{$pid}{UID} eq $user );
  49.         }
  50.  
  51.         return @psList;
  52. }
  53.  
  54. ## Return list of process id's with matching cmd's
  55. sub getbycmd {
  56.         my $self = shift;
  57.         my $cmd  = shift;
  58.  
  59.         carp 'No object specified'                      unless(ref $self);
  60.         carp 'No cmd specified : obj->getbycmd("cmd")'  unless ($cmd);
  61.  
  62.     eval { "" =~ m/$cmd/ };
  63.     carp "Invalid regex passed to getbycmd()\n"
  64.       if $@;
  65.  
  66.         my @psList;
  67.         for my $pid (keys %$self) {
  68.         ##TODO: Is there a need to  metaquote $cmd
  69.         ##or should we assume that $cmd is a valid regex?
  70.                 push @psList, $pid
  71.                   if ( $self->{$pid}{CMD} =~ m/$cmd/i );
  72.          }
  73.          
  74.          return @psList;
  75. }
  76.  
  77. ## Return process details as a hash
  78. ## PID, UID, PPID, TERM, CMD
  79. sub getdetail {
  80.         my $self = shift;
  81.         my $pid  = shift;
  82.        
  83.         carp 'No object specified'                                      unless(ref $self);
  84.         carp 'No PID specified : obj->getdetail("pid")' unless ($pid);
  85.  
  86.         return undef
  87.           unless exists $self->{$pid};
  88.        
  89.         my %psDet   = %{ $self->{$pid} };
  90.         $psDet{PID} = $pid;
  91.  
  92.         return \%psDet;
  93. }
  94.  
  95. ## Return UID for specified process
  96. sub getuid {
  97.         my $self = shift;
  98.         my $pid  = shift;
  99.  
  100.         carp 'No object specified'                                      unless(ref $self);
  101.         carp 'No PID specified : obj->getdetail("pid")' unless ($pid);
  102.  
  103.     return ( exists $self->{$pid} ? $self->{$pid}{UID} : undef );
  104. }
  105.  
  106. 1;
  107.  
  108.  
  109. __END__
  110.  
  111. =head1 NAME
  112.  
  113. Process - build a list of current processes in the system
  114.  
  115. =head1 SYNOPSIS
  116.  
  117.     use Process;
  118.  
  119.     my $ps = Process->new() or die "Process: Cannot build process list $!";
  120.     foreach ($ps->getbyuser('user')) {
  121.         print $ps->getdetail($_);
  122.     }  
  123.  
  124. =head1 DESCRIPTION
  125.  
  126. The C<Process> package provides an interface to the system processes with
  127. the help of specific routines.
  128.  
  129. =over 4
  130.  
  131. =item B<new ( )>
  132.  
  133. C<new> is the constructor for C<Process> objects. It accepts no arguments
  134. and builds a list of processes currently in the system
  135.  
  136. =back
  137.  
  138. =over 4
  139.  
  140. =item B<getbyuser ( USERNAME )>
  141.  
  142. This returns a list of process id's for the user specified in argument 1. The
  143. user name match is a case-sensitive check and expects to get the complete
  144. user name in order to generate the correspnding list.
  145.  
  146. =back
  147.  
  148. =over 4
  149.  
  150. =item B<getbycmd  ( CMDNAME )>
  151.  
  152. This returns a list of process id's whose process name matches the passed
  153. argument. The match accepts regex's to find matching processes. Command-line
  154. arguments to running processes are not matched with the user-specified
  155. CMDNAME.
  156.  
  157. =back
  158.  
  159. =over 4
  160.  
  161. =item B<getdetail ( PID )>
  162.  
  163. C<getdetail> collects the details of the specified PID and returns it
  164. as a hash reference with the following keys :
  165.     PID     [Process ID]
  166.     PPID    [Process parent ID]
  167.     UID     [User ID]
  168.     TERM    [tty]
  169.     CMD     [Command name]
  170.  
  171. =back
  172.  
  173. =over 4
  174.  
  175. =item B<getuid ( PID )>
  176.  
  177. C<getuid> returns the UID for the process passed in PID
  178.  
  179. =back
  180.  
  181.  
  182. =head1 NOTES
  183.  
  184. In its current avatar, Process uses the B<'ps'> utility found in most Unix and
  185. Unix-type systems. No attempt should be made to use it under Windows.
  186.  
  187. =head1 AUTHOR
  188.  
  189. Amit Saraff. Please report all bugs to <amitsaraff@gmail.com>.
  190.  
  191. =head1 COPYRIGHT
  192.  
  193. Copyright (c) 2009-2010 Amit Saraff <amitsaraff@gmail.com>. All rights reserved.
  194. This program is free software; you can redistribute it and/or
  195. modify it under the same terms as Perl itself.
  196.  
  197. =cut
clone this paste RAW Paste Data