summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Win32/Process/Info.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Win32/Process/Info.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Win32/Process/Info.pm52
1 files changed, 46 insertions, 6 deletions
diff --git a/Master/tlpkg/tlperl/lib/Win32/Process/Info.pm b/Master/tlpkg/tlperl/lib/Win32/Process/Info.pm
index 45cfc373918..a9d9c8c91f5 100644
--- a/Master/tlpkg/tlperl/lib/Win32/Process/Info.pm
+++ b/Master/tlpkg/tlperl/lib/Win32/Process/Info.pm
@@ -50,6 +50,10 @@ 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.
+The process IDs made available are those returned by the variant in
+use. See the documentation to the individual variants for details,
+especially if you are a Cygwin user.
+
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
@@ -70,7 +74,7 @@ use 5.006;
use strict;
use warnings;
-our $VERSION = '1.019';
+our $VERSION = '1.020';
use Carp;
use File::Spec;
@@ -101,6 +105,21 @@ our %static = (
my %variant_support;
BEGIN {
+ # Cygwin has its own idea of what a process ID is, independent of
+ # the underlying operating system. The Cygwin Perl implements this,
+ # so if we're Cygwin we need to compensate. This MUST return the
+ # Windows-native form under Cygwin, which means any variant which
+ # needs another form must override.
+
+ if ( $^O eq 'cygwin' ) {
+ *My_Pid = sub {
+ return Cygwin::pid_to_winpid( $$ );
+ };
+ } else {
+ *My_Pid = sub {
+ return $$;
+ };
+ }
%variant_support = (
NT => {
check_support => sub {
@@ -156,7 +175,9 @@ DLL_LOOP:
$wmi = Win32::OLE->GetObject(
'winmgmts:{impersonationLevel=impersonate,(Debug)}!//./root/cimv2'
);
- $wmi and $proc = $wmi->Get( "Win32_Process='$$'" );
+ $wmi and $proc = $wmi->Get(
+ sprintf q{Win32_Process='%s'}, __PACKAGE__->My_Pid()
+ );
};
Win32::OLE->Option( Warn => $old_warn );
$wmi or return 'Unable to get WMI object';
@@ -480,7 +501,7 @@ passing any necessary arguments.
my $idempotent;
- sub import {
+ sub import { ## no critic (RequireArgUnpacking)
my ($pkg, @params) = @_;
my (@args, @vars);
foreach (@params) {
@@ -490,8 +511,7 @@ passing any necessary arguments.
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 {
@@ -502,7 +522,12 @@ passing any necessary arguments.
$variant_support{$try}{check_support}->()} || $@;
}
}
+
return;
+
+# Do this if we become a subclass of Exporter
+# @_ = ( $pkg, @args );
+# goto &Exporter::import;;
}
# Return the number of times import() done.
@@ -631,6 +656,21 @@ sub SubProcInfo {
}
}
+=item $pid = $pi->My_Pid()
+
+This convenience method returns the process ID of the current process,
+in a form appropriate to the operating system and the variant in use.
+Normally, it simply returns C<$$>. But Cygwin has its own idea of what
+the process ID is, which may differ from Windows. Worse than that, under
+Cygwin the NT and WMI variants return Windows PIDs, while PT appears to
+return Cygwin PIDs.
+
+=cut
+
+# This is defined above, trickily, as an assignment to *My_Pid, so we
+# don't have to test $^O every time. It's above because code in a BEGIN
+# block needs it.
+
=item $text = Win32::Process::Info->variant_support_status($variant);
This static method returns the support status of the given variant. The
@@ -950,7 +990,7 @@ Thomas R. Wyant, III (F<wyant at cpan dot org>)
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
+Copyright (C) 2007-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