muteW

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