eyepopslikeamosquito has asked for the wisdom of the Perl Monks concerning the following question:
A while back I did
Timing and timing out Unix commands
to run commands, timing how long they took to run. Now they want a Windows version.
I don't think fork or signals will cut it on Windows, due to limitations and general weirdness of perlfork emulation under Windows.
So I've basically rewritten it, as shown below.
Update: See reply below for a better Windows version using Win32::Job.
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 times function on Windows;
its emulation in the win32_times function in
win32/win32.c always returning zero for
tms_cutime and tms_cstime.
I'd like to work around this by calling the Win32
GetProcessTimes function, but that function
is not supported by Win32::Process.
Suggestions welcome.
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);
}
Re: Timing Windows commands
by BrowserUk (Patriarch) on Feb 03, 2004 at 05:05 UTC
|
It gets a little complicated obtaining a process handle from the object returned by Win32::Process. You have to ask it for the process id, and then use the Kernel API OpenProcess() to convert that back to a native process handle so that you can call GetProcessTimes().
Once you have the times, they come back as 64-bit values of 100 nano second periods since 1/jan 1601. Unpacking and formating the these time into something reasonable is awkward. My formatting routine is very lazy and doesn't do leading zeros, and you'll need to check the math on the conversion of the kernel and user times. There may be APIs available to do the formatting and converting.
#! perl -slw
use strict;
use Win32::Process;
use Win32::API::Prototype;
$|++;
ApiLink(
'kernel32',
'BOOL GetProcessTimes(
HANDLE hProcess,
LPFILETIME lpCreationTime,
LPFILETIME lpExitTime,
LPFILETIME lpKernelTime,
LPFILETIME lpUserTime
)'
) or die $^E;
ApiLink(
'kernel32',
'HANDLE OpenProcess(
DWORD dwDesiredAccess,
BOOL bInheritHandle,
DWORD dwProcessId
)'
) or die $^E;
ApiLink(
'kernel32',
'BOOL FileTimeToSystemTime(
FILETIME* lpFileTime,
LPSYSTEMTIME lpSystemTime
)'
) or die $^E;
sub SystemTimeToString{
my( $y, $M, $dow, $d, $h, $m, $s, $milli ) = unpack 's8', $_[ 0 ];
# $dow = (qw[ Sunday Monday Tuesday Wednesday Thursday Friday Satu
+rday ])[$dow];
# $d = ( qw[ undef Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
+] )[ $d ];
return "$y/$M/$d $h:$m:$s.$milli";
}
Win32::Process::Create(
my $pObj,
"C:\\windows\\system32\\notepad.exe",
"notepad temp.txt",
0,
NORMAL_PRIORITY_CLASS,
"."
) or die $^E;
print 'Paused'; <>;
my $pid = $pObj->GetProcessID;
print "pid: $pid";
my $hProc = OpenProcess( 0x0400, 1, $pid ) or die $^E;
print "hproc: $hProc";
my( $c, $e, $k, $u ) = ('0'x8) x 4;
my( $cs, $es ) = ('0'x16) x 2;
GetProcessTimes( $hProc, $c, $e, $k, $u ) or die $^E;
FileTimeToSystemTime( $c, $cs ) or die $^E;
print 'Process created: ', SystemTimeToString( $cs );
FileTimeToSystemTime( $e, $es ) or die $^E;
print 'Process ended: ', SystemTimeToString( $es );
printf '%7.5f %7.5f', map{ unpack( 'Nx[N]', $_ ) / 10e8 }$k, $u;
__END__
P:\test>326090
Paused
pid: 3616
hproc: 72
Process created: 2004/2/3 4:53:50.390
Process ended: 2004/2/3 4:53:50.796
0.00000 15.16372
| [reply] [Watch: Dir/Any] [d/l] |
|
| [reply] [Watch: Dir/Any] |
Re: Timing Windows commands
by Roger (Parson) on Feb 03, 2004 at 02:25 UTC
|
A similar problem has been discussed last week, check out this node: 325509, "Timing a process". You could have a look there.
that function is not supported by Win32::Process
You could use Win32::API and import that function instead...
| [reply] [Watch: Dir/Any] |
Re: Timing Windows commands
by eyepopslikeamosquito (Archbishop) on Feb 03, 2004 at 05:36 UTC
|
Update: I have a simpler, cleaner version working now using
Win32::Job. I like this version a lot; note that it relies
on Windows 2000 and above.
use strict;
use Win32::Job;
select(STDERR);$|=1;select(STDOUT);$|=1; # autoflush
my $SysDir = "$ENV{SystemRoot}\\system32"; # is there a better way?
my $Outf = "out-$$.tmp";
my $Errf = "err-$$.tmp";
-f $Outf and (unlink($Outf) or die "error: unlink '$Outf': $!");
-f $Errf and (unlink($Errf) or die "error: unlink '$Errf': $!");
sub slurp_file {
my $file = shift;
local $/;
open(my $fh, $file) or die "error:open '$file': $!";
<$fh>;
}
sub write_result {
my ($pid, $rc, $elap, $user, $sys) = @_;
warn "pid=$pid, rc=$rc, elapsed=$elap user=$user sys=$sys\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) = @_;
warn "run $cmd->[0] ($cmd->[1]) at " . scalar(localtime) . "\n";
my $job = Win32::Job->new();
defined($job) or die "error creating job: $^E";
my $pid = $job->spawn($cmd->[0], $cmd->[1],
{ stdin => 'NUL', stdout => $Outf, stderr => $Errf } )
or die "error spawn: $^E";
warn "in run_for, waiting for pid=$pid\n";
$job->run($timeout);
my $stat = $job->status();
exists($stat->{$pid}) or die "oops, no status for $pid";
my $rc = $stat->{$pid}->{exitcode};
my $t = $stat->{$pid}->{time};
write_result($pid, $rc, $t->{elapsed}, $t->{user}, $t->{kernel});
}
my @cmds = (
[ "$SysDir\\netstat.exe", 'netstat -na' ],
[ $^X, 'perl -e "print STDERR Hello;sleep 15"' ],
[ $^X, 'perl -e "print STDERR World"' ],
[ "$SysDir\\cmd.exe", 'cmd /c DIR' ],
);
for my $cmd (@cmds) {
run_for($cmd, 10);
}
| [reply] [Watch: Dir/Any] [d/l] |
Re: Timing Windows commands
by MADuran (Beadle) on Feb 03, 2004 at 03:06 UTC
|
Try Win32::GetTickCount(). It should give a crude estimate(compared to UNIX time)but should do what it to do you need to Here is the documetaion . It is a function of the WIN32 module and is just a wrapper for the GetTickCount API in Windows.
Update: I really need to read more carefully. As Roger said this was in a thread last week.
MADuran Who needs a spiffy sig
| [reply] [Watch: Dir/Any] |
|
|