From 90bc9c9742d88e1d9573d36f027d6283dcf9be03 Mon Sep 17 00:00:00 2001 From: Brendan Byrd Date: Fri, 12 Oct 2012 17:47:53 -0400 Subject: [PATCH] Add Darwin Add new Process class with some changes to structure --- lib/P9Y/ProcessTable.pm | 23 +++++- lib/P9Y/ProcessTable/BSD.pm | 14 ++-- lib/P9Y/ProcessTable/Darwin.pm | 133 +++++++++++++++++++++++++++++++ lib/P9Y/ProcessTable/OS2.pm | 18 +++-- lib/P9Y/ProcessTable/ProcFS.pm | 20 ++--- lib/P9Y/ProcessTable/Process.pm | 137 ++++++++++++++++++++++++++++++++ lib/P9Y/ProcessTable/VMS.pm | 21 +++-- lib/P9Y/ProcessTable/Win32.pm | 106 +++++++++++++++++++++--- t/test.t | 7 ++ test.t | 7 -- 10 files changed, 436 insertions(+), 50 deletions(-) create mode 100644 lib/P9Y/ProcessTable/Darwin.pm create mode 100644 lib/P9Y/ProcessTable/Process.pm create mode 100644 t/test.t delete mode 100644 test.t diff --git a/lib/P9Y/ProcessTable.pm b/lib/P9Y/ProcessTable.pm index fb8ce87..574eb6f 100644 --- a/lib/P9Y/ProcessTable.pm +++ b/lib/P9Y/ProcessTable.pm @@ -32,11 +32,28 @@ BEGIN { require P9Y::ProcessTable::ProcFS; } else { - die "No idea how to handle $^O processes. Email me with more information!"; + die "No idea how to handle $^O processes. Email me with more information!"; } } } +} + +############################################################################# +# Common Methods (may potentially be redefined with OS-specific ones) + +sub table { + my $self = shift; + return map { $self->process($_) } ($self->list); +} +sub process { + my ($self, $pid) = @_; + $pid = $$ if (@_ == 1); + my $hash = $self->_process_hash($pid); + return unless $hash; + + $hash->{_pt_obj} = $self; + return P9Y::ProcessTable::Process->new($hash); } 42; @@ -46,9 +63,9 @@ __END__ =begin wikidoc = SYNOPSIS - + # code - + = DESCRIPTION ### Ruler ##################################################################################################################################12345 diff --git a/lib/P9Y/ProcessTable/BSD.pm b/lib/P9Y/ProcessTable/BSD.pm index 9c11a8c..7fe1124 100644 --- a/lib/P9Y/ProcessTable/BSD.pm +++ b/lib/P9Y/ProcessTable/BSD.pm @@ -1,4 +1,5 @@ -package P9Y::ProcessTable; +package # hide from PAUSE + P9Y::ProcessTable; # VERSION # ABSTRACT: BSD process table @@ -8,6 +9,7 @@ package P9Y::ProcessTable; use sanity; use Moo; +use P9Y::ProcessTable::Process; use BSD::Process; @@ -17,17 +19,12 @@ no warnings 'uninitialized'; ############################################################################# # Methods -sub table { - my $self = shift; - return map { $self->process($_) } ($self->list); -} - sub list { my $self = shift; return sort { $a <=> $b } (BSD::Process::list); } -sub process { +sub _process_hash { my ($self, $pid) = @_; my $info = BSD::Process::info($pid); return unless $info; @@ -69,6 +66,9 @@ sub process { my $item = $info->{ $stat_loc->{$key} }; $hash->{$key} = $item if defined $item; } + + $hash->{ ttlflt} = $hash->{ minflt} + $hash->{ majflt}; + $hash->{cttlflt} = $hash->{cminflt} + $hash->{cmajflt}; state $states = { stat_1 => 'forking', diff --git a/lib/P9Y/ProcessTable/Darwin.pm b/lib/P9Y/ProcessTable/Darwin.pm new file mode 100644 index 0000000..ee7ffbb --- /dev/null +++ b/lib/P9Y/ProcessTable/Darwin.pm @@ -0,0 +1,133 @@ +package # hide from PAUSE + P9Y::ProcessTable; + +# VERSION +# ABSTRACT: Darwin/OSX process table + +############################################################################# +# Modules + +use sanity; +use Moo; +use P9Y::ProcessTable::Process; + +use Proc::ProcessTable; +use List::AllUtils 'first'; + +use namespace::clean; +no warnings 'uninitialized'; + +my $pt = Proc::ProcessTable->new(); + +############################################################################# +# Methods + +# Unfortunately, P:PT has no concept of anything except "grab everything at once". So, we need to run +# through these wasteful cycles just to get one process, one list of PIDs, etc. + +no warnings 'redefine'; + +sub table { + my $self = shift; + return map { + my $hash = $self->_convert_hash($_); + $hash->{_pt_obj} = $self; + P9Y::ProcessTable::Process->new($hash); + } ($pt->table); +} + +sub list { + my $self = shift; + return sort { $a <=> $b } map { $_->pid } @{ $pt->table }; +} + +sub _process_hash { + my ($self, $pid) = @_; + my $info = first { $_->pid == $pid } @{ $pt->table }; + return unless $info; + return $self->_convert_hash; +} + +sub _convert_hash { + my ($self, $info) = @_; + return unless $info; + + my $hash = {}; + state $stat_loc = { qw/ + pid pid + ppid ppid + pgrp pgrp + uid uid + gid gid + euid euid + egid egid + suid suid + sgid sgid + priority priority + size size + rss rss + flags flags + nice nice + sess sess + time time + stime stime + utime utime + start start + wchan wchan + ttydev ttydev + ttynum ttynum + pctcpu pctcpu + pctmem pctmem + state state + cmdline cmndline + fname fname + / }; + + foreach my $key (keys %$stat_loc) { + no strict 'refs'; + my $old = $stat_loc->{$key}; + my $item = $info->$old(); + $hash->{$key} = $item if defined $item; + } + + $hash->{ ttlflt} = $hash->{ minflt} + $hash->{ majflt}; + $hash->{cttlflt} = $hash->{cminflt} + $hash->{cmajflt}; + + return $hash; +} + +42; + +__END__ + +=begin wikidoc + += SYNOPSIS + + # code + += DESCRIPTION + +### Ruler ##################################################################################################################################12345 + +Insert description here... + += CAVEATS + +### Ruler ##################################################################################################################################12345 + +Bad stuff... + += SEE ALSO + +### Ruler ##################################################################################################################################12345 + +Other modules... + += ACKNOWLEDGEMENTS + +### Ruler ##################################################################################################################################12345 + +Thanks and stuff... + +=end wikidoc diff --git a/lib/P9Y/ProcessTable/OS2.pm b/lib/P9Y/ProcessTable/OS2.pm index 34c67e0..9d11453 100644 --- a/lib/P9Y/ProcessTable/OS2.pm +++ b/lib/P9Y/ProcessTable/OS2.pm @@ -1,4 +1,5 @@ -package P9Y::ProcessTable; +package # hide from PAUSE + P9Y::ProcessTable; # VERSION # ABSTRACT: OS/2 process table @@ -8,6 +9,7 @@ package P9Y::ProcessTable; use sanity; use Moo; +use P9Y::ProcessTable::Process; use OS2::Process; @@ -17,9 +19,15 @@ no warnings 'uninitialized'; ############################################################################# # Methods +no warnings 'redefine'; + sub table { my $self = shift; - return map { $self->_process_hash($_) } (process_hentries); + return map { + my $hash = $self->_convert_hash($_); + $hash->{_pt_obj} = $self; + P9Y::ProcessTable::Process->new($hash); + } (process_hentries); } sub list { @@ -27,14 +35,14 @@ sub list { return sort { $a <=> $b } map { $_->{owner_pid} } (process_hentries); } -sub process { +sub _process_hash { my ($self, $pid) = @_; my $info = process_hentry($pid); return unless $info; - return $self->_process_hash($info); + return $self->_convert_hash; } -sub _process_hash { +sub _convert_hash { my ($self, $info) = @_; return unless $info; diff --git a/lib/P9Y/ProcessTable/ProcFS.pm b/lib/P9Y/ProcessTable/ProcFS.pm index 488f3d3..e54e06b 100644 --- a/lib/P9Y/ProcessTable/ProcFS.pm +++ b/lib/P9Y/ProcessTable/ProcFS.pm @@ -1,4 +1,5 @@ -package P9Y::ProcessTable; +package # hide from PAUSE + P9Y::ProcessTable; # VERSION # ABSTRACT: /proc FS process table @@ -8,6 +9,7 @@ package P9Y::ProcessTable; use sanity; use Moo; +use P9Y::ProcessTable::Process; use Path::Class; use File::Slurp 'read_file'; @@ -19,11 +21,6 @@ no warnings 'uninitialized'; ############################################################################# # Methods -sub table { - my $self = shift; - return map { $self->process($_) } ($self->list); -} - sub list { my $self = shift; @@ -40,7 +37,7 @@ sub list { return sort { $a <=> $b } @list; } -sub process { +sub _process_hash { my ($self, $pid) = @_; my $pdir = dir('', 'proc', $pid); @@ -95,7 +92,7 @@ sub process { }; state $stat_loc = [ qw( - pid fname state ppid pgrp sess ttynum . flags minflt cminflt cmajflt utime stime cutime cstime priority . threads . . + pid fname state ppid pgrp sess ttynum . flags minflt cminflt majflt cmajflt utime stime cutime cstime priority . threads . . size . rss . . . . . . . . . wchan . . . cpuid . . . . . ) ]; @@ -107,8 +104,11 @@ sub process { $hash->{fname} =~ s/^\((.+)\)$/$1/; $hash->{state} = $states->{ $hash->{state} }; - $hash->{time} = $hash->{utime} + $hash->{stime}; - $hash->{ctime} = $hash->{cutime} + $hash->{stime}; + $hash->{ time} = $hash->{ utime} + $hash->{ stime}; + $hash->{ctime} = $hash->{cutime} + $hash->{cstime}; + + $hash->{ ttlflt} = $hash->{ minflt} + $hash->{ majflt}; + $hash->{cttlflt} = $hash->{cminflt} + $hash->{cmajflt}; } elsif ($^O eq /solaris|sunos/i) { ### Solaris ### diff --git a/lib/P9Y/ProcessTable/Process.pm b/lib/P9Y/ProcessTable/Process.pm new file mode 100644 index 0000000..74802e3 --- /dev/null +++ b/lib/P9Y/ProcessTable/Process.pm @@ -0,0 +1,137 @@ +package P9Y::ProcessTable::Process; + +# VERSION +# ABSTRACT: Base class for a single process + +############################################################################# +# Modules + +use sanity; +use Moo; + +use namespace::clean; +no warnings 'uninitialized'; + +############################################################################# +# Attributes + +has _pt_obj => ( + is => 'ro', + required => 1, + handles => [qw( _process_hash )], +); + +has pid => ( is => 'ro', required => 1 ); +has uid => ( is => 'rwp', predicate => 1 ); +has gid => ( is => 'rwp', predicate => 1 ); +has euid => ( is => 'rwp', predicate => 1 ); +has egid => ( is => 'rwp', predicate => 1 ); +has ppid => ( is => 'rwp', required => 1 ); +has pgrp => ( is => 'rwp', predicate => 1 ); +has sess => ( is => 'rwp', predicate => 1 ); + +has cwd => ( is => 'rwp', predicate => 1 ); +has exe => ( is => 'rwp', predicate => 1 ); +has root => ( is => 'rwp', predicate => 1 ); +has cmdline => ( is => 'rwp', predicate => 1 ); +has environ => ( is => 'rwp', predicate => 1 ); + +has fname => ( is => 'rwp', predicate => 1 ); +has state => ( is => 'rwp', predicate => 1 ); +has ttynum => ( is => 'rwp', predicate => 1 ); +has flags => ( is => 'rwp', predicate => 1 ); +has minflt => ( is => 'rwp', predicate => 1 ); +has cminflt => ( is => 'rwp', predicate => 1 ); +has majflt => ( is => 'rwp', predicate => 1 ); +has cmajflt => ( is => 'rwp', predicate => 1 ); +has ttlflt => ( is => 'rwp', predicate => 1 ); +has cttlflt => ( is => 'rwp', predicate => 1 ); +has utime => ( is => 'rwp', predicate => 1 ); +has stime => ( is => 'rwp', predicate => 1 ); +has cutime => ( is => 'rwp', predicate => 1 ); +has cstime => ( is => 'rwp', predicate => 1 ); +has start => ( is => 'rwp', predicate => 1 ); +has time => ( is => 'rwp', predicate => 1 ); +has ctime => ( is => 'rwp', predicate => 1 ); +has priority => ( is => 'rwp', predicate => 1 ); +has threads => ( is => 'rwp', predicate => 1 ); +has size => ( is => 'rwp', predicate => 1 ); +has rss => ( is => 'rwp', predicate => 1 ); +has wchan => ( is => 'rwp', predicate => 1 ); +has cpuid => ( is => 'rwp', predicate => 1 ); +has pctcpu => ( is => 'rwp', predicate => 1 ); +has pctmem => ( is => 'rwp', predicate => 1 ); + +############################################################################# +# Common Methods (may potentially be redefined with OS-specific ones) + +sub refresh { + my ($self) = @_; + my $hash = $self->_process_hash($self->pid); + return unless $hash; + + # use set methods + foreach my $meth (keys %$hash) { + no strict 'refs'; + $self->("_set_$meth")($hash->{$meth}) if (exists $hash->{$meth}); + } + + return $self; +} + +sub kill { + my ($self, $sig) = @_; + return CORE::kill($sig, $self->pid); +} + +sub pgrp { + my ($self, $pgrp) = @_; + return $self->{pgrp} if @_ == 1; + + setpgrp($self->pid, $pgrp); + $self->_set_pgrp($pgrp); +} + +sub priority { + my ($self, $pri) = @_; + return $self->{priority} if @_ == 1; + + setpriority(0, $self->pid, $pri); + $self->_set_priority($pri); +} + +42; + +__END__ + +=begin wikidoc + += SYNOPSIS + + # code + += DESCRIPTION + +### Ruler ##################################################################################################################################12345 + +Insert description here... + += CAVEATS + +### Ruler ##################################################################################################################################12345 + +Bad stuff... + += SEE ALSO + +### Ruler ##################################################################################################################################12345 + +Other modules... + += ACKNOWLEDGEMENTS + +### Ruler ##################################################################################################################################12345 + +Thanks and stuff... + +=end wikidoc diff --git a/lib/P9Y/ProcessTable/VMS.pm b/lib/P9Y/ProcessTable/VMS.pm index c894432..8712543 100644 --- a/lib/P9Y/ProcessTable/VMS.pm +++ b/lib/P9Y/ProcessTable/VMS.pm @@ -1,4 +1,5 @@ -package P9Y::ProcessTable; +package # hide from PAUSE + P9Y::ProcessTable; # VERSION # ABSTRACT: VMS process table @@ -8,6 +9,7 @@ package P9Y::ProcessTable; use sanity; use Moo; +use P9Y::ProcessTable::Process; use VMS::Process; @@ -19,24 +21,33 @@ no warnings 'uninitialized'; sub table { my $self = shift; - return map { $self->process($_) } ($self->list); + return map { + my $hash = $self->_convert_hash($_); + $hash->{_pt_obj} = $self; + P9Y::ProcessTable::Process->new($hash); + } (process_list); } sub list { my $self = shift; - return sort { $a <=> $b } ( ); ### FIXME ### + return sort { $a <=> $b } map { $_->{PID} } (process_list); } -sub process { +sub _process_hash { my ($self, $pid) = @_; my $info = process_list({ NAME => 'MASTER_PID', VALUE => $pid, }); return unless $info; + return $self->_convert_hash; +} +sub _convert_hash { + my ($self, $info) = @_; + return unless $info; + my $hash = {}; - state $stat_loc = { qw/ pid PID uid OWNER diff --git a/lib/P9Y/ProcessTable/Win32.pm b/lib/P9Y/ProcessTable/Win32.pm index 18d001c..86b6fb5 100644 --- a/lib/P9Y/ProcessTable/Win32.pm +++ b/lib/P9Y/ProcessTable/Win32.pm @@ -1,4 +1,5 @@ -package P9Y::ProcessTable; +package # hide from PAUSE + P9Y::ProcessTable; # VERSION # ABSTRACT: Win32 process table @@ -8,7 +9,9 @@ package P9Y::ProcessTable; use sanity; use Moo; +use P9Y::ProcessTable::Process; +use Win32::Process; use Win32::Process::Info; use namespace::clean; @@ -19,10 +22,7 @@ my $pi = Win32::Process::Info->new(); ############################################################################# # Methods -sub table { - my $self = shift; - return map { $self->process($_) } ($self->list); -} +no warnings 'redefine'; sub list { my $self = shift; @@ -30,11 +30,21 @@ sub list { } sub process { + my ($self, $pid) = @_; + $pid = Win32::Process::GetCurrentProcessID if (@_ == 1); # changed here... + my $hash = $self->_process_hash($pid); + return unless $hash; + + $hash->{_pt_obj} = $self; + return P9Y::ProcessTable::Process->new($hash); +} + +sub _process_hash { my ($self, $pid) = @_; my $info = $pi->GetProcInfo($pid); return unless $info; $info = $info->[0]; - + my $hash = {}; state $stat_loc = { qw/ pid ProcessId @@ -44,7 +54,7 @@ sub process { exe ExecutablePath threads ThreadCount priority Priority - minflt PageFaults + ttlflt PageFaults utime UserModeTime stime KernelModeTime size VirtualSize @@ -54,19 +64,89 @@ sub process { state Status cmdline CommandLine / }; - + foreach my $key (keys %$stat_loc) { my $item = $info->{ $stat_loc->{$key} }; $hash->{$key} = $item if defined $item; } - + $hash->{exe} =~ /^(\w\:\\)/; - $hash->{root} = $1; + $hash->{root} = $1; $hash->{time} = $hash->{utime} + $hash->{stime}; - + return $hash; } +############################################################################# +# Process side + +### FIXME: Can't get Win32::API to not crash on me... ### + +package # hide from PAUSE + P9Y::ProcessTable::Process; + +use Win32::Process; +#use Win32::API; +#use Win32::API::Callback; + +BEGIN { + #Win32::API->Import( 'user32', 'EnumWindows', 'KN', 'N' ); + #Win32::API->Import( 'user32', 'GetWindowThreadProcessId', 'NP', 'N' ); + #Win32::API->Import( 'user32', 'PostMessage', 'NINN', 'N' ); +} + +no warnings 'redefine'; + +sub _win32_proc { + my $self = shift; + my $obj; + Win32::Process::Open($obj, $self->pid, 0); + return $obj; +} + +sub kill { + my ($self, $sig) = @_; + + # Windows's signal.h actually has plenty of gaps, but it still follows Linux's model where + # there isn't gaps. Thus, we'll just fill in the blanks. + + # POSIX = 0 HUP INT QUIT ILL TRAP ABRT . FPE KILL . SEGV . PIPE ALRM TERM . . . . . . ABRT + # 0x0010 = WM_CLOSE + state $posix2wm = [ + 0, 0x0010, 0x0010, qw/kill kill kill kill . kill kill . kill ./, 0x0010, 0x0010, 0x0010, qw/. . . . . . kill/ + ]; + + $sig = $posix2wm->[$sig]; + return if (!$sig || $sig eq '.'); + if ($sig eq '0') { + return CORE::kill($sig, $self->pid); + } + elsif ($sig eq 'kill') { + return $self->_win32_proc->Kill(255); + } + else { + #my $cb = Win32::API::Callback->new( sub { + # my $hwnd = shift; + # my $pid = 0; + # + # #GetWindowThreadProcessId($hwnd, \$pid); + # print "foo\n"; + # #PostMessage($hwnd, $sig) if ($$pid && $$pid == $self->pid); + #}, "NN", "N" ); + # + #my $ret = EnumWindows($cb, 0); + return $self->_win32_proc->Kill(255); + } +} + +sub priority { + my ($self, $pri) = @_; + return $self->{priority} if @_ == 1; + + $self->_win32_proc->SetPriorityClass($pri); + $self->_set_priority($pri); +} + 42; __END__ @@ -74,9 +154,9 @@ __END__ =begin wikidoc = SYNOPSIS - + # code - + = DESCRIPTION ### Ruler ##################################################################################################################################12345 diff --git a/t/test.t b/t/test.t new file mode 100644 index 0000000..03671e5 --- /dev/null +++ b/t/test.t @@ -0,0 +1,7 @@ +use Test::Most; +use P9Y::ProcessTable; + +lives_ok { P9Y::ProcessTable->table } 'get table'; + + +dd \@list; diff --git a/test.t b/test.t deleted file mode 100644 index cf6ab3f..0000000 --- a/test.t +++ /dev/null @@ -1,7 +0,0 @@ -use P9Y::ProcessTable; -use Data::Dump; - -my $p = P9Y::ProcessTable->new; -my @list = $p->table; - -dd \@list;