in reply to Spawning processes using Win32::Process
As it happens, I'm hacking right now on a Unix/Windows QA test script to fork many like processes. It's a bit hacky, but may be of use to you as an example.
use strict; $|=1; my $IS_WIN32 = $^O eq 'MSWin32'; my $CAN_FORK = !$IS_WIN32; my $cmd = "netstat -na"; my $cmd_exe; my $SysDir; if ($IS_WIN32) { $SysDir = "$ENV{SystemRoot}\\system32"; $cmd_exe = "$SysDir\\netstat.exe"; } unless ($CAN_FORK) { require Win32::Process; # save original stdout and stderr open(SAVEOUT, ">&STDOUT"); open(SAVEERR, ">&STDERR"); } my $OutDir = "knob.tmp"; -d $OutDir or (mkdir($OutDir) or die "error: mkdir '$OutDir': $!"); my $nproc = 3; my @hProc = (); my @Pids = (); my $pid; print "forking $nproc commands (output in dir '$OutDir').\n"; # Fork all the processes ... for my $i (0 .. $nproc-1) { my $Outf = "$OutDir/$i.tmp"; if ($CAN_FORK) { print "$i: cmd='$cmd'\n"; defined($pid = fork()) or die "error: fork: $!"; if ($pid == 0) { # child exec("$cmd >$Outf 2>&1"); die "error: exec '$cmd': $!"; } # parent continues... } else { print "$i: cmd_exe='$cmd_exe' cmd='$cmd'\n"; # redirect stdout and stderr open(STDOUT, ">$Outf") or die "can't redirect stdout"; open(STDERR, ">&STDOUT") or die "can't dup stdout"; Win32::Process::Create(my $hProc, # process object $cmd_exe, # executable $cmd, # command line 1, # inherit file h +andles Win32::Process::NORMAL_PRIORITY_CLASS(), ".") # working dir or die "cannot create process $i: $! ($^E)\n"; push(@hProc, $hProc); $pid = $hProc->GetProcessID(); # parent continues (redirect back to original) ... close(STDOUT);close(STDERR); open(STDOUT, ">&SAVEOUT"); open(STDERR, ">&SAVEERR"); } $Pids[$i] = $pid; print "$i process started ok (pid=$pid).\n"; } # Now wait for them to finish ... for my $i (0 .. $nproc-1) { print "$i waiting for process to end...\n"; my $rc = 0; if ($CAN_FORK) { $pid = wait(); $rc = $? >> 8; $pid < 0 and die "wait failed: $!"; } else { $pid = $Pids[$i]; $hProc[$i]->Wait(Win32::Process::INFINITE()) or die "error Wait: + $! ($^E)"; $hProc[$i]->GetExitCode($rc) or die "error GetExitCode: $! ($^E) +"; } print "i=$i pid=$pid exit code=$rc\n"; }
|
---|