summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm306
1 files changed, 0 insertions, 306 deletions
diff --git a/Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm b/Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm
deleted file mode 100644
index 17a9643dc05..00000000000
--- a/Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm
+++ /dev/null
@@ -1,306 +0,0 @@
-=head1 NAME
-
-Win32::Process::Info::PT - Provide process information via Proc::ProcessTable.
-
-=head1 SYNOPSIS
-
-This package fetches process information on a given machine, using Dan
-Urist's B<Proc::ProcessTable>. This makes the 'Win32::' part of our name
-bogus, but lets one use the same basic interface under a wider range of
-operating systems.
-
- use Win32::Process::Info
- $pi = Win32::Process::Info->new (undef, 'PT');
- $pi->Set (elapsed_as_seconds => 0); # In clunks, not seconds.
- @pids = $pi->ListPids (); # Get all known PIDs
- @info = $pi->GetProcInfo (); # Get the max
-
-CAVEAT USER:
-
-This package does not support access to a remote machine,
-because the underlying API doesn't. If you specify a machine
-name (other than '', 0, or undef) when you instantiate a
-new Win32::Process::Info::PT object, you will get an exception.
-
-This package is B<not> intended to be used independently;
-instead, it is a subclass of Win32::Process::Info, and should
-only be called via that package.
-
-=head1 DESCRIPTION
-
-The main purpose of the Win32::Process::Info::PT package is to get
-whatever information is convenient (for the author!) about one or more
-processes. GetProcInfo (which see) is therefore the most-important
-method in the package. See it for more information.
-
-This package returns whatever process IDs are made available by
-Proc::ProcessTable. Under Cygwin, this seems to mean Cygwin process IDs,
-not Windows process IDs.
-
-Unless explicitly stated otherwise, modules, variables, and so
-on are considered private. That is, the author reserves the right
-to make arbitrary changes in the way they work, without telling
-anyone. For subroutines, variables, and so on which are considered
-public, the author will make an effort keep them stable, and failing
-that to call attention to changes.
-
-Nothing is exported by default, though all the public subroutines are
-exportable, either by name or by using the :all tag.
-
-The following subroutines should be considered public:
-
-=over
-
-=cut
-
-# 0.001 18-Sep-2007 T. R. Wyant
-# Initial release.
-# 0.001_01 01-Apr-2009 T. R. Wyant
-# Make Perl::Critic compliant (to -stern, with my own profile)
-# 0.002 02-Apr-2009 T. R. Wyant
-# Production version.
-# 0.002_01 07-Apr-2009 T. R. Wyant
-# Use $self->_build_hash(), so that we test it.
-
-package Win32::Process::Info::PT;
-
-use strict;
-use warnings;
-
-use base qw{ Win32::Process::Info };
-
-our $VERSION = '1.020';
-
-use Carp;
-use File::Basename;
-use Proc::ProcessTable;
-
-# TODO figure out what we need to do here.
-
-my %_transform = (
-## CreationDate => \&Win32::Process::Info::_date_to_time_t,
- KernelModeTime => \&Win32::Process::Info::_clunks_to_desired,
- UserModeTime => \&Win32::Process::Info::_clunks_to_desired,
- );
-
-my %lglarg = map {($_, 1)} qw{assert_debug_priv variant};
-
-sub new {
- my $class = shift;
- $class = ref $class if ref $class;
- my $arg = shift;
- if (ref $arg eq 'HASH') {
- my @ilg = grep {!$lglarg{$_}} keys %$arg;
- @ilg and
- croak "Error - Win32::Process::Info::PT argument(s) (@ilg) illegal";
- } else {
- croak "Error - Win32::Process::Info::PT does not support remote operation."
- if $arg;
- }
- no warnings qw{once};
- my $self = {%Win32::Process::Info::static};
- use warnings qw{once};
- delete $self->{variant};
- $self->{_xfrm} = \%_transform;
- bless $self, $class;
- return $self;
-}
-
-
-=item @info = $pi->GetProcInfo ();
-
-This method returns a list of anonymous hashes, each containing
-information on one process. If no arguments are passed, the
-list represents all processes in the system. You can pass a
-list of process IDs, and get out a list of the attributes of
-all such processes that actually exist. If you call this
-method in scalar context, you get a reference to the list.
-
-What keys are available depend on the variant in use. With the PT
-variant you can hope to get at most the following keys. The caveat is
-that the Win32::Process::Info keys are derived from
-Proc::ProcessTable::Process fields, and if your OS does not support the
-underlying field, you will not get it. Here are the possible keys and
-the fields from which they are derived:
-
- CreationDate: start
- Description: cmndline
- ExecutablePath: fname (note 1)
- KernelModeTime: stime (note 2)
- Name: basename (fname)
- Owner: '\' . getpwuid (uid) (note 3)
- OwnerSid: uid (note 4)
- ParentProcessId: ppid
- ProcessId: pid
- UserModeTime: utime (note 2)
-
-Notes:
-
-1) ExecutablePath may not be an absolute pathname.
-
-2) We assume that Proc::ProcessTable::Process returns stime and utime in
-microseconds, and multiply by 10 to get clunks. This may be wrong under
-some operating systems.
-
-3) Owner has a backslash prefixed because Windows returns domain\user. I
-don't see a good way to get domain, but I wanted to be consistent (read:
-I was too lazy to special-case the test script).
-
-4) Note that under Cygwin this is B<not> the same as the Windows PID,
-which is returned in field 'winpid'. But the Subprocesses method needs
-the ProcessId and ParentProcessId to be consistent, and there was no
-documented 'winppid' field.
-
-The output will contain all processes for which information was
-requested, but will not necessarily contain all information for
-all processes.
-
-The _status key of the process hash contains the status of
-GetProcInfo's request(s) for information. In the case of
-Win32::Process::Info::PT, this will always be 0, but is provided
-to be consistent with the other variants.
-
-=cut
-
-{
-
- my %pw_uid;
- my %fld_map = (
- cmndline => 'Description',
- fname => sub {
- my ($info, $proc) = @_;
- $info->{Name} = basename (
- $info->{ExecutablePath} = $proc->fname ());
- },
- pid => 'ProcessId',
- ppid => 'ParentProcessId',
- start => 'CreationDate',
-## stime => 'KernelModeTime',
-## utime => 'UserModeTime',
- stime => sub {
- my ($info, $proc) = @_;
- $info->{KernelModeTime} = $proc->stime() * 10;
- },
- utime => sub {
- my ($info, $proc) = @_;
- $info->{UserModeTime} = $proc->utime() * 10;
- },
- uid => sub {
- my ($info, $proc) = @_;
- $info->{OwnerSid} = my $uid = $proc->uid ();
- $info->{Owner} = $pw_uid{$uid} ||= '\\' . getpwuid($uid);
- },
- );
- my @fld_sup = grep { defined $_ } Proc::ProcessTable->new ()->fields ();
-
- sub GetProcInfo {
- my ($self, @args) = @_;
-
- my $my_pid = $self->My_Pid();
- my $opt = ref $args[0] eq 'HASH' ? shift @args : {};
- my $tbl = Proc::ProcessTable->new ()->table ();
-
- if (@args) {
- my %filter = map {
- ($_ eq '.' ? $my_pid : $_) => 1
- } @args;
- $tbl = [grep {$filter{$_->pid ()}} @$tbl];
- }
- my @pinf;
- foreach my $proc (@$tbl) {
- my $info = {_status => 0};
- foreach my $key (@fld_sup) {
- my $name = $fld_map{$key} or next;
- if (ref $name eq 'CODE') {
- $name->($info, $proc);
- } else {
- # Yes, we could just plop the information into the
- # hash. But _build_hash() needs to be called in
- # every variant so it gets tested under any
- # variant.
- $self->_build_hash($info, $name, $proc->$key());
- }
- }
- push @pinf, $info;
- }
- return wantarray ? @pinf : \@pinf;
- }
-
-}
-
-=item @pids = $pi->ListPids ()
-
-This subroutine returns a list of all known process IDs in the
-system, in no particular order. If called in list context, the
-list of process IDs itself is returned. In scalar context, a
-reference to the list is returned.
-
-=cut
-
-sub ListPids {
- my ($self, @args) = @_;
-
- my $tbl = Proc::ProcessTable->new ()->table ();
- my $my_pid = $self->My_Pid();
- my @pids;
-
- if (@args) {
- my %filter = map {
- ($_ eq '.' ? $my_pid : $_) => 1
- } @args;
- @pids = grep {$filter{$_}} map {$_->pid} @$tbl;
- } else {
- @pids = map {$_->pid} @$tbl;
- }
- return wantarray ? @pids : \@pids;
-}
-
-sub My_Pid {
- return $$;
-}
-
-=back
-
-=head1 REQUIREMENTS
-
-This library uses the following libraries:
-
- Carp
- Time::Local
- Proc::ProcessTable
-
-As of this writing, all but Proc::ProcessTable are part of the
-standard Perl distribution.
-
-=head1 ACKNOWLEDGMENTS
-
-This module would not exist without the following people
-
-Dan Urist, author (or at least coordinator) of the Proc::ProcessTable
-module, upon which this is based.
-
-Jenda Krynicky, whose "How2 create a PPM distribution"
-(F<http://jenda.krynicky.cz/perl/PPM.html>) gave me a leg up on
-both PPM and tar distributions.
-
-=head1 AUTHOR
-
-Thomas R. Wyant, III (F<wyant at cpan dot org>)
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2007, 2009-2011, 2013 by Thomas R. Wyant, III
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl 5.10.0. For more details, see the full text
-of the licenses in the directory LICENSES.
-
-This program is distributed in the hope that it will be useful, but
-without any warranty; without even the implied warranty of
-merchantability or fitness for a particular purpose.
-
-=cut
-
-# ex: set textwidth=72 :
-
-1;