James Couball wrote:
> Everyone, thank you for the replies.
>
> Here is what I ended up with for a getppid that works platforms that
> support getppid() and Windows (comments welcome):
Just for comparison, here's a script that compares your OLE version to a
Win32::API version - the API version is a bit longer, but should be much
faster. I couldn't get either method to fail if parent has exited (or at
least attempted to exit using script at end and uncommenting BEGIN line
below) :
#!perl --
use strict;
use warnings;
use Win32::API;
# make sure we're detached from parent for this test and log ppid to foo
# this next line is attempting to have parent exit before this runs
# BEGIN { open STDOUT, ">>$ENV{TMP}/foo"; binmode STDOUT; $| = 1; sleep 5; }
our ($pt0, $timeit);
BEGIN { $timeit = 1; } # time the script
BEGIN { if ($timeit) { print scalar (localtime), "\n";
$pt0 = Win32::GetTickCount (); } }
END { if ($timeit) { print scalar (localtime); my $ticks = Win32::GetTickCount;
printf " - %.6f sec (%u ticks)\n", ($ticks - $pt0) / 1000, $ticks - $pt0; } }
our %A; # get commandline switches into %A
for (my $ii = 0; $ii < @ARGV; ) {
if ($ARGV[$ii] =~ /^--$/) { splice @ARGV, $ii, 1; last; }
if ($ARGV[$ii] !~ /^-{1,2}(.*)$/) { $ii++; next; }
my $arg = $1; splice @ARGV, $ii, 1;
if ($arg =~ /^([\w]+)=(.*)$/) { exists ($A{$1}) ? ($A{$1} .= "|$2") :
($A{$1} = $2); } else { $A{$1}++; }
}
my $ole = $A{o} || 0; # get switches to vars
my $api = $A{a} || 0; $api = 1 if not $ole;
(my $prog = $0) =~ s/^.*[\\\/]//; # usage printout
my $usage = <<EOD;
Usage: $prog [-a] [-o]
-a use Win32::API (default)
-o use OLE instead of API
EOD
die $usage if $A{h} or $A{help};
my $CreateToolhelp32Snapshot; # define API calls
my $Process32First;
my $Process32Next;
my $CloseHandle;
my $ppid;
if ($^O =~ /^MSWin/) {
if ($ole) {
$ppid = getppido (); # use OLE to get it
} elsif ($api) {
$ppid = getppida (); # use Win32::API to get it
}
} else {
$ppid = getppid ();
}
printf "OLE=%u, API=%u, pid='%d', ppid='%d'\n", $ole, $api, $$, defined
$ppid ? $ppid : '<unknown>';
exit;
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub getppido { # OLE version
require Win32::OLE;
require Win32::OLE::Variant;
my $machine = "\\\\.";
# WMI Win32_Process class
my $class = "winmgmts:{impersonationLevel=impersonate}$machine\\Root\\cimv2";
my $ppid;
if (my $wmi = Win32::OLE->GetObject($class)) {
my $pid = $$;
if (my $proc=$wmi->Get(qq{Win32_Process.Handle="$pid"})) {
$ppid = $proc->{ParentProcessId} if
($proc->{ParentProcessId}!=0);
}
}
return $ppid;
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub getppida { # Win32::API version
if (not defined $CreateToolhelp32Snapshot) {
$CreateToolhelp32Snapshot = new Win32::API ('kernel32',
'CreateToolhelp32Snapshot', 'II', 'N') or
die "import CreateToolhelp32Snapshot: $!($^E)";
$Process32First = new Win32::API ('kernel32', 'Process32First',
'IP', 'N') or die "import Process32First: $!($^E)";
$Process32Next = new Win32::API ('kernel32', 'Process32Next', 'IP',
'N') or die "import Process32Next: $!($^E)";
$CloseHandle = new Win32::API ('kernel32', 'CloseHandle', 'I', 'N')
or die "import CloseHandle: $!($^E)";
}
use constant TH32CS_SNAPPROCESS => 0x00000002;
use constant INVALID_HANDLE_VALUE => -1;
use constant MAX_PATH => 260;
# Take a snapshot of all processes in the system.
my $hProcessSnap = $CreateToolhelp32Snapshot->Call(TH32CS_SNAPPROCESS, 0);
die "CreateToolhelp32Snapshot: $!($^E)" if $hProcessSnap ==
INVALID_HANDLE_VALUE;
# Struct PROCESSENTRY32:
# DWORD dwSize; # 0 for 4
# DWORD cntUsage; # 4 for 4
# DWORD th32ProcessID; # 8 for 4
# DWORD th32DefaultHeapID; # 12 for 4
# DWORD th32ModuleID; # 16 for 4
# DWORD cntThreads; # 20 for 4
# DWORD th32ParentProcessID; # 24 for 4
# LONG pcPriClassBase; # 28 for 4
# DWORD dwFlags; # 32 for 4
# char szExeFile[MAX_PATH]; # 36 for 260
# Set the size of the structure before using it.
my $dwSize = MAX_PATH + 36;
my $pe32 = pack 'I9C260', $dwSize, 0 x 8, '0' x MAX_PATH;
my $lppe32 = pack 'P', $pe32;
# Retrieve information about the first process, and exit if unsuccessful
my $ret = $Process32First->Call($hProcessSnap, $pe32);
do {
if (not $ret) {
$CloseHandle->Call($hProcessSnap);
warn "Process32First: ret=$ret, $!($^E)";
return undef;
}
# return ppid if pid == my pid
my $th32ProcessID = unpack 'I', substr $pe32, 8, 4;
return unpack ('I', substr $pe32, 24, 4) if $$ == $th32ProcessID;
} while ($Process32Next->Call($hProcessSnap, $pe32));
$CloseHandle->Call($hProcessSnap);
return undef;
}
__END__
Detached script starter - I start like this from tcsh :
perl detach.pl 'f:/perl/bin/perl.exe' 'getppid.pl -o'
perl detach.pl 'f:/perl/bin/perl.exe' 'getppid.pl -a'
#!perl --
use strict;
use warnings;
use Win32::Process;
print qq{pid=$$, Win32::Process::Create(\$pObj, "$ARGV[0]", "@ARGV", 0, },
DETACHED_PROCESS, qq{, '.'\n};
my $pObj;
Win32::Process::Create($pObj, $ARGV[0], "@ARGV", 0, DETACHED_PROCESS, ".") or
die "Win32::Process::Create: $!($^E)";
my $cpid = $pObj->GetProcessID();
print "child pid=$cpid started - $$ exiting\n";
exit; # don't wait for child
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
