Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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

In reply to Timing Windows commands by eyepopslikeamosquito

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2024-03-29 14:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found