perlquestion
eyepopslikeamosquito
<P>A while back I did
[id://309205]
to run commands, timing how long they took to run. Now they want a Windows version.
</P>
<P>
I don't think fork or signals will cut it on Windows, due to limitations and general weirdness of [doc://perlfork] emulation under Windows.
So I've basically rewritten it, as shown below.
<B>Update</B>: See [id://326118|reply below] for a better Windows version using [mod://Win32::Job].
</P>
<P>Though simpler than the Unix version, it's currently unable
to compute the child process CPU time. :-(
This is because the Benchmark module on Windows always returns
zero for this. I'm pretty sure the root cause of this is the
lack of the Unix <CODE>times</CODE> function on Windows;
its emulation in the <CODE>win32_times</CODE> function in
<CODE>win32/win32.c</CODE> always returning zero for
<CODE>tms_cutime</CODE> and <CODE>tms_cstime</CODE>.
I'd like to work around this by calling the Win32
<CODE>GetProcessTimes</CODE> function, but that function
is not supported by [mod://Win32::Process].</P>
<P>Suggestions welcome.</P>
<CODE>
use strict;
use Time::HiRes qw(time sleep);
use Win32::Process;
select(STDERR);$|=1;select(STDOUT);$|=1; # autoflush
### save original stdout and stderr
open(SAVEOUT, ">&STDOUT"); open(SAVEERR, ">&STDERR");
my $SysDir = "$ENV{SystemRoot}\\system32"; # is there a better way?
my $Outf = "out-$$.tmp";
my $Errf = "err-$$.tmp";
sub slurp_file {
my $file = shift;
local $/;
open(my $fh, $file) or die "error:open '$file': $!";
<$fh>;
}
sub write_result {
my ($pid, $rc, $elap) = @_;
warn "pid=$pid, rc=$rc, elapsed=$elap\n";
my $outstr = slurp_file($Outf);
my $errstr = slurp_file($Errf);
unlink($Outf) or die "error: unlink '$Outf': $!";
unlink($Errf) or die "error: unlink '$Errf': $!";
warn "cmd stdout='$outstr'\n";
warn "cmd stderr='$errstr'\n";
}
# Run command $cmd, timing out after $timeout seconds.
sub run_for {
my ($cmd, $timeout) = @_;
$timeout *= 1000; # convert to millisecs
warn "run $cmd->[0] ($cmd->[1]) at " . scalar(localtime) . "\n";
my $t0 = time();
### redirect stdout and stderr
open(STDOUT, '>'.$Outf) or die "error create '$Outf': $!";
open(STDERR, '>'.$Errf) or die "error create '$Errf': $!";
Win32::Process::Create(my $hProc, # process object
$cmd->[0], # executable
$cmd->[1], # command line
1, # inherit handles
NORMAL_PRIORITY_CLASS, # priority
'.') # working dir
or die "error create process: $!";
### parent continues (redirect back to original) ...
close(STDOUT); close(STDERR);
open(STDOUT, ">&SAVEOUT"); open(STDERR, ">&SAVEERR");
my $pid = $hProc->GetProcessID();
warn "in run_for, waiting for pid=$pid\n";
$hProc->Wait($timeout) or $hProc->Kill(42), $hProc->Wait(INFINITE);
$hProc->GetExitCode(my $rc) or warn "error GetExitCode: $!\n";
my $t1 = time();
write_result($pid, $rc, $t1 - $t0);
}
my @cmds = (
[ "$SysDir\\netstat.exe", 'netstat -na' ],
[ $^X, 'perl -e "print STDERR Hello;sleep 15"' ],
[ "$SysDir\\cmd.exe", 'cmd /c DIR' ],
);
for my $cmd (@cmds) {
run_for($cmd, 10);
}
</CODE>