Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- package Process;
- use strict;
- use warnings;
- use Carp;
- our (@ISA, $VERSION, @EXPORT_OK);
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(
- );
- $VERSION = "0.2";
- sub new {
- ## Store the process details in $self as a
- ## reference of a hash to a hash.
- my $class = shift;
- my $self = {};
- ## Get list of process using 'ps'
- my @psList = `ps --no-headers -eo user,pid,ppid,tname,comm`;
- return undef if $?;
- for (@psList) {
- my @psDet = split;
- my $pid = $psDet[1];
- $self->{$pid}{UID} = $psDet[0];
- $self->{$pid}{PPID} = $psDet[2];
- $self->{$pid}{TERM} = $psDet[3];
- $self->{$pid}{CMD} = join " ", @psDet[4..$#psDet];
- }
- bless $self, $class;
- return $self;
- }
- ## Returns list of process id's owned by user
- sub getbyuser {
- my $self = shift;
- my $user = shift;
- carp "No object specified" unless(ref $self);
- carp "No user specified : obj->getbyuser(\"uname\")" unless($user);
- my @psList;
- for my $pid (keys %$self) {
- push @psList, $pid
- if( $self->{$pid}{UID} eq $user );
- }
- return @psList;
- }
- ## Return list of process id's with matching cmd's
- sub getbycmd {
- my $self = shift;
- my $cmd = shift;
- carp 'No object specified' unless(ref $self);
- carp 'No cmd specified : obj->getbycmd("cmd")' unless ($cmd);
- eval { "" =~ m/$cmd/ };
- carp "Invalid regex passed to getbycmd()\n"
- if $@;
- my @psList;
- for my $pid (keys %$self) {
- ##TODO: Is there a need to metaquote $cmd
- ##or should we assume that $cmd is a valid regex?
- push @psList, $pid
- if ( $self->{$pid}{CMD} =~ m/$cmd/i );
- }
- return @psList;
- }
- ## Return process details as a hash
- ## PID, UID, PPID, TERM, CMD
- sub getdetail {
- my $self = shift;
- my $pid = shift;
- carp 'No object specified' unless(ref $self);
- carp 'No PID specified : obj->getdetail("pid")' unless ($pid);
- return undef
- unless exists $self->{$pid};
- my %psDet = %{ $self->{$pid} };
- $psDet{PID} = $pid;
- return \%psDet;
- }
- ## Return UID for specified process
- sub getuid {
- my $self = shift;
- my $pid = shift;
- carp 'No object specified' unless(ref $self);
- carp 'No PID specified : obj->getdetail("pid")' unless ($pid);
- return ( exists $self->{$pid} ? $self->{$pid}{UID} : undef );
- }
- 1;
- __END__
- =head1 NAME
- Process - build a list of current processes in the system
- =head1 SYNOPSIS
- use Process;
- my $ps = Process->new() or die "Process: Cannot build process list $!";
- foreach ($ps->getbyuser('user')) {
- print $ps->getdetail($_);
- }
- =head1 DESCRIPTION
- The C<Process> package provides an interface to the system processes with
- the help of specific routines.
- =over 4
- =item B<new ( )>
- C<new> is the constructor for C<Process> objects. It accepts no arguments
- and builds a list of processes currently in the system
- =back
- =over 4
- =item B<getbyuser ( USERNAME )>
- This returns a list of process id's for the user specified in argument 1. The
- user name match is a case-sensitive check and expects to get the complete
- user name in order to generate the correspnding list.
- =back
- =over 4
- =item B<getbycmd ( CMDNAME )>
- This returns a list of process id's whose process name matches the passed
- argument. The match accepts regex's to find matching processes. Command-line
- arguments to running processes are not matched with the user-specified
- CMDNAME.
- =back
- =over 4
- =item B<getdetail ( PID )>
- C<getdetail> collects the details of the specified PID and returns it
- as a hash reference with the following keys :
- PID [Process ID]
- PPID [Process parent ID]
- UID [User ID]
- TERM [tty]
- CMD [Command name]
- =back
- =over 4
- =item B<getuid ( PID )>
- C<getuid> returns the UID for the process passed in PID
- =back
- =head1 NOTES
- In its current avatar, Process uses the B<'ps'> utility found in most Unix and
- Unix-type systems. No attempt should be made to use it under Windows.
- =head1 AUTHOR
- Amit Saraff. Please report all bugs to <amitsaraff@gmail.com>.
- =head1 COPYRIGHT
- Copyright (c) 2009-2010 Amit Saraff <amitsaraff@gmail.com>. All rights reserved.
- This program is free software; you can redistribute it and/or
- modify it under the same terms as Perl itself.
- =cut
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement