view release on metacpan or  search on metacpan

lib/Class/Usul/IPC.pm  view on Meta::CPAN

use Class::Null;
use Class::Usul::Constants    qw( EXCEPTION_CLASS FALSE NUL OK SPC TRUE );
use Class::Usul::Functions    qw( arg_list get_user io loginid
                                  merge_attributes throw );
use Class::Usul::IPC::Cmd;
use Class::Usul::Time         qw( time2str );
use Class::Usul::Types        qw( Bool ConfigProvider Logger );
use English                   qw( -no_match_vars );
use Module::Load::Conditional qw( can_load );
use Unexpected::Functions     qw( Unspecified );
use Moo;

# Public attributes
has 'cache_ttys' => is => 'ro', isa => Bool, default => TRUE;

has 'config' => is => 'ro', isa => ConfigProvider, required => TRUE;

has 'log' => is => 'ro', isa => Logger, required => TRUE;

# Private functions
my $_cmd_matches = sub {
   my ($cmd, $pattern) = @_;

   return !$pattern || $cmd =~ m{ $pattern }msx ? TRUE : FALSE;
};

my $_new_proc_process_table = sub {
   my $cache_ttys = shift;

   can_load( modules => { 'Proc::ProcessTable' => '0' } )
      and return Proc::ProcessTable->new( cache_ttys => $cache_ttys );

   return Class::Null->new;
};

my $_proc_belongs_to_user = sub {
   my ($puid, $user) = @_;

   return (!$user || $user eq 'All' || $user eq loginid $puid) ? TRUE : FALSE;
};

my $_pscomp = sub {
   my ($arg1, $arg2) = @_; my $result;

   $result = $arg1->{uid} cmp $arg2->{uid};
   $result = $arg1->{pid} <=> $arg2->{pid} if ($result == 0);

   return $result;
};

my $_set_fields = sub {
   my ($has, $p) = @_; my $flds = {};

   $flds->{id   } = $has->{pid   } ? $p->pid                  : NUL;
   $flds->{pid  } = $has->{pid   } ? $p->pid                  : NUL;
   $flds->{ppid } = $has->{ppid  } ? $p->ppid                 : NUL;
   $flds->{start} = $has->{start } ? time2str( '%d/%m %H:%M', $p->start ) : NUL;
   $flds->{state} = $has->{state } ? $p->state                : NUL;
   $flds->{tty  } = $has->{ttydev} ? $p->ttydev               : NUL;
   $flds->{time } = $has->{time  } ? int $p->time / 1_000_000 : NUL;
   $flds->{uid  } = $has->{uid   } ? getpwuid $p->uid         : NUL;

   if ($has->{ttydev} and $p->ttydev) {
      $flds->{tty} = $p->ttydev;
   }
   elsif ($has->{ttynum} and $p->ttynum) {
      $flds->{tty} = $p->ttynum;
   }
   else { $flds->{tty} = NUL }

   if ($has->{rss} and $p->rss) {
      $flds->{size} = int $p->rss/1_024;
   }
   elsif ($has->{size} and $p->size) {
      $flds->{size} = int $p->size/1_024;
   }
   else { $flds->{size} = NUL }

   if ($has->{exec} and $p->exec) {
      $flds->{cmd} = substr $p->exec, 0, 64;
   }
   elsif ($has->{cmndline} and $p->cmndline) {
      $flds->{cmd} = substr $p->cmndline, 0, 64;
   }
   elsif ($has->{fname} and $p->fname) {
      $flds->{cmd} = substr $p->fname, 0, 64;
   }
   else { $flds->{cmd} = NUL }

   return $flds;
};

my $_signal_cmd = sub {
   my ($cmd, $flag, $sig, $pids) = @_; my $opts = [];

   $sig  and push @{ $opts }, '-o', "sig=${sig}";
   $flag and push @{ $opts }, '-o', 'flag=one';

   return [ $cmd, '-nc', 'signal_process', @{ $opts }, '--', @{ $pids || [] } ];
};

# Construction
around 'BUILDARGS' => sub {
   my ($orig, $self, @args) = @_; my $attr = $orig->( $self, @args );

   my $builder = $attr->{builder} or return $attr;

   merge_attributes $attr, $builder, [ 'config', 'log' ];

   return $attr;
};

my $_new_process_table = sub {
   my ($self, $rows, $count) = @_;

   return {
      count    => $count,
      fields   => [ qw( uid pid ppid start time size state tty cmd ) ],
      labels   => { uid   => 'User',   pid   => 'PID',
                    ppid  => 'PPID',   start => 'Start Time',
                    tty   => 'TTY',    time  => 'Time',