Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked

Win32 capturing output from a process that may hang

by Random_Walk (Prior)
on Mar 02, 2005 at 11:19 UTC ( #435766=perlquestion: print w/ replies, xml ) Need Help??
Random_Walk has asked for the wisdom of the Perl Monks concerning the following question:

Wise Brothers and Sisters in Perl I beg your assistance

I have a perl script that queries an Oracle database using sqlplus on Win2003. The perl script is run by a Tivoli monitor that has a hard time limit of 120 seconds. Sometimes the SQL plus fails to return, the Tivoli monitor times out and a perl process is left hanging around waiting on sqlplus.

I can not use DBI due to local managment decision

What I want is to run the sqlplus command and if it has not returned after 110 seconds kill it and return an appropriate error to Tivoli. If it does complete in 110 seconds I need to capture STDOUT and process it. I thought this should be easy.

I have tried using $SIG{ALRM} and alarms, they are not implemented in Active State on Windows.

I have tried using win32::Process and grabbing STDOUT with no luck, here is my test code

#!/usr/bin/perl use strict; use warnings; use Win32::Process; use Win32; $|++; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # spawn process #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ my $process="c:\\perl\\bin\\perl.exe"; my $output="nothing"; open OUT, ">", \$output; select OUT; my $ProcObj; Win32::Process::Create ( $ProcObj, $process, "perl 1 2 3", 0, NORMAL_PRIORITY_CLASS, "." ) or die "Create process failed: $!"; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # wait 10 seconds for process to finish #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ unless ( $ProcObj->Wait(10000) ) # waits for 10,000 milliseconds { #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # process has not completed, so return # result for monitoring probe and kill # wntmon process #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "-1"; $ProcObj->Kill(2001); } print "Ball cocks\n"; select STDOUT; print "output was: $output\n"; __END__ # just prints the @ARG array it gets # output is this C:\PERL\bin>perl this was called with: 1, 2, 3 output was: Ball cocks
I also found others have tried to follow this via dolorosa capturing STDOUT after Win32::Process::Create()

And finally I thought open a handle to the process and use select but the results of my search were rather off-putting IO::Select on Windows, stdin-socket without fork()?? and RE: stdin-socket without fork()??

What is the normal way to do this under Windows ? Do I need to fork and set up some form of IPC to get the results back ? Would I be OK to spawn a thread and use a shared data structure to get the results from the thread ? What is considered best practice ? One last caveat, this script has to run on Unix too so the less different the behaviour can be for the two OSes the happier I shall be, though I do expect I will have to write a sub for each OS.

My Gratitude in advance,

Pereant, qui ante nos nostra dixerunt!

Comment on Win32 capturing output from a process that may hang
Select or Download Code
Replies are listed 'Best First'.
Re: Win32 capturing output from a process that may hang
by Corion (Pope) on Mar 02, 2005 at 11:39 UTC

    I would spawn a second Perl process (possibly via system(qq{start "$^X" -w}), which starts sqlplus and writes the output to a file, and writes a .ok-file if it has completed. If the .ok file doesn't exist after 110 seconds, report the failure, otherwise report the result of the SQL query.

Re: Win32 capturing output from a process that may hang
by ZlR (Chaplain) on Mar 02, 2005 at 11:48 UTC

      This looks really nice but I can not get it to work :(

      C:\system\Perl\bin>perl one two This is my @ARGV one, two >perl -MWin32::Job -le"$job=Win32::Job->new;$job->spawn('perl', 'perl one two', {stdout=> 'test.out'}); print "ran OK" if $job->ru +n(5);" >type test.out >dir test.out Volume in drive C is CDRIVE Volume Serial Number is 144D-4181 Directory of C:\system\Perl\bin 02/03/2005 16:13 0 test.out 1 File(s) 0 bytes 0 Dir(s) 2,907,258,880 bytes free C:\system\Perl\bin>time The current time is: 16:13:31.15 Enter the new time:
      It is also not printing "Ran OK" even though it is returning the prompt imediately so not hitting the 5 second timeout. Did I miss something obvious ? (I also tried giving it stdout => 'test.out' which the doco says should also work, same thing, zero byte file)


      Pereant, qui ante nos nostra dixerunt!
        I will have to check later on a 5.8 install .
        At first i'd say it doesn't print "ran OK" because the run method applies the timeout only if something went wrong which is not the case here . From the docs of run:

        Returns a boolean indicating whether the processes exited by themselves, or whether the time expired.


Re: Win32 capturing output from a process that may hang (Updated!)
by BrowserUk (Pope) on Mar 02, 2005 at 14:42 UTC
    Would I be OK to spawn a thread and use a shared data structure to get the results from the thread ?

    Hmm. Seems select doesn't timeout on pipes! If the spawn process writes output regulalry as my did, then this works, but if it doesn't, the select never times out and it blocks forver:(

    Update2: This works now even if the process produces no ouput.

    That's the way I would do it. I don't see any reason this shouldn't work equally well on non-win systems (assuming a threaded perl), but I don't have the facility to test that.

    #! perl -slw use strict; use threads; use Thread::Queue; sub captureWithTimeout { my( $cmd, $Q, $timeout ) = @_; my $pid = open CMD, "$cmd |" or die "$cmd : $!"; sleep $timeout; my $rv; $rv = kill 9, $pid if kill 0, $pid; $Q->enqueue( $_ ) while defined( $_ = <CMD> ); return $rv; } my $Q = new Thread::Queue; my $t = threads->create( \&captureWithTimeout, $ARGV[ 0 ], $Q, $ARGV[ 1 ] ); print "Running '$ARGV[ 0 ] for $ARGV[ 1] seconds"; print "It took too long, so I killed it" if $t->join; print 'It produced the following output:'; printf $Q->dequeue while $Q->pending; __END__ P:\test>435776 "perl 15" 10 Running 'perl 15 for 10 seconds It took too long, so I killed it It produced the following output: Starting 1 2 3 4 5 6 7 8 9 P:\test>435776 "perl 15" 20 Running 'perl 15 for 20 seconds It produced the following output: Starting 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Stopping

    Examine what is said, not who speaks.
    Silence betokens consent.
    Love the truth but pardon error.

      Thanks BrowserUK

      I feared that threads under windows were flakey but I guess that is old news. If you think they are safe I am more than happy to use them. Have done quite a bit under *nix with them and for a simple job like this they work perfectly there so this does give me the one size fits all solution.


      Pereant, qui ante nos nostra dixerunt!

        Thanks. A few words of caution. Unless you want to do other things in your main code during the timeout, you don;t need the thread. Something as simple as this (almost) suffices:

        #! perl -slw use strict; my( $cmd, $timeout ) = @ARGV; print "Running '$cmd' for $timeout seconds"; my $pid = open CMD, "$ARGV[ 0 ] |" or die "'$ARGV[ 0 ] : $!"; print $pid; sleep 1 while $timeout-- and kill 0, $pid; my $rv = kill 9, $pid; my @capture = <CMD>; print "It took too long, so I killed it" if $rv; print 'It produced the following output:'; printf $_ for @capture;

        That will allow the spawned process to run for the timeout number of seconds before killing it and returning whatever output it had managed to produce--but there are problems.

        1. The timeout will always run to completion, even if the process finishes early.

          The sleep 1 while $timeout-- and kill 0, $pid; is meant to allow the timeout to be shorted circuited if the process finishes, but it doesn;t work.

          Even though kill 0, $pid will return false if the process never existed, it seems to continue to return true, once it has returned true once, even after the process has gone away?

          I think this is a bug in perl's implementation of kill on win32, but I a, finding it hard to confirm that.

        2. If the process produces a large volume of output, then the pipe between the processes "fills" and the spawned process will block until the spawning process reads some data from the it's end of the pipe.

          That means that the spawned process will always be killed and only partial output returned, even if it could produce all of the data within the timeout period if it didn't get blocked. Ie. If the spawning process was serviceing it's end of the pipe.

          This problem could be alleviated by reading this end of the pipe as the output is being produced, but of course, the moment we go into a read state on the pipe, we block until the spawned process produces output. Back to problem one.

          So the next thing (actually, the original thing) I tried was to use select on the pipe handle to determine if tehre was something available to read before attempting a read, but neither select, nor IO::Select->can_read() seem to work on (Win32) pipes?

          If this limitation is documented, I have been unable to find it.

        The upshot. If your process only produces a small volue of output, and you can live with always waiting for the full timeout period, the above code, or the threaded version above may be usable, but otherwise, you'd best consider some of the other options.

        Sorry if I gave you false hope, but I've long since given up putting to much effort into exploring things until the OP shows some interest in the possible solution I am offereing. I've spent way to many hours exploring and testing possible solutions only to have the OP pop back and say "Oh, but I don't like threads!", or "Your code doesn't work exactly the way I want it to so I'm not going to be bothered to try and correct it myself, I'm just coing to complain and do something completely different.".

        If that sounds a little jaundiced--it is:(

        Examine what is said, not who speaks.
        Silence betokens consent.
        Love the truth but pardon error.

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2016-02-09 07:45 GMT
Find Nodes?
    Voting Booth?

    How many photographs, souvenirs, artworks, trophies or other decorative objects are displayed in your home?

    Results (309 votes), past polls