Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical

Comment on

( #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, 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); }

In reply to Timing Windows commands by eyepopslikeamosquito

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

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    [choroba]: Why privately? Asking in SoPW means other people with similar problems can benefit from your questions, too.

    How do I use this? | Other CB clients
    Other Users?
    Others cooling their heels in the Monastery: (4)
    As of 2018-05-26 08:57 GMT
    Find Nodes?
      Voting Booth?