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