Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Timing Windows commands

by eyepopslikeamosquito (Canon)
on Feb 03, 2004 at 02:20 UTC ( #326090=perlquestion: print w/ replies, xml ) Need Help??
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, so I have basically rewritten it, as shown below.

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); }

Comment on Timing Windows commands
Select or Download Code
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...

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
Re: Timing Windows commands
by BrowserUk (Pope) 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

    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    Timing (and a little luck) are everything!

      Thankyou very much for providing example code! I may yet take this approach. I was also thinking it may be cleaner to submit a patch for Win32::Process to allow it support GetProcessTimes natively (though this is a bit of a pest because this Win32 call is not supported on Win95 lineage).

Re: Timing Windows commands
by eyepopslikeamosquito (Canon) 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); }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://326090]
Approved by Roger
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (8)
As of 2014-10-25 15:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (145 votes), past polls