Added Win32::Process::Info module

git-svn-id: svn://tug.org/texlive/trunk@23119 c570f23f-e606-0410-a88d-b1316a301751

4 files changed, 2526 insertions, 0 deletions

diff --git a/Master/tlpkg/tlperl/lib/Win32/Process/Info.pm b/Master/tlpkg/tlperl/lib/Win32/Process/Info.pm
new file mode 100644
index 00000000000..6164c18d37b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Process/Info.pm
@@ -0,0 +1,964 @@
+=head1 NAME
+
+Win32::Process::Info - Provide process information for Windows 32 systems.
+
+=head1 SYNOPSIS
+
+ use Win32::Process::Info;
+ $pi = Win32::Process::Info->new ();
+ $pi->Set (elapsed_in_seconds => 0);	# In clunks, not seconds.
+ @pids = $pi->ListPids ();	# Get all known PIDs
+ @info = $pi->GetProcInfo ();	# Get the max
+ %subs = $pi->Subprocesses ();	# Figure out subprocess relationships.
+ @info = grep {
+     defined $_->{Name} &&
+     $_->{Name} =~ m/perl/
+ } $pi->GetProcInfo ();        # All processes with 'perl' in name.
+
+=head1 NOTICE
+
+This package covers a multitude of sins - as many as Microsoft has
+invented ways to get process info and I have resources and gumption
+to code. The key to this mess is the 'variant' argument to the 'new'
+method (q.v.).
+
+The WMI variant has various problems, known or suspected to be inherited
+from Win32::OLE. See L</BUGS> for the gory details. The worst of these
+is that if you use fork(), you B<must> disallow WMI completely by
+loading this module as follows:
+
+ use Win32::Process::Info qw{NT};
+
+This method of controlling things must be considered experimental until
+I can confirm it causes no unexpected insurmountable problems. If I am
+forced to change it, the change will be flagged prominently in the
+documentation.
+
+This change is somewhat incompatible with 1.006 and earlier because it
+requires the import() method to be called in the correct place with the
+correct arguments. If you C<require Win32::Process::Info>, you B<must>
+explicitly call Win32::Process::Info->import().
+
+See the import() documentation below for the details.
+
+B<YOU HAVE BEEN WARNED!>
+
+=head1 DESCRIPTION
+
+The main purpose of the Win32::Process::Info package is to get whatever
+information is convenient (for the author!) about one or more Windows
+32 processes. L</GetProcInfo> is therefore the most-important
+method in the package. See it for more information.
+
+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 methods, 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.
+
+The following methods should be considered public:
+
+=over 4
+
+=cut
+
+package Win32::Process::Info;
+
+use 5.006;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.018';
+
+use Carp;
+use File::Spec;
+use Time::Local;
+
+our %static = (
+    elapsed_in_seconds	=> 1,
+    variant		=> $ENV{PERL_WIN32_PROCESS_INFO_VARIANT},
+    );
+
+#	The real reason for the %variant_support hash is to deal with
+#	the apparant inability of Win32::API to be 'require'-d anywhere
+#	but in a BEGIN block. The 'unsupported' key is intended to be
+#	used as a 'necessary but not required' criterion; that is, if
+#	'unsupported' is true, there's no reason to bother; but if it's
+#	false, there may still be problems of some sort. This is par-
+#	ticularly true of WMI, where the full check is rather elephan-
+#	tine.
+#
+#	The actual 'necessary but not required' check has moved to
+#	{check_support}, with {unsupported} simply holding the result of
+#	the check. The {check_support} key is code to be executed when
+#	the import() hook is called when the module is loaded.
+#
+#	While I was at it, I decided to consolidate all the variant-
+#	specific information in one spot and, while I was at it, write
+#	a variant checker utility.
+
+my %variant_support;
+BEGIN {
+    %variant_support = (
+	NT => {
+	    check_support => sub {
+		local $@;
+		eval {
+		    require Win32;
+		    Win32->can( 'IsWinNT' ) && Win32::IsWinNT();
+		} or return "$^O is not a member of the Windows NT family";
+		eval { require Win32::API; 1 }
+		    or return 'I can not find Win32::API';
+		my @path = File::Spec->path();
+DLL_LOOP:
+		foreach my $dll (qw{PSAPI.DLL ADVAPI32.DLL KERNEL32.DLL}) {
+		    foreach my $loc (@path) {
+			next DLL_LOOP if -e File::Spec->catfile ($loc, $dll);
+		    }
+		    return "I can not find $dll";
+		}
+		return 0;
+	    },
+	    make => sub {
+		require Win32::Process::Info::NT;
+		Win32::Process::Info::NT->new (@_);
+	    },
+	    unsupported => "Disallowed on load of @{[__PACKAGE__]}.",
+	},
+	PT => {
+	    check_support => sub {
+		local $@;
+		return "Unable to load Proc::ProcessTable"
+		    unless eval {require Proc::ProcessTable; 1};
+		return 0;
+	    },
+	    make => sub {
+		require Win32::Process::Info::PT;
+		Win32::Process::Info::PT->new (@_);
+	    },
+	    unsupported => "Disallowed on load of @{[__PACKAGE__]}.",
+	},
+	WMI => {
+	    check_support => sub {
+		local $@;
+		_isReactOS()
+		    and return 'Unsupported under ReactOS';
+		eval {
+		    require Win32::OLE;
+		    1;
+		} or return 'Unable to load Win32::OLE';
+		my ( $wmi, $proc );
+		my $old_warn = Win32::OLE->Option( 'Warn' );
+		eval {
+		    Win32::OLE->Option( Warn => 0 );
+		    $wmi = Win32::OLE->GetObject(
+			'winmgmts:{impersonationLevel=impersonate,(Debug)}!//./root/cimv2'
+		    );
+		    $wmi and $proc = $wmi->Get( "Win32_Process='$$'" );
+		};
+		Win32::OLE->Option( Warn => $old_warn );
+		$wmi or return 'Unable to get WMI object';
+		$proc or return 'WMI broken: unable to get process object';
+		return 0;
+	    },
+	    make => sub {
+		require Win32::Process::Info::WMI;
+		Win32::Process::Info::WMI->new (@_);
+	    },
+	    unsupported => "Disallowed on load of @{[__PACKAGE__]}.",
+	},
+    );
+}
+
+our %mutator = (
+    elapsed_in_seconds	=> sub {$_[2]},
+    variant		=> sub {
+	ref $_[0]
+	    and eval { $_[0]->isa( 'Win32::Process::Info' ) }
+	    or croak 'Variant can not be set on an instance';
+	foreach (split '\W+', $_[2]) {
+	    my $status;
+	    $status = variant_support_status( $_ )
+		and croak "Variant '$_' unsupported on your configuration; ",
+		    $status;
+	}
+	$_[2]
+    },
+);
+
+
+=item $pi = Win32::Process::Info->new ([machine], [variant], [hash])
+
+This method instantiates a process information object, connected
+to the given machine, and using the given variant.
+
+The following variants are currently supported:
+
+NT - Uses the NT-native mechanism. Good on any NT, including
+Windows 2000. This variant does not support connecting to
+another machine, so the 'machine' argument must be an
+empty string (or undef, if you prefer).
+
+PT - Uses Dan Urist's Proc::ProcessTable, making it possible
+(paradoxically) to use this module on other operating systems than
+Windows. Only those Proc::ProcessTable::Process fields which seem
+to correspond to WMI items are returned. B<Caveat:> the PT variant
+is to be considered experimental, and may be changed or retracted
+in future releases.
+
+WMI - Uses the Windows Management Implementation. Good on Win2K, ME,
+and possibly others, depending on their vintage and whether
+WMI has been retrofitted.
+
+The initial default variant comes from environment variable
+PERL_WIN32_PROCESS_INFO_VARIANT. If this is not found, it will be
+'WMI,NT,PT', which means to try WMI first, NT if WMI fails, and PT as a
+last resort. This can be changed using Win32::Process::Info->Set
+(variant => whatever).
+
+The hash argument is a hash reference to additional arguments, if
+any. The hash reference can actually appear anywhere in the argument
+list, though positional arguments are illegal after the hash reference.
+
+The following hash keys are supported:
+
+  variant => corresponds to the 'variant' argument (all)
+  assert_debug_priv => assert debug if available (all) This
+	only has effect under WMI. The NT variant always
+	asserts debug. You want to be careful doing this
+	under WMI if you're fetching the process owner
+	information, since the script can be badly behaved
+	(i.e. die horribly) for those processes whose
+	ExecutablePath is only available with the debug
+	privilege turned on.
+  host => corresponds to the 'machine' argument (WMI)
+  user => username to perform operation under (WMI)
+  password => password corresponding to the given
+	username (WMI)
+
+ALL hash keys are optional. SOME hash keys are only supported under
+certain variants. These are indicated in parentheses after the
+description of the key. It is an error to specify a key that the
+variant in use does not support.
+
+=cut
+
+my @argnam = qw{host variant};
+sub new {
+    my ($class, @params) = @_;
+    $class = ref $class if ref $class;
+    my %arg;
+    my ( $self, @probs );
+
+    my $inx = 0;
+    foreach my $inp (@params) {
+	if (ref $inp eq 'HASH') {
+	    foreach my $key (keys %$inp) {$arg{$key} = $inp->{$key}}
+	} elsif (ref $inp) {
+	    croak "Argument may not be @{[ref $inp]} reference.";
+	} elsif ($argnam[$inx]) {
+	    $arg{$argnam[$inx]} = $inp;
+	} else {
+	    croak "Too many positional arguments.";
+	}
+	$inx++;
+    }
+
+    _import_done()
+	or croak __PACKAGE__,
+	    '->import() must be called before calling ', __PACKAGE__,
+	    '->new()';
+    my $mach = $arg{host} or delete $arg{host};
+    my $try = $arg{variant} || $static{variant} || 'WMI,NT,PT';
+    foreach my $variant (grep {$_} split '\W+', $try) {
+	my $status;
+	$status = variant_support_status( $variant ) and do {
+	    push @probs, $status;
+	    next;
+	};
+	my $self;
+	$self = $variant_support{$variant}{make}->( \%arg ) and do {
+	    $static{variant} ||= $self->{variant} = $variant;
+	};
+	return $self;
+    }
+    croak join '; ', @probs;
+}
+
+=item @values = $pi->Get (attributes ...)
+
+This method returns the values of the listed attributes. If
+called in scalar context, it returns the value of the first
+attribute specified, or undef if none was. An exception is
+raised if you specify a non-existent attribute.
+
+This method can also be called as a class method (that is, as
+Win32::Process::Info->Get ()) to return default attributes values.
+
+The relevant attribute names are:
+
+B<elapsed_as_seconds> is TRUE to convert elapsed user and
+kernel times to seconds. If FALSE, they are returned in
+clunks (that is, hundreds of nanoseconds). The default is
+TRUE.
+
+B<variant> is the variant of the Process::Info code in use,
+and should be zero or more of 'WMI' or 'NT', separated by
+commas. 'WMI' selects the Windows Management Implementation, and
+'NT' selects the Windows NT native interface.
+
+B<machine> is the name of the machine connected to. This is
+not available as a class attribute.
+
+=cut
+
+sub Get {
+my ($self, @args) = @_;
+$self = \%static unless ref $self;
+my @vals;
+foreach my $name (@args) {
+    croak "Error - Attribute '$name' does not exist."
+	unless exists $self->{$name};
+    croak "Error - Attribute '$name' is private."
+	if $name =~ m/^_/;
+    push @vals, $self->{$name};
+    }
+return wantarray ? @vals : $vals[0];
+}
+
+=item @values = $pi->Set (attribute => value ...)
+
+This method sets the values of the listed attributes,
+returning the values of all attributes listed if called in
+list context, or of the first attribute listed if called
+in scalar context.
+
+This method can also be called as a class method (that is, as
+Win32::Process::Info->Set ()) to change default attribute values.
+
+The relevant attribute names are the same as for Get.
+However:
+
+B<variant> is read-only at the instance level. That is,
+Win32::Process::Info->Set (variant => 'NT') is OK, but
+$pi->Set (variant => 'NT') will raise an exception. If
+you set B<variant> to an empty string (the default), the
+next "new" will iterate over all possibilities (or the
+contents of environment variable
+PERL_WIN32_PROCESS_INFO_VARIANT if present), and set
+B<variant> to the first one that actually works.
+
+B<machine> is not available as a class attribute, and is
+read-only as an instance attribute. It is B<not> useful for
+discovering your machine name - if you instantiated the
+object without specifying a machine name, you will get
+nothing useful back.
+
+=cut
+
+sub Set {
+my ($self, @args) = @_;
+croak "Error - Set requires an even number of arguments."
+    if @args % 2;
+$self = \%static unless ref $self;
+my $mutr = $self->{_mutator} || \%mutator;
+my @vals;
+while (@args) {
+    my $name = shift @args;
+    my $val = shift @args;
+    croak "Error - Attribute '$name' does not exist."
+	unless exists $self->{$name};
+    croak "Error - Attribute '$name' is read-only."
+	unless exists $mutr->{$name};
+    $self->{$name} = $mutr->{$name}->($self, $name, $val);
+    push @vals, $self->{$name};
+    }
+return wantarray ? @vals : $vals[0];
+}
+
+=item @pids = $pi->ListPids ();
+
+This method lists all known process IDs in the system. If
+called in scalar context, it returns a reference to the
+list of PIDs. If you pass in a list of pids, the return will
+be the intersection of the argument list and the actual PIDs
+in the system.
+
+=cut
+
+sub ListPids {
+   confess
+   "Error - Whoever coded this forgot to override ListPids.";
+}
+
+=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 depends on the variant in use.
+You can hope to get at least the following keys for a
+"normal" process (i.e. not the idle process, which is PID 0,
+nor the system, which is some small indeterminate PID) to
+which you have access:
+
+    CreationDate
+    ExecutablePath
+    KernelModeTime
+    MaximumWorkingSetSize
+    MinimumWorkingSetSize
+    Name (generally the name of the executable file)
+    ProcessId
+    UserModeTime
+
+You may find other keys available as well, depending on which
+operating system you're using, and which variant of Process::Info
+you're using.
+
+This method also optionally takes as its first argument a reference
+to a hash of option values. The only supported key is:
+
+    no_user_info => 1
+	Do not return keys Owner and OwnerSid, even if available.
+	These tend to be time-consuming, and can cause problems
+	under the WMI variant.
+
+=cut
+
+sub GetProcInfo {
+    confess
+    "Programming Error - Whoever coded this forgot to override GetProcInfo.";
+}
+
+=item Win32::Process::Info->import ()
+
+The purpose of this static method is to specify which variants of the
+functionality are legal to use. Possible arguments are 'NT', 'WMI',
+'PT', or some combination of these (e.g. ('NT', 'WMI')). Unrecognized
+arguments are ignored, though this may change if this class becomes a
+subclass of Exporter. If called with no arguments, it is as though it
+were called with arguments ('NT', 'WMI', 'PT'). See L</BUGS>, below, for
+why this mess was introduced in the first place.
+
+This method must be called at least once, B<in a BEGIN block>, or B<no>
+variants will be legal to use. Usually it does B<not> need to be
+explicitly called by the user, since it is called implicitly when you
+C<use Win32::Process::Info;>. If you C<require Win32::Process::Info;>
+you B<will> have to call this method explicitly.
+
+If this method is called more than once, the second and subsequent calls
+will have no effect on what variants are available. The reason for this
+will be made clear (I hope!) under L</USE IN OTHER MODULES>, below.
+
+The only time a user of this module needs to do anything different
+versus version 1.006 and previous of this module is if this module is
+being loaded in such a way that this method is not implicitly called.
+This can happen two ways:
+
+ use Win32::Process::Info ();
+
+explicitly bypasses the implicit call of this method. Don't do that.
+
+ require Win32::Process::Info;
+
+also does not call this method. If you must load this module using
+require rather than use, follow the require with
+
+ Win32::Process::Info->import ();
+
+passing any necessary arguments.
+
+=cut
+
+{	# Begin local symbol block.
+
+    my $idempotent;
+
+    sub import {
+	my ($pkg, @params) = @_;
+	my (@args, @vars);
+	foreach (@params) {
+	    if (exists $variant_support{$_}) {
+		push @vars, $_;
+	    } else {
+		push @args, $_;
+	    }
+	}
+	# Note that if we ever become a subclass of Exporter
+	# we will have to call __PACKAGE__->SUPER::import (@args);
+	if ($idempotent++) {
+	    # Warning here maybe?
+	} else {
+	    @vars or push @vars, keys %variant_support;
+	    foreach my $try (@vars) {
+		$variant_support{$try} or next;
+		$variant_support{$try}{unsupported} = eval {
+		    $variant_support{$try}{check_support}->()} || $@;
+	    }
+	}
+	return;
+    }
+
+    # Return the number of times import() done.
+    sub _import_done {
+	return $idempotent;
+    }
+
+}	# End local symbol block.
+
+
+{
+    my $is_reactos = $^O eq 'MSWin32' && lc $ENV{OS} eq 'reactos';
+    sub _isReactOS {
+	return $is_reactos;
+    }
+}
+
+
+=item %subs = $pi->Subprocesses ([pid ...])
+
+This method takes as its argument a list of PIDs, and returns a hash
+indexed by PID and containing, for each PID, a reference to a list of
+all subprocesses of that process. If those processes have subprocesses
+as well, you will get the sub-sub processes, and so ad infinitum, so
+you may well get back more hash keys than you passed process IDs. Note
+that the process of finding the sub-sub processes is iterative, not
+recursive; so you don't get back a tree.
+
+If no argument is passed, you get all processes in the system.
+
+If called in scalar context you get a reference to the hash.
+
+This method works off the ParentProcessId attribute. Not all variants
+support this. If the variant you're using doesn't support this
+attribute, you get back an empty hash. Specifically:
+
+ NT -> unsupported
+ PT -> supported
+ WMI -> supported
+
+=cut
+
+sub Subprocesses {
+my ($self, @args) = @_;
+my %prox = map {($_->{ProcessId} => $_)}
+	@{$self->GetProcInfo ({no_user_info => 1})};
+my %subs;
+my $rslt = \%subs;
+my $key_found;
+foreach my $proc (values %prox) {
+    $subs{$proc->{ProcessId}} ||= [];
+    # TRW 1.011_01 next unless $proc->{ParentProcessId};
+    defined (my $pop = $proc->{ParentProcessId}) or next; # TRW 1.011_01
+    $key_found++;
+    # TRW 1.011_01 next unless $prox{$proc->{ParentProcessId}};
+    $prox{$pop} or next;	# TRW 1.011_01
+# TRW 1.012_02    $proc->{CreationDate} >= $prox{$pop}{CreationDate} or next;	# TRW 1.011_01
+    (defined($proc->{CreationDate}) &&
+	defined($prox{$pop}{CreationDate}) && 
+        $proc->{CreationDate} >= $prox{$pop}{CreationDate})
+	or next;	# TRW 1.012_02
+    # TRW 1.011_01 push @{$subs{$proc->{ParentProcessId}}}, $proc->{ProcessId};
+    push @{$subs{$pop}}, $proc->{ProcessId};
+    }
+my %listed;
+return %listed unless $key_found;
+if (@args) {
+    $rslt = \%listed;
+    while (@args) {
+	my $pid = shift @args;
+	next unless $subs{$pid};	# TRW 1.006
+	next if $listed{$pid};
+	$listed{$pid} = $subs{$pid};
+	push @args, @{$subs{$pid}};
+	}
+    }
+return wantarray ? %$rslt : $rslt;
+}
+
+=item @info = $pi->SubProcInfo ();
+
+This is a convenience method which wraps GetProcInfo(). It has the same
+calling sequence, and returns generally the same data. But the data
+returned by this method will also have the {subProcesses} key, which
+will contain a reference to an array of hash references representing the
+data on subprocesses of each process.
+
+Unlike the data returned from Subprocesses(), the data here are not
+flattened; so if you specify one or more process IDs as arguments, you
+will get back at most the number of process IDs you specified; fewer if
+some of the specified processes do not exist.
+
+B<Note well> that a given process can occur more than once in the
+output. If you call SubProcInfo without arguments, the @info array will
+contain every process in the system, even those which are also in some
+other process' {subProcesses} array.
+
+Also unlike Subprocesses(), you will get an exception if you use this
+method with a variant that does not support the ParentProcessId key.
+
+=cut
+
+sub SubProcInfo {
+    my ($self, @args) = @_;
+    my $opt = ref $args[0] eq 'HASH' ? shift @args : {};
+    my @data = $self->GetProcInfo ($opt);
+    my %subs = map {$_->{ProcessId} => $_} @data;
+    my $bingo;
+    foreach my $proc (@data) {
+	exists $proc->{ParentProcessId} or next;
+	$proc->{subProcesses} ||= [];
+	$bingo++;
+	defined (my $dad = $subs{$proc->{ParentProcessId}}) or next;
+	(defined $dad->{CreationDate} && defined $proc->{CreationDate})
+	    or next;
+	$dad->{CreationDate} > $proc->{CreationDate} and next;
+	push @{$dad->{subProcesses} ||= []}, $proc;
+    }
+    $bingo or croak "Error - Variant '@{[$self->Get('variant')
+    ]}' does not support the ParentProcessId key";
+    if (@args) {
+	return (map {exists $subs{$_} ? $subs{$_} : ()} @args);
+    } else {
+	return @data;
+    }
+}
+
+=item $text = Win32::Process::Info->variant_support_status($variant);
+
+This static method returns the support status of the given variant. The
+return is false if the variant is supported, or an appropriate message
+if the variant is unsupported.
+
+This method can also be called as a normal method, or even as a
+subroutine.
+
+=cut
+
+sub variant_support_status {
+    my @args = @_;
+    my $variant = pop @args or croak "Variant not specified";
+    exists $variant_support{$variant}
+	or croak "Variant '$variant' is unknown";
+    _import_done()
+	or croak __PACKAGE__,
+	    '->import() must be called before calling ', __PACKAGE__,
+	    '->variant_support_status()';
+    return $variant_support{$variant}{unsupported};
+}
+
+=item print "$pi Version = @{[$pi->Version ()]}\n"
+
+This method just returns the version number of the
+Win32::Process::Info object.
+
+=cut
+
+sub Version {
+return $Win32::Process::Info::VERSION;
+}
+
+#
+#	$self->_build_hash ([hashref], key, value ...)
+#	builds a process info hash out of the given keys and values.
+#	The keys are assumed to be the WMI keys, and will be trans-
+#	formed if needed. The values will also be transformed if
+#	needed. The resulting hash entries will be placed into the
+#	given hash if one is present, or into a new hash if not.
+#	Either way, the hash is returned.
+
+sub _build_hash {
+my ($self, $hash, @args) = @_;
+$hash ||= {};
+while (@args) {
+    my $key = shift @args;
+    my $val = shift @args;
+    $val = $self->{_xfrm}{$key}->($self, $val)
+	if (exists $self->{_xfrm}{$key});
+    $hash->{$key} = $val;
+    }
+return $hash;
+}
+
+
+#	$self->_clunks_to_desired (clunks ...)
+#	converts elapsed times in clunks to elapsed times in
+#	seconds, PROVIDED $self->{elapsed_in_seconds} is TRUE.
+#	Otherwise it simply returns its arguments unmodified.
+
+sub _clunks_to_desired {
+my $self = shift;
+@_ = map {defined $_ ? $_ / 10_000_000 : undef} @_ if $self->{elapsed_in_seconds};
+return wantarray ? @_ : $_[0];
+}
+
+#	$self->_date_to_time_t (date ...)
+#	converts the input dates (assumed YYYYmmddhhMMss) to
+#	Perl internal time, returning the results. The "self"
+#	argument is unused.
+
+
+sub _date_to_time_t {
+my ($self, @args) = @_;
+my @result;
+local $^W = 0;	# Prevent Time::Local 1.1 from complaining. This appears
+		# to be fixed in 1.11, but since Time::Local is part of
+		# the ActivePerl core, there's no PPM installer for it.
+		# At least, not that I can find.
+foreach (@args) {
+    if ($_) {
+	my ($yr, $mo, $da, $hr, $mi, $sc) = m/^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;
+	--$mo;
+	my $val = timelocal ($sc, $mi, $hr, $da, $mo, $yr);
+	push @result, $val;
+	}
+      else {
+	push @result, undef;
+	}
+    }
+return @result if wantarray;
+return $result[0];
+}
+
+1;
+__END__
+
+=back
+
+=head1 USE IN OTHER MODULES
+
+Other modules that use this module are also subject to the effects of
+the collision between Win32::OLE and the emulated fork call, and to the
+requirements of the import() method. I will not address subclassing,
+since I am not sure how well this module subclasses (the variants are
+implemented as subclasses of this module).
+
+Modules that simply make use of this module (the 'has-a' relationship)
+should work as before, B<provided> they 'use Win32::Process::Info'. Note
+that the phrase 'as before' is literal, and means (among other things),
+that you can't use the emulated fork.
+
+If you as the author of a module that uses Win32::Process::Info wish to
+allow emulated forks, you have a number of options.
+
+The easiest way to go is
+
+ use Win32::Process::Info qw{NT};
+
+if this provides enough information for your module.
+
+If you would prefer the extra information provided by WMI but can
+operate in a degraded mode if needed, you can do something like
+
+ use Win32::Process::Info ();
+ 
+ sub import {
+    my $pkg = shift;
+    $pkg->SUPER::import (@_);  # Optional (see below)
+    Win32::Process::Info->import (@_);
+ }
+
+The call to $pkg->SUPER::import is needed only if your package is a
+subclass of Exporter.
+
+Note to users of modules that require this module:
+
+If the above 'rules' are violated, the symptoms will be either that you
+cannot instantiate an object (because there are no legal variants) or
+that you cannot use fork (because the WMI variant was enabled by
+default). The workaround for you is to
+
+ use Win32::Process::Info;
+
+before you 'use' the problematic module. If the problem is coexistence
+with fork, you will of course need to
+
+ use Win32::Process::Info qw{NT};
+
+This is why only the first import() sets the possible variants.
+
+=head1 ENVIRONMENT
+
+This package is sensitive to a number of environment variables.
+Note that these are normally consulted only when the package
+is initialized (i.e. when it's "used" or "required").
+
+PERL_WIN32_PROCESS_INFO_VARIANT
+
+If present, specifies which variant(s) are tried, in which
+order. The default behavior is equivalent to specifying
+'WMI,NT'. This environment variable is consulted when you
+"use Win32::Process::Info;". If you want to change it in
+your Perl code you should use the static Set () method.
+
+PERL_WIN32_PROCESS_INFO_WMI_DEBUG
+
+If present and containing a value Perl recognizes as true,
+causes the WMI variant to assert the "Debug" privilege.
+This has the advantage of returning more full paths, but
+the disadvantage of tending to cause Perl to die when
+trying to get the owner information on the newly-accessible
+processes.
+
+PERL_WIN32_PROCESS_INFO_WMI_PARIAH
+
+If present, should contain a semicolon-delimited list of process names
+for which the package should not attempt to get owner information. '*'
+is a special case meaning 'all'. You will probably need to use this if
+you assert PERL_WIN32_PROCESS_INFO_WMI_DEBUG.
+
+=head1 REQUIREMENTS
+
+It should be obvious that this library must run under some
+flavor of Windows.
+
+This library uses the following libraries:
+
+ Carp
+ Time::Local
+ Proc::ProcessTable (if using the PT variant)
+ Win32::API (if using the NT-native variant)
+ Win32API::Registry (if using the NT-native variant)
+ Win32::ODBC (if using the WMI variant)
+
+As of ActivePerl 630, none of this uses any packages that are not
+included with ActivePerl. Carp and Time::Local have been in the core
+since at least 5.004. Your mileage may, of course, vary.
+
+=head1 BUGS
+
+The WMI variant leaks memory - badly for 1.001 and earlier. After
+1.001 it only leaks badly if you retrieve the process owner
+information. If you're trying to write a daemon, the NT variant
+is recommended. If you're stuck with WMI, set the no_user_info flag
+when you call GetProcInfo. This won't stop the leaks, but it minimizes
+them, at the cost of not returning the username or SID.
+
+If you intend to use fork (), your script will die horribly unless you
+load this module as
+
+ use Win32::Process::Info qw{NT};
+
+The problem is that fork() and Win32::OLE (used by the WMI variant) do
+not play B<at all> nicely together. This appears to be an acknowledged
+problem with Win32::OLE, which is brought on simply by loading the
+module. See import() above for the gory details.
+
+The use of the NT and WMI variants under non-Microsoft systems is
+unsupported. ReactOS 0.3.3 is known to lock up when GetProcInfo() is
+called; since this  works on the Microsoft OSes, I am inclined to
+attribute this to the acknowledged alpha-ness of ReactOS. I have no idea
+what happens under Wine. B<Caveat user.>
+
+Bugs can be reported to the author by mail, or through
+L<http://rt.cpan.org>.
+
+=head1 RESTRICTIONS
+
+You can not C<require> this module except in a BEGIN block. This is a
+consequence of the use of Win32::API, which has the same restriction, at
+least in some versions.
+
+If you C<require> this module, you B<must> explicitly call C<<
+Win32::Process::Info->import() >>, so that the module will know what
+variants are available.
+
+If your code calls fork (), you must load this module as
+
+ use Win32::Process::Info qw{NT};
+
+This renders the WMI variant unavailable. See L</BUGS>.
+
+=head1 RELATED MODULES
+
+Win32::Process::Info focuses on returning static data about a process.
+If this module doesn't do what you want, maybe one of the following
+ones will.
+
+=over 4
+
+=item Proc::ProcessTable by Dan Urist
+
+This module does not as of this writing support Windows, though there
+is a minimal Cygwin version that might serve as a starting point. The
+'PT' variant makes use of this module.
+
+=item Win32::PerfLib by Jutta M. Klebe
+
+This module focuses on performance counters. It is a ".xs" module,
+and requires Visual C++ 6.0 to install. But it's also part of LibWin32,
+and should come with ActivePerl.
+
+=item Win32::IProc by Amine Moulay Ramdane
+
+This module is no longer supported, which is a shame because it returns
+per-thread information as well. As of December 27, 2004, Jenda Krynicky
+(F<http://jenda.krynicky.cz/>) was hosting a PPM kit in PPM repository
+F<http://jenda.krynicky.cz/perl/>, which may be usable. But the source
+for the DLL files is missing, so if some Windows upgrade breaks it
+you're out of luck.
+
+=item Win32API::ProcessStatus, by Ferdinand Prantl
+
+This module focuses on the .exe and .dll files used by the process. It
+is a ".xs" module, requiring Visual C++ 6.0 and psapi.h to install.
+
+=item pulist
+
+This is not a Perl module, it's an executable that comes with the NT
+resource kit.
+
+=back
+
+=head1 ACKNOWLEDGMENTS
+
+This module would not exist without the following people:
+
+Aldo Calpini, who gave us Win32::API.
+
+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.
+
+Dave Roth, F<http://www.roth.net/perl/>, author of
+B<Win32 Perl Programming: Administrators Handbook>, which is
+published by Macmillan Technical Publishing, ISBN 1-57870-215-1
+
+Dan Sugalski F<sugalskd@osshe.edu>, author of VMS::Process, where
+I got (for good or ill) the idea of just grabbing all the data
+I could find on a process and smashing it into a big hash.
+
+The folks of Cygwin (F<http://www.cygwin.com/>), especially Christopher
+G. Faylor, author of ps.cc.
+
+Judy Hawkins of Pitney Bowes, for providing testing and patches for
+NT 4.0 without WMI.
+
+=head1 AUTHOR
+
+Thomas R. Wyant, III (F<wyant at cpan dot org>)
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2001-2005 by E. I. DuPont de Nemours and Company, Inc. All
+rights reserved.
+
+Copyright (C) 2007-2011 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 :
diff --git a/Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm b/Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm
new file mode 100644
index 00000000000..022d1442b33
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Process/Info/NT.pm
@@ -0,0 +1,849 @@
+=head1 NAME
+
+Win32::Process::Info::NT - Provide process information via NT-native calls.
+
+=head1 SYNOPSIS
+
+
+This package fetches process information on a given Windows
+machine, using Microsoft Windows NT's native process
+information calls.
+
+ use Win32::Process::Info
+ $pi = Win32::Process::Info->new (undef, 'NT');
+ $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::NT 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 package is to get whatever
+information is convenient (for the author!) about one or more Windows
+32 processes. GetProcInfo (which see) is therefore the most-important
+subroutine in the package. See it for more information.
+
+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 4
+
+=cut
+
+
+package Win32::Process::Info::NT;
+
+use 5.006;
+
+use strict;
+use warnings;
+
+#	The purpose of this is to provide a dummy Call
+#	method for those cases where we might not be able
+#	to map a subroutine.
+
+sub Win32::Process::Info::DummyRoutine::new {
+my $class = shift;
+$class = ref $class if ref $class;
+my $self = {};
+bless $self, $class;
+return $self;
+}
+
+sub Win32::Process::Info::DummyRoutine::Call {
+return undef;	## no critic (ProhibitExplicitReturnUndef)
+}
+
+use base qw{Win32::Process::Info};
+
+our $VERSION = '1.018';
+
+our $AdjustTokenPrivileges;
+our $CloseHandle;
+our $elapsed_in_seconds;
+our $EnumProcesses;
+our $EnumProcessModules;
+our $FileTimeToSystemTime;
+our $GetCurrentProcess;
+our $GetModuleFileNameEx;
+our $GetPriorityClass;
+our $GetProcessAffinityMask;
+our $GetProcessIoCounters;
+our $GetProcessWorkingSetSize;
+our $GetProcessTimes;
+our $GetProcessVersion;
+our $GetTokenInformation;
+our $LookupAccountSid;
+our $LookupPrivilegeValue;
+our $OpenProcess;
+our $OpenProcessToken;
+
+our $GetSidIdentifierAuthority;
+our $GetSidSubAuthority;
+our $GetSidSubAuthorityCount;
+our $IsValidSid;
+
+use Carp;
+use File::Basename;
+use Win32;
+use Win32::API;
+
+use constant TokenUser => 1;	# PER MSDN
+use constant TokenOwner => 4;
+
+my $setpriv;
+eval {
+    require Win32API::Registry and
+    $setpriv = sub {
+	Win32API::Registry::AllowPriv (
+	    Win32API::Registry::SE_DEBUG_NAME (), 1)
+	};
+    };
+$setpriv ||= sub {};
+##0.013 use Win32API::Registry qw{:Func :SE_};
+
+
+my %_transform = (
+	CreationDate => \&Win32::Process::Info::_date_to_time_t,
+	KernelModeTime => \&Win32::Process::Info::_clunks_to_desired,
+	UserModeTime => \&Win32::Process::Info::_clunks_to_desired,
+	);
+
+sub _map {
+return Win32::API->new (@_) ||
+    croak "Error - Failed to map $_[1] from $_[0]: $^E";
+}
+
+sub _map_opt {
+return Win32::API->new (@_) ||
+    Win32::Process::Info::DummyRoutine->new ();
+}
+
+my %lglarg = map {($_, 1)} qw{assert_debug_priv variant};
+
+sub new {
+my $class = shift;
+$class = ref $class if ref $class;
+croak "Error - Win32::Process::Info::NT is unsupported under this flavor of Windows."
+    unless Win32::IsWinNT ();
+my $arg = shift;
+if (ref $arg eq 'HASH') {
+    my @ilg = grep {!$lglarg{$_}} keys %$arg;
+    @ilg and
+	croak "Error - Win32::Process::Info::NT argument(s) (@ilg) illegal";
+    }
+  else {
+    croak "Error - Win32::Process::Info::NT does not support remote operation."
+	if $arg;
+    }
+my $self = {%Win32::Process::Info::static};
+delete $self->{variant};
+$self->{_xfrm} = \%_transform;
+bless $self, $class;
+# We want to fail silently, since that's probably better than nothing.
+##0.013	AllowPriv (SE_DEBUG_NAME, 1)
+$setpriv->() if $setpriv;	##0.013 ##1.005
+$setpriv = undef;		##1.005
+##    or croak "Error - Failed to (try to) assert privilege @{[
+##	SE_DEBUG_NAME]}; $^E"
+    ;
+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 NT
+variant you can hope to get at least the following keys for a "normal"
+process (i.e. not the idle process, which is PID 0, nor the system,
+which is _usually_ PID 8) to which you have access:
+
+    CreationDate
+    ExecutablePath
+    KernelModeTime
+    MaximumWorkingSetSize
+    MinimumWorkingSetSize
+    Name (generally the name of the executable file)
+    OtherOperationCount
+    OtherTransferCount (= number of bytes transferred)
+    ProcessId
+    ReadOperationCount
+    ReadTransferCount (= number of bytes read)
+    UserModeTime
+    WriteOperationCount
+    WriteTransferCount (= number of bytes read)
+
+All returns are Perl scalars. The I/O statistic keys represent counts
+if named *OperationCount, or bytes if named *TransferCount.
+
+Note that:
+
+- The I/O statistic keys will only be present on Windows 2000.
+
+- The MinimumWorkingSetSize and MaximumWorkingSetSize keys have
+no apparent relationship to the amount of memory actually
+consumed by the process.
+
+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. If all information is
+present, the status element of the hash will be zero. If there
+was any problem getting any of the information, the _status element
+will contain the Windows error code ($^E + 0, to be precise). You
+might want to look at it - or not count on the hashes being fully
+populated (or both!).
+
+Note that GetProcInfo is not, at the moment, able to duplicate the
+information returned by the resource kit tool pulist.exe. And it may
+never do so. Pulist.exe relies on the so-called internal APIs, which
+for NT are found in ntdll.dll, which may not be linked against.
+Pulist.exe gets around this by loading it at run time, and calling
+NtQuerySystemInformation. The required constants and structure
+definitions are in Winternl.h, which doesn't come with VCC. The caveat
+at http://msdn.microsoft.com/library/default.asp?url=/library/en-us/
+devnotes/winprog/calling_internal_apis.asp claims that they reserve
+the right to change this without notice, so I hesitate to program
+against it. Sorry. I guess the real purpose of this paragraph is to
+say that I _did_ try.
+
+=cut
+
+
+#	The following manifest constants are from windef.h
+
+use constant MAX_PATH => 260;
+
+
+#	The following manifest constants are from winerror.h
+
+use constant ERROR_ACCESS_DENIED => 5;
+
+
+#	The following manifest constants are from winnt.h
+
+use constant READ_CONTROL                     => 0x00020000;
+use constant SYNCHRONIZE                      => 0x00100000;
+use constant STANDARD_RIGHTS_REQUIRED         => 0x000F0000;
+use constant STANDARD_RIGHTS_READ             => READ_CONTROL;
+use constant STANDARD_RIGHTS_WRITE            => READ_CONTROL;
+use constant STANDARD_RIGHTS_EXECUTE          => READ_CONTROL;
+
+use constant PROCESS_TERMINATE         => 0x0001;
+use constant PROCESS_CREATE_THREAD     => 0x0002;
+use constant PROCESS_VM_OPERATION      => 0x0008;
+use constant PROCESS_VM_READ           => 0x0010;
+use constant PROCESS_VM_WRITE          => 0x0020;
+use constant PROCESS_DUP_HANDLE        => 0x0040;
+use constant PROCESS_CREATE_PROCESS    => 0x0080;
+use constant PROCESS_SET_QUOTA         => 0x0100;
+use constant PROCESS_SET_INFORMATION   => 0x0200;
+use constant PROCESS_QUERY_INFORMATION => 0x0400;
+use constant PROCESS_ALL_ACCESS        => STANDARD_RIGHTS_REQUIRED | SYNCHRONIZE |
+                                   0xFFF;
+
+use constant SID_REVISION              => 1;	# Current revision level
+use constant SID_MAX_SUB_AUTHORITIES   => 15;
+
+use constant TOKEN_ASSIGN_PRIMARY      => 0x0001;
+use constant TOKEN_DUPLICATE           => 0x0002;
+use constant TOKEN_IMPERSONATE         => 0x0004;
+use constant TOKEN_QUERY               => 0x0008;
+use constant TOKEN_QUERY_SOURCE        => 0x0010;
+use constant TOKEN_ADJUST_PRIVILEGES   => 0x0020;
+use constant TOKEN_ADJUST_GROUPS       => 0x0040;
+use constant TOKEN_ADJUST_DEFAULT      => 0x0080;
+use constant TOKEN_ADJUST_SESSIONID    => 0x0100;
+
+use constant TOKEN_ALL_ACCESS          => STANDARD_RIGHTS_REQUIRED |
+                          TOKEN_ASSIGN_PRIMARY | TOKEN_DUPLICATE |
+                          TOKEN_IMPERSONATE | TOKEN_QUERY |
+                          TOKEN_QUERY_SOURCE | TOKEN_ADJUST_PRIVILEGES |
+                          TOKEN_ADJUST_GROUPS | TOKEN_ADJUST_SESSIONID |
+                          TOKEN_ADJUST_DEFAULT;
+
+
+use constant TOKEN_READ            => STANDARD_RIGHTS_READ | TOKEN_QUERY;
+
+
+use constant TOKEN_WRITE           => STANDARD_RIGHTS_WRITE | TOKEN_ADJUST_PRIVILEGES |
+                          TOKEN_ADJUST_GROUPS | TOKEN_ADJUST_DEFAULT;
+
+use constant TOKEN_EXECUTE         => STANDARD_RIGHTS_EXECUTE;
+
+
+# Crib notes:
+# MS type	Perl type
+# Handle	N
+# Bool		I
+# DWord		I
+# Pointer	P
+
+sub GetProcInfo {
+my ( $self, @args ) = @_;
+my $opt = ref $args[0] eq 'HASH' ? shift @args : {};
+
+$CloseHandle ||= _map ('KERNEL32', 'CloseHandle', [qw{N}], 'V');
+$GetModuleFileNameEx ||=
+	_map ('PSAPI', 'GetModuleFileNameEx', [qw{N N P N}], 'I');
+$GetPriorityClass ||=
+	_map ('KERNEL32', 'GetPriorityClass', [qw{N}], 'I');
+$GetProcessAffinityMask ||=
+	_map ('KERNEL32', 'GetProcessAffinityMask', [qw{N P P}], 'I');
+$GetProcessIoCounters ||=
+	_map_opt ('KERNEL32', 'GetProcessIoCounters', [qw{N P}], 'I');
+$GetProcessTimes ||=
+	_map ('KERNEL32', 'GetProcessTimes', [qw{N P P P P}], 'I');
+$GetProcessWorkingSetSize ||=
+	_map ('KERNEL32', 'GetProcessWorkingSetSize', [qw{N P P}], 'I');
+$GetTokenInformation ||=
+	_map ('ADVAPI32', 'GetTokenInformation', [qw{N N P N P}], 'I');
+$LookupAccountSid ||=
+	_map ('ADVAPI32', 'LookupAccountSid', [qw{P P P P P P P}], 'I');
+$OpenProcess ||= _map ('KERNEL32', 'OpenProcess', [qw{N I N}], 'N');
+$OpenProcessToken ||=
+	_map ('ADVAPI32', 'OpenProcessToken', [qw{N N P}], 'I');
+$EnumProcessModules ||=
+	_map ('PSAPI', 'EnumProcessModules', [qw{N P N P}], 'I');
+
+
+my $dac = PROCESS_QUERY_INFORMATION | PROCESS_VM_READ;
+my $tac = TOKEN_READ;
+
+@args or @args = ListPids ($self);
+
+my @pinf;
+
+my $dat;
+my %sid_to_name;
+my @trydac = (
+    PROCESS_QUERY_INFORMATION | PROCESS_VM_READ,
+    PROCESS_QUERY_INFORMATION,
+    );
+
+foreach my $pid (map {$_ eq '.' ? $$ : $_} @args) {
+
+    local $^E = 0;
+    $dat = $self->_build_hash (undef, ProcessId => $pid);
+    $self->_build_hash ($dat, Name => 'System Idle Process')
+	unless $pid;
+
+    push @pinf, $dat;
+
+    my $prchdl;
+    foreach my $dac (@trydac) {
+	$prchdl = $OpenProcess->Call ($dac, 0, $pid) and last;
+	}
+    next unless $prchdl;
+
+    my ($cretim, $exttim, $knltim, $usrtim);
+    $cretim = $exttim = $knltim = $usrtim = ' ' x 8;
+    if ($GetProcessTimes->Call ($prchdl, $cretim, $exttim, $knltim, $usrtim)) {
+	my $time = _to_char_date ($cretim);
+	$self->_build_hash ($dat, CreationDate => $time) if $time;
+	$self->_build_hash ($dat,
+		KernelModeTime	=> _ll_to_bigint ($knltim),
+		UserModeTime	=> _ll_to_bigint ($usrtim));
+	}
+
+    my ($minws, $maxws);
+    $minws = $maxws = '    ';
+    if ($GetProcessWorkingSetSize->Call ($prchdl, $minws, $maxws)) {
+	$self->_build_hash ($dat,
+		MinimumWorkingSetSize	=> unpack ('L', $minws),
+		MaximumWorkingSetSize	=> unpack ('L', $maxws));
+	}
+
+    my $procio = '        ' x 6;	# structure is 6 longlongs.
+    if ($GetProcessIoCounters->Call ($prchdl, $procio)) {
+	my ($ro, $wo, $oo, $rb, $wb, $ob) = _ll_to_bigint ($procio);
+	$self->_build_hash ($dat,
+		ReadOperationCount	=> $ro,
+		ReadTransferCount	=> $rb,
+		WriteOperationCount	=> $wo,
+		WriteTransferCount	=> $wb,
+		OtherOperationCount	=> $oo,
+		OtherTransferCount	=> $ob);
+	}
+
+    my $modhdl = '    ';	# Module handle better be 4 bytes.
+    my $modgot = '    ';
+
+    if ($EnumProcessModules->Call ($prchdl, $modhdl, length $modhdl, $modgot)) {
+	$modhdl = unpack ('L', $modhdl);
+	my $mfn = ' ' x MAX_PATH;
+	if ($GetModuleFileNameEx->Call ($prchdl, $modhdl, $mfn, length $mfn)) {
+	    $mfn =~ s/\0.*//;
+	    $mfn =~ s/^\\(\w+)/$ENV{$1} ? $ENV{$1} : "\\$1"/ex;
+	    $mfn =~ s/^\\\?\?\\//;
+	    $self->_build_hash ($dat,
+		ExecutablePath	=> $mfn);
+	    my $base = basename ($mfn);
+	    $self->_build_hash ($dat, Name => $base) if $base;
+	    }
+	}
+
+    my ($tokhdl);
+    $tokhdl = ' ' x 4;		# Token handle better be 4 bytes.
+    {				# Start block, to use as single-iteration loop
+	last if $opt->{no_user_info};
+	$OpenProcessToken->Call ($prchdl, $tac, $tokhdl)
+	    or do {$tokhdl = undef; last; };
+	my ($dsize, $size_in, $size_out, $sid, $stat, $use, $void);
+	$tokhdl = unpack 'L', $tokhdl;
+
+	$size_out = ' ' x 4;
+	$void = pack 'p', undef;
+	my $token_type = TokenUser;
+	$GetTokenInformation->Call ($tokhdl, $token_type, $void, 0, $size_out);
+	$size_in = unpack 'L', $size_out;
+	my $tokinf = ' ' x $size_in;
+	$GetTokenInformation->Call ($tokhdl, $token_type, $tokinf, $size_in, $size_out)
+	    or last;
+	my $sidadr = unpack "P$size_in", $tokinf;
+## NO!	my $sidadr = unpack "P4", $tokinf;
+
+	$sid = _text_sid ($sidadr) or last;
+	$self->_build_hash ($dat, OwnerSid => $sid);
+	if ($sid_to_name{$sid}) {
+	    $self->_build_hash ($dat, Owner => $sid_to_name{$sid});
+	    last;
+	    }
+
+	$size_out = $dsize = pack 'L', 0;
+	$use = pack 'S', 0;
+	$stat = $LookupAccountSid->Call ($void, $sidadr, $void, $size_out, $void, $dsize, $use);
+	my ($name, $domain);
+	$name = " " x (unpack 'L', $size_out);
+	$domain = " " x (unpack 'L', $dsize);
+	my $pname = pack 'p', $name;
+	my $pdom = pack 'p', $domain;
+	$LookupAccountSid->Call ($void, $sidadr, $name, $size_out, $domain, $dsize, $use)
+	    or last;
+	$size_out = unpack 'L', $size_out;
+	$dsize = unpack 'L', $dsize;
+	my $user = (substr ($domain, 0, $dsize) . "\\" .
+			substr ($name, 0, $size_out));
+	$sid_to_name{$sid} = $user;
+	$self->_build_hash ($dat, Owner => $user);
+	}
+
+    $CloseHandle->Call ($tokhdl) if $tokhdl && $tokhdl ne '    ';
+    $CloseHandle->Call ($prchdl);
+    }
+  continue {
+    $self->_build_hash ($dat, _status => $^E + 0);
+    }
+return wantarray ? @pinf : \@pinf;
+}
+
+sub _to_char_date {
+my @args = @_;
+my @result;
+( $FileTimeToSystemTime ||=
+    Win32::API->new ('KERNEL32', 'FileTimeToSystemTime', [qw{P P}], 'I') )
+    or croak "Error - Failed to map FileTimeToSystemTime: $^E";
+my $systim = '  ' x 8;
+foreach (@args) {
+    $FileTimeToSystemTime->Call ($_, $systim) or
+	croak "Error - FileTimeToSystemTime failed: $^E";
+    my $time;
+    my ($yr, $mo, $dow, $day, $hr, $min, $sec, $ms) = unpack ('S*', $systim);
+    if ($yr == 1601 && $mo == 1 && $day == 1) {
+	$time = undef;
+	}
+      else {
+	$time = sprintf ('%04d%02d%02d%02d%02d%02d',
+	    $yr, $mo, $day, $hr, $min, $sec);
+	}
+    push @result, $time;
+    }
+return @result if wantarray;
+return $result[0];
+}
+
+sub _ll_to_bigint {
+my @args = @_;
+my @result;
+foreach (@args) {
+    my @data = unpack 'L*', $_;
+    while (@data) {
+	my $low = shift @data;
+	my $high = shift @data;
+	push @result, ($high <<= 32) + $low;
+	}
+    }
+return @result if wantarray;
+return $result[0];
+}
+
+sub _clunks_to_secs {
+my @args = @_;
+my @result;
+foreach (_ll_to_bigint (@args)) {
+    push @result, $_ / 10_000_000;
+    }
+return @result if wantarray;
+return $result[0];
+}
+
+=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 $filter = undef;
+@args and $filter = {map {(($_ eq '.' ? $$ : $_), 1)} @args};
+$EnumProcesses ||= _map ('PSAPI', 'EnumProcesses', [qw{P N P}], 'I');
+my $psiz = 4;
+my $bsiz = 0;
+    {
+    $bsiz += 1024;
+    my $pidbuf = ' ' x $bsiz;
+    my $pidgot = '    ';
+    $EnumProcesses->Call ($pidbuf, $bsiz, $pidgot) or
+	croak "Error - Failed to call EnumProcesses: $^E";
+# Note - 122 = The data area passed to a system call is too small
+    my $pidnum = unpack ('L', $pidgot);
+    redo unless $pidnum < $bsiz;
+    $pidnum /= 4;
+    my @pids;
+    if ($filter) {
+	@pids = grep {$filter->{$_}} unpack ("L$pidnum", $pidbuf);
+	}
+      else {
+	@pids = unpack ("L$pidnum", $pidbuf);
+	}
+    return wantarray ? @pids : \@pids;
+    }
+confess 'Programming error - should not get here';
+}
+
+
+
+#	_text_sid (pointer to SID)
+
+#	This subroutine translates the given sid in to a string.
+#	The algorithm is from http://msdn.microsoft.com/library/
+#	default.asp?url=/library/en-us/security/security/
+#	converting_a_binary_sid_to_string_format.asp)
+#
+#	As a general note: The SID is represented internally by an
+#	opaque structure, which contains a bunch of things that we
+#	need to know to format it. Rather than publishing the
+#	structure, or providing a formatting routine, Microsoft
+#	provided a bunch of subroutines which return pointers to the
+#	various pieces/parts of the structure that we need to do it
+#	ourselves. This presents us with with the situation of an
+#	opaque structure, essentially all of whose parts are public.
+#	This, I presume, is an example of the superior engineering that
+#	makes Microsoft the darling of the industry.
+#
+#	It also means we play some serious games, since Win32::API has
+#	no mechanism to return a pointer. The next best thing is to
+#	tell Win32::API that the return is a number of the appropriate
+#	size, "pack" the number to get an honest-to-God pointer, and
+#	then unpack again as a pointer to a structure of the
+#	appropriate size. A further unpack may be necessary to extract
+#	data from the finally-obtained structure. You'll be seeing a
+#	lot of this pack/unpack idiom in the code that follows.
+
+sub _text_sid {
+my $sid = shift;
+
+
+#	Make sure we have a valid SID
+
+$IsValidSid ||= _map ('ADVAPI32', 'IsValidSid', [qw{P}], 'I');
+my $stat = $IsValidSid->Call ($sid)
+    or return;
+
+
+#	Get the identifier authority.
+
+$GetSidIdentifierAuthority ||=
+	_map ('ADVAPI32', 'GetSidIdentifierAuthority', [qw{P}], 'N');
+my $sia = $GetSidIdentifierAuthority->Call ($sid);
+$sia = pack 'L', $sia;
+$sia = unpack 'P6', $sia;
+
+
+#	Get the number of subauthorities.
+
+$GetSidSubAuthorityCount ||=
+	_map ('ADVAPI32', 'GetSidSubAuthorityCount', [qw{P}], 'N');
+my $subauth = $GetSidSubAuthorityCount->Call ($sid);
+$subauth = pack 'L', $subauth;
+$subauth = unpack 'P1', $subauth;
+$subauth = unpack 'C*', $subauth;
+
+
+#	Start by formatting the revision number. Note that this is
+#	hard-coded. It's in a .h file if you're using "C". The
+#	revision is actually in the SID if you trust the include
+#	file, but the docs make it look like the SID structure is
+#	supposed to be opaque, and in Microsoft's example comes from
+#	the .h
+
+my $sidout = sprintf 'S-%lu', SID_REVISION;
+
+
+#	Format the identifier authority. The rules are different
+#	depending on whether the first 2 bytes are in use.
+
+if (unpack 'S', $sia) {
+    $sidout .= sprintf ('-0x%s', unpack 'H*', $sia);
+    }
+  else {
+    $sidout .= sprintf '-%lu', unpack 'x2N', $sia;
+    }
+
+
+#	Now tack on all the subauthorities. Because of Microsoft's
+#	high-quality design, the subauthorities are in a different
+#	byte order than the identifier authority.
+
+$GetSidSubAuthority ||=
+	_map ('ADVAPI32', 'GetSidSubAuthority', [qw{P I}], 'N');
+for (my $subctr = 0; $subctr < $subauth; $subctr++) {
+    my $subid = $GetSidSubAuthority->Call ($sid, $subctr);
+    $subid = pack 'L', $subid;
+    $subid = unpack 'P4', $subid;
+    $sidout .= sprintf '-%lu', unpack 'L', $subid;
+    }
+
+
+#	Return the formatted string.
+
+return $sidout;
+}
+
+=back
+
+=head1 REQUIREMENTS
+
+This library uses the following libraries:
+
+ Carp
+ Time::Local
+ Win32
+ Win32::API
+ Win32API::Registry (if available)
+
+As of this writing, all but Win32 and Win32::API are part of the
+standard Perl distribution. Win32 is not part of the standard Perl
+distribution, but comes with the ActivePerl distribution. Win32::API
+comes with ActivePerl as of about build 630, but did not come with
+earlier versions. It must be installed before installing this module.
+
+=head1 ACKNOWLEDGMENTS
+
+This module would not exist without the following people:
+
+Aldo Calpini, who gave us Win32::API.
+
+The folks of Cygwin (F<http://www.cygwin.com/>), especially Christopher
+Faylor, author of ps.cc.
+
+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.
+
+Judy Hawkins of Pitney Bowes, for providing testing and patches for
+NT 4.0 without WMI.
+
+=head1 AUTHOR
+
+Thomas R. Wyant, III (F<wyant at cpan dot org>)
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2001-2003 by E. I. DuPont de Nemours and Company, Inc.
+
+Copyright (C) 2007-2011 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
+
+1;
+__END__
+
+Sample code from MSDN
+
+Set privilege (http://msdn.microsoft.com/library/default.asp?url=/library/en-us/security/security/enabling_and_disabling_privileges.asp)
+
+BOOL SetPrivilege(
+    HANDLE hToken,          // access token handle
+    LPCTSTR lpszPrivilege,  // name of privilege to enable/disable
+    BOOL bEnablePrivilege   // to enable or disable privilege
+    )
+{
+TOKEN_PRIVILEGES tp;
+LUID luid;		// 64-bit identifier
+
+if ( !LookupPrivilegeValue(
+        NULL,            // lookup privilege on local system
+        lpszPrivilege,   // privilege to lookup
+        &luid ) )        // receives LUID of privilege
+{
+    printf("LookupPrivilegeValue error: %u\n", GetLastError() );
+    return FALSE;
+}
+
+tp.PrivilegeCount = 1;
+tp.Privileges[0].Luid = luid;
+if (bEnablePrivilege)
+    tp.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED;
+else
+    tp.Privileges[0].Attributes = 0;
+
+// Enable the privilege or disable all privileges.
+
+if ( !AdjustTokenPrivileges(
+       hToken,
+       FALSE,
+       &tp,
+       sizeof(TOKEN_PRIVILEGES),
+       (PTOKEN_PRIVILEGES) NULL,
+       (PDWORD) NULL) )
+{
+      printf("AdjustTokenPrivileges error: %u\n", GetLastError() );
+      return FALSE;
+}
+
+return TRUE;
+}
+
+
+#	_set_priv ([priv_name, ...])
+
+#	This subroutine turns on the desired privilege (or privileges).
+#	If no arguments are passed it turns on the "Debug" privilege.
+#	The algorithm is from
+#	http://msdn.microsoft.com/library/default.asp?url=/library/
+#	en-us/security/security/enabling_and_disabling_privileges.asp
+#
+#	We return zero for success, or $^E if an error occurs.
+#
+#	The complication _here_ is that there is no standard internal
+#	representation of a privilege. Microsoft encodes them as LUIDs
+#	(locally-unique identifiers), which means we have to take as
+#	input the strings representing the names of the privileges, and
+#	translate each to a LUID, since LUIDS are _local_ to a given
+#	instance of an operating system.
+
+sub _set_priv {
+
+my $self = shift;
+@_ =  (SE_DEBUG_NAME ()) unless @_;
+
+
+#	First we have to get our own access token, because that's what
+#	we actually set the privilege on. And we'd better declare the
+#	correct access intent ahead of time, or Microsoft will be very
+#	upset.
+
+$GetCurrentProcess ||= _map ('KERNEL32', 'GetCurrentProcess', [], 'N');
+my $prchdl = $GetCurrentProcess->Call () or return $^E + 0;
+$OpenProcessToken ||=
+	_map ('ADVAPI32', 'OpenProcessToken', [qw{N N P}], 'I');
+my $tokhdl;
+$tokhdl = ' ' x 4;		# Token handle better be 4 bytes.
+my $tac = TOKEN_READ | TOKEN_ADJUST_PRIVILEGES;
+$OpenProcessToken->Call ($prchdl, $tac, $tokhdl) or return $^E + 0;
+$tokhdl = unpack 'L', $tokhdl;
+
+
+#	OK, now we get to build up a TOKEN_PRIVILEGES structure
+#	representing the privileges we want to assert. This looks like:
+#	    A dword count (number of privileges)
+#	    The specified number of LUID_AND_ATTRIBUTES structures,
+#		    each of which looks like:
+#		Luid (64 bits = 8 bytes, as noted above)
+#	 	Attributes (4 bytes).
+#	Each LUID gets looked up and slapped on the end of the growing
+#	TOKEN_PRIVILEGES structure.
+
+my $enab = pack 'L', SE_PRIVILEGE_ENABLED ();
+my %gotprv;
+$LookupPrivilegeValue ||=
+	_map ('ADVAPI32', 'LookupPrivilegeValue', [qw{P P P}], 'I');
+my $null = pack 'p', undef;
+my $num = 0;
+my $tp = '';
+foreach my $priv (@_) {
+    next if $gotprv{$priv};
+    my $luid = '.' x 8;		# An LUID is 64 bits.
+    $LookupPrivilegeValue->Call ($null, $priv, $luid) or
+		return $^E + 0;
+    $gotprv{$priv} = $luid;
+    $num++;
+    $tp .= $luid . $enab;
+    }
+
+
+#	Okay, the TOKEN_PRIVILEGES structure needs the number of
+#	privileges slapped on the front. So:
+
+$num = pack 'L', $num;
+$tp = $num . $tp;
+
+
+#	At long last we turn on the desired privileges. As another
+#	example of Microsoft's inspired design, note that we need to
+#	tell the subroutine how big the structure is, even though the
+#	structure contains the number of elements. Or, alternately,
+#	that we have to pass the number of elements even though we told
+#	the subroutine how big the structure is.
+
+$AdjustTokenPrivileges ||=
+    _map ('ADVAPI32', 'AdjustTokenPrivileges', [qw{N I P N P P}], 'I');
+$AdjustTokenPrivileges->Call (
+	$tokhdl, 0, $tp, length $tp, $null, $null) or
+    return $^E + 0;
+
+
+return 0;
+}
+
diff --git a/Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm b/Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm
new file mode 100644
index 00000000000..b2b6326b0a4
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Process/Info/PT.pm
@@ -0,0 +1,287 @@
+=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 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.
+
+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.018';
+
+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 $opt = ref $args[0] eq 'HASH' ? shift @args : {};
+	my $tbl = Proc::ProcessTable->new ()->table ();
+	if (@args) {
+	    my %filter = map {(($_ eq '.' ? $$ : $_), 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 @pids;
+    if (@args) {
+	my %filter = map {(($_ eq '.' ? $$ : $_), 1)} @args;
+	@pids = grep {$filter{$_}} map {$_->pid} @$tbl;
+    } else {
+	@pids = map {$_->pid} @$tbl;
+    }
+    return wantarray ? @pids : \@pids;
+}
+
+=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 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;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Process/Info/WMI.pm b/Master/tlpkg/tlperl/lib/Win32/Process/Info/WMI.pm
new file mode 100644
index 00000000000..3edb3a262f6
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Process/Info/WMI.pm
@@ -0,0 +1,426 @@
+=head1 NAME
+
+Win32::Process::Info::WMI - Provide process information via WMI.
+
+=head1 SYNOPSIS
+
+This package fetches process information on a given Windows
+machine, using Microsoft's Windows Management Implementation.
+
+ use Win32::Process::Info
+ $pi = Win32::Process::Info->new (undef, 'WMI');
+ $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 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
+
+This package implements the WMI-specific methods of
+Win32::Process::Info.
+
+The following methods should be considered public:
+
+=over 4
+
+=cut
+
+package Win32::Process::Info::WMI;
+
+use strict;
+use warnings;
+
+use base qw{Win32::Process::Info};
+our $VERSION = '1.018';
+
+use vars qw{%mutator};
+use Carp;
+use Time::Local;
+use Win32::OLE qw{in with};
+use Win32::OLE::Const;
+use Win32::OLE::Variant;
+
+
+%mutator = %Win32::Procecss::Info::mutator;
+
+my %pariah = map {($_ => 1)} grep {$_} split ';',
+    lc ($ENV{PERL_WIN32_PROCESS_INFO_WMI_PARIAH} || '');
+my $no_user_info = $ENV{PERL_WIN32_PROCESS_INFO_WMI_PARIAH} &&
+    $ENV{PERL_WIN32_PROCESS_INFO_WMI_PARIAH} eq '*';
+my $assert_debug_priv = $ENV{PERL_WIN32_PROCESS_INFO_WMI_DEBUG};
+
+
+#	note that "new" is >>>NOT<<< considered a public
+#	method.
+
+my $wmi_const;
+
+my %lglarg = map {($_, 1)} qw{assert_debug_priv host password user variant};
+
+sub new {
+my $class = shift;
+$class = ref $class if ref $class;
+
+my $arg = shift;
+my @ilg = grep {!$lglarg{$_}} keys %$arg;
+@ilg and
+    croak "Error - Win32::Process::Info::WMI argument(s) (@ilg) illegal";
+
+my $mach = $arg->{host} || '';
+$mach =~ s|^[\\/]+||;
+my $user = $arg->{user} || '';
+my $pass = $arg->{password} || '';
+$arg->{assert_debug_priv} ||= $assert_debug_priv;
+
+my $old_warn = Win32::OLE->Option ('Warn');
+Win32::OLE->Option (Warn => 0);
+
+
+#	Under at least some circumstances, I have found that I have
+#	access when using the monicker, and not if using the locator;
+#	especially under NT 4.0 with the retrofitted WMI. So use the
+#	monicker unless I have a username/password.
+
+my $wmi;
+
+if ($user) {
+    my $locator = Win32::OLE->new ('WbemScripting.SWbemLocator') or do {
+	Win32::OLE->Option (Warn => $old_warn);
+	croak "Error - Win32::Process::Info::WMI failed to get SWBemLocator object:\n",
+	    Win32::OLE->LastError;
+	};
+
+    $wmi_const ||= Win32::OLE::Const->Load ($locator) or do {
+	Win32::OLE->Option (Warn => $old_warn);
+	croak "Error - Win32::Process::Info::WMI failed to load WMI type library:\n",
+	    Win32::OLE->LastError;
+	};
+
+
+# Note that MSDN says that the following doesn't work under NT 4.0.
+##$wmi->Security_->Privileges->AddAsString ('SeDebugPrivilege', 1);
+
+    $locator->{Security_}{ImpersonationLevel} =
+	$wmi_const->{wbemImpersonationLevelImpersonate};
+    $locator->{Security_}{Privileges}->Add ($wmi_const->{wbemPrivilegeDebug})
+	if $arg->{assert_debug_priv};
+
+    $wmi = $locator->ConnectServer (
+	$mach,				# Server
+	'root/cimv2',			# Namespace
+	$user,				# User (with optional domain)
+	$pass,				# Password
+	'',				# Locale
+	'',				# Authority
+##	wbemConnectFlagUseMaxWait,	# Flag
+	);
+    }
+  else {
+    my $mm = $mach || '.';
+    $wmi = Win32::OLE->GetObject (
+	"winmgmts:{impersonationLevel=impersonate@{[
+		$arg->{assert_debug_priv} ? ',(Debug)' : '']}}!//$mm/root/cimv2");
+    }
+
+$wmi or do {
+    Win32::OLE->Option (Warn => $old_warn);
+    croak "Error - Win32::Process::Info::WMI failed to get winmgs object:\n",
+	Win32::OLE->LastError;
+    };
+
+$wmi_const ||= Win32::OLE::Const->Load ($wmi) or do {
+    Win32::OLE->Option (Warn => $old_warn);
+    croak "Error - Win32::Process::Info::WMI failed to load WMI type library:\n",
+	Win32::OLE->LastError;
+    };
+
+
+#	Whew! we're through with that! Manufacture and return the
+#	desired object.
+
+Win32::OLE->Option (Warn => $old_warn);
+my $self = {%Win32::Process::Info::static};
+$self->{machine} = $mach;
+$self->{password} = $pass;
+$self->{user} = $pass;
+$self->{wmi} = $wmi;
+$self->{_attr} = undef;	# Cache for keys.
+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 both on the variant in use and
+the setting of b<use_wmi_names>. Assuming B<use_wmi_names> is
+TRUE, you can hope to get at least the following keys for a
+"normal" process (i.e. not the idle process, which is PID 0,
+nor the system, which is PID 8) to which you have access:
+
+    CSCreationClassName
+    CSName (= machine name)
+    Caption (seems to generally equal Name)
+    CreationClassName
+    CreationDate
+    Description (seems to equal Caption)
+    ExecutablePath
+    KernelModeTime
+    MaximumWorkingSetSize
+    MinimumWorkingSetSize
+    Name
+    OSCreationClassName
+    OSName
+    OtherOperationCount
+    OtherTransferCount
+    Owner (*)
+    OwnerSid (*)
+    PageFaults
+    ParentProcessId
+    PeakWorkingSetSize
+    ProcessId
+    ReadOperationCount
+    ReadTransferCount
+    UserModeTime
+    WindowsVersion
+    WorkingSetSize
+    WriteOperationCount
+    WriteTransferCount
+
+You may find other keys available as well.
+
+* - Keys marked with an asterisk are computed, and may not always
+be present.
+
+=cut
+
+sub _get_proc_objects {
+my $self = shift;
+my @procs = @_ ?
+    map {
+	my $pi = $_ eq '.' ? $$ : $_;
+	my $obj = $self->{wmi}->Get ("Win32_Process='$pi'");
+	Win32::OLE->LastError ? () : ($obj)	
+	} @_ :
+    (in $self->{wmi}->InstancesOf ('Win32_Process'));
+
+if (@procs && !$self->{_attr}) {
+    my $atls = $self->{_attr} = [];
+    $self->{_xfrm} = {
+	KernelModeTime	=> \&Win32::Process::Info::_clunks_to_desired,
+	UserModeTime	=> \&Win32::Process::Info::_clunks_to_desired,
+	};
+
+    foreach my $attr (in $procs[0]->{Properties_}) {
+	my $name = $attr->{Name};
+	my $type = $attr->{CIMType};
+	push @$atls, $name;
+	$self->{_xfrm}{$name} = \&Win32::Process::Info::_date_to_time_t
+	    if $type == $wmi_const->{wbemCimtypeDatetime};
+	}
+    }
+$self->{_attr} = {map {($_->{Name}, $_->{CIMType})}
+	in $procs[0]->{Properties_}}
+    if (@procs && !$self->{_attr});
+
+return @procs;
+}
+
+sub GetProcInfo {
+my $self = shift;
+my $opt = ref $_[0] eq 'HASH' ? shift : {};
+my @pinf;
+my %username;
+my ($sid, $user, $domain);
+my $old_warn = Win32::OLE->Option ('Warn');
+Win32::OLE->Option (Warn => 0);
+
+my $skip_user = $no_user_info || $opt->{no_user_info};
+unless ($skip_user) {
+    $sid = Variant (VT_BYREF | VT_BSTR, '');
+##    $sid = Variant (VT_BSTR, '');
+    $user = Variant (VT_BYREF | VT_BSTR, '');
+    $domain = Variant (VT_BYREF | VT_BSTR, '');
+#
+#	The following plausable ways of caching the variant to try to
+#	stem the associated memory leak result in an access violation
+#	the second time through (i.e. the first time the object is
+#	retrieved from cache rather than being manufactured). God knows
+#	why, but so far He has not let me in on the secret. Sometimes
+#	There's an OLE type mismatch error before the access violation
+#	is reported, but sometimes not.
+#
+##    $sid = $self->{_variant}{sid} ||= Variant (VT_BYREF | VT_BSTR, '');
+##    $user = $self->{_variant}{user} ||= Variant (VT_BYREF | VT_BSTR, '');
+##    $domain = $self->{_variant}{domain} ||= Variant (VT_BYREF | VT_BSTR, '');
+##    $sid = $Win32::Process::Info::WMI::sid ||= Variant (VT_BYREF | VT_BSTR, '');
+##    $user = $Win32::Process::Info::WMI::user ||= Variant (VT_BYREF | VT_BSTR, '');
+##    $domain = $Win32::Process::Info::WMI::domain ||= Variant (VT_BYREF | VT_BSTR, '');
+    }
+
+foreach my $proc (_get_proc_objects ($self, @_)) {
+    my $phash = $self->_build_hash (
+	undef, map {($_, $proc->{$_})} @{$self->{_attr}});
+    push @pinf, $phash;
+    my $oid;
+
+#	The test for executable path is extremely ad-hoc, but the best
+#	way I have come up with so far to strain out the System and
+#	Idle processes. The methods can misbehave badly on these, and
+#	I have found no other way of identifying them. Idle is always
+#	process 0, but it seems to me that I have seen once a system
+#	whose System process ID was not 8. This test was actually
+#	removed at one point, but is reinstated since finding a set of
+#	slides on the NT startup which bolsters my confidence in it.
+#	But it still looks like ad-hocery to me.
+
+    eval {
+	return unless $proc->{ExecutablePath};
+	return if $skip_user || $pariah{lc $proc->{Name}};
+	$sid->Put ('');
+	$proc->GetOwnerSid ($sid);
+	$oid = $sid->Get ();
+	return unless $oid;
+	$phash->{OwnerSid} = $oid;
+	unless ($username{$oid}) {
+	    $username{$oid} =
+	    $proc->GetOwner ($user, $domain) ? $oid :
+		"@{[$domain->Get ()]}\\@{[$user->Get ()]}";
+	    }
+	$phash->{Owner} = $username{$oid};
+	};
+    }
+Win32::OLE->Option (Warn => $old_warn);
+return wantarray ? @pinf : \@pinf;
+}
+
+=item @pids = $pi->ListPids ();
+
+This method lists all known process IDs in the system. If
+called in scalar context, it returns a reference to the
+list of PIDs. If you pass in a list of pids, the return will
+be the intersection of the argument list and the actual PIDs
+in the system.
+
+=cut
+
+sub ListPids {
+my $self = shift;
+my @pinf;
+foreach my $proc (_get_proc_objects ($self, @_)) {
+    push @pinf, $proc->{ProcessId};
+    }
+return wantarray ? @pinf : \@pinf;
+}
+1;
+__END__
+source of the following list:
+http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/r_32os5_02er.asp
+  string Caption  ;
+  string CreationClassName  ;
+  datetime CreationDate  ;
+  string CSCreationClassName  ;
+  string CSName  ;
+  string Description  ;
+  string ExecutablePath  ;
+  uint16 ExecutionState  ;
+  string Handle  ;
+  uint32 HandleCount  ;
+  datetime InstallDate  ;
+  uint64 KernelModeTime  ;
+  uint32 MaximumWorkingSetSize  ;
+  uint32 MinimumWorkingSetSize  ;
+  string Name  ;
+  string OSCreationClassName  ;
+  string OSName  ;
+  uint64 OtherOperationCount  ;
+  uint64 OtherTransferCount  ;
+  uint32 PageFaults  ;
+  uint32 PageFileUsage  ;
+  uint32 ParentProcessId  ;
+  uint32 PeakPageFileUsage  ;
+  uint64 PeakVirtualSize  ;
+  uint32 PeakWorkingSetSize  ;
+  uint32 Priority  ;
+  uint64 PrivatePageCount  ;
+  uint32 ProcessId  ;
+  uint32 QuotaNonPagedPoolUsage  ;
+  uint32 QuotaPagedPoolUsage  ;
+  uint32 QuotaPeakNonPagedPoolUsage  ;
+  uint32 QuotaPeakPagedPoolUsage  ;
+  uint64 ReadOperationCount  ;
+  uint64 ReadTransferCount  ;
+  uint32 SessionId  ;
+  string Status  ;
+  datetime TerminationDate  ;
+  uint32 ThreadCount  ;
+  uint64 UserModeTime  ;
+  uint64 VirtualSize  ;
+  string WindowsVersion  ;
+  uint64 WorkingSetSize  ;
+  uint64 WriteOperationCount  ;
+  uint64 WriteTransferCount  ;
+
+=back
+
+=head1 REQUIREMENTS
+
+It should be obvious that this library must run under some
+flavor of Windows.
+
+This library uses the following libraries:
+
+  Carp
+  Time::Local
+  Win32::OLE
+  use Win32::OLE::Const;
+  use Win32::OLE::Variant;
+
+As of ActivePerl 630, none of the variant libraries use any libraries
+that are not included with ActivePerl. Your mileage may vary.
+
+=head1 ACKNOWLEDGMENTS
+
+This module would not exist without the following people:
+
+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.
+
+Dave Roth, F<http://www.roth.net/perl/>, author of
+B<Win32 Perl Programming: Administrators Handbook>, which is
+published by Macmillan Technical Publishing, ISBN 1-57870-215-1
+
+=head1 AUTHOR
+
+Thomas R. Wyant, III (F<wyant at cpan dot org>)
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2001-2005 by E. I. DuPont de Nemours and Company, Inc.
+
+Copyright (C) 2007, 2010-2011 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 :