diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Win32/Process/Info.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Win32/Process/Info.pm | 52 |
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 |