bloonix has asked for the wisdom of the Perl Monks concerning the following question:

Hello Monks,

I'm seeking for you wisdom and hope that someone can help me a bit.

I wrote a little daemon that executes programs with IPC::Open3 and intercepts the output from stdout and stderr. IO::Select is used to check if a handle is ready and alarm() for timeouts within eval{}.

The daemon is running very nice on linux, but unfortunately not on windows.

Now I was searching for another solution and thought about to use threads.

In the following example a thread is created to execute a program. The parent waits until $timeout and then detach the thread and kills the process that is maybe still running. 

#!perl.exe
use strict;
use warnings;
use threads;
use threads::shared;
use Data::Dumper;
use IPC::Open3;
use Symbol;

my %data : shared;
my $timeout = 3;
my $command = "perl test.pl";
my $tid = threads->create(sub { execute($command) });

while (--$timeout) {
    if ($tid->is_joinable) {
        $tid->join;
        last;
    }
    sleep 1;
}

if ($timeout == 0) {
    if ($data{pid}) {
        kill -9, $data{pid};
    }
    $tid->detach;
    $data{timedout} = 1;
}

print Dumper(\%data);

sub execute {
    my $in  = Symbol::gensym();
    my $out = Symbol::gensym();
    my $err = Symbol::gensym();
    my $pid = open3($in, $out, $err, @_);
    close $in;
    $data{pid} = $pid;
    # sorry for that dirty handling of $out and $err :-)
    # it was just a hack for tests
    $data{stdout} = do { local $/; <$out> };
    $data{stderr} = do { local $/; <$err> };
    close $out;
    close $err;
    threads->exit;
}

[download]
Now my question to you is: could it be simplier? I don't know if my code example is too much dirty, because I haven't the finest idea of windows.

I would be very pleased for your wisdom.

Cheers
Jonny

Edit: a short code fix

Replies are listed 'Best First'.
Re: Windows, threads and IPC::Open3
by BrowserUk (Patriarch) on Nov 07, 2010 at 22:18 UTC

    This is a bit simpler than yours, a lot simpler than the CPAN 'solutions', and it works even if the program produces a lot of output: 

    #! perl -slw
use strict;
use IPC::Open3;
use threads stack_size => 4096;

## Kill 0,pid does appear to work properly,
## It return true even after the executable is dead & gone
sub checkPid{
    scalar( `tasklist /nh /fi "pid eq $_[0]"` !~ m[INFO]sm );
}

sub execute {
    my(  $timeout, @command, ) = @_;
    my( $err, $in, $out ) = do{ local *FH; \*FH };
    my $pid = open3( $in, $out, $err, @command )
        or die "@command : $!/$@/$^E";
    my( $Tout ) = threads->create( sub{
        my( $Terr ) = threads->create( sub{ my @in = <$err>; return \@
+in } );
        my @in = <$out>;
        return \@in, $Terr->join;
    } );
    sleep 1 while checkPid( $pid ) and --$timeout;
    kill 3, $pid unless $timeout;
    return $Tout->join, $timeout == 0;
}

my @cmd = (
    'perl.exe',
    q[-le"$|++; print($_), warn( $_), Win32::Sleep 250 for 1 .. 12" ]
);
my( $out, $err, $timeout ) = execute( 2, @cmd );

print 'Command ', $timeout ? 'timed out' : 'completed';
print "From stdout:[\n @$out ]" if @$out;
print "From stderr:[\n @$err ]\n" if @$err;

( $out, $err, $timeout ) = execute( 5, @cmd );
print 'Command ', $timeout ? 'timed out' : 'completed';
print "From stdout:[\n @$out ]" if @$out;
print "From stderr:[\n @$err ]" if @$err;

    [download]

    Produces:

    C:\test>869942
Command timed out
From stdout:[
 1
 2
 3
 4
 5
 ]
From stderr:[
 1 at -e line 1.
 2 at -e line 1.
 3 at -e line 1.
 4 at -e line 1.
 5 at -e line 1.
 ]

Command completed
From stdout:[
 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 ]
From stderr:[
 1 at -e line 1.
 2 at -e line 1.
 3 at -e line 1.
 4 at -e line 1.
 5 at -e line 1.
 6 at -e line 1.
 7 at -e line 1.
 8 at -e line 1.
 9 at -e line 1.
 10 at -e line 1.
 11 at -e line 1.
 12 at -e line 1.
 ]

    [download]

    The discrepancy between the 1 1/4 seconds of output gathered and the 2 second timeout in the first run, is down to pipe buffering.

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
Re: Windows, threads and IPC::Open3
by ikegami (Patriarch) on Nov 07, 2010 at 21:01 UTC

    First of all, that won't work. If either pipes fill up, the child will block and never exit. You also don't kill the child on timeout. (I'm blind!)

    So let's examine what your original solution doesn't work on Windows:

    • You can only select() sockets on Windows.
    • alarm() is emulated by Perl, so it may not work in this circumstance.

    Using sockets instead of pipes to communicate with the child (as demonstrated here) would solve the first problem, so all that's left would be to use select()'s timeout argument instead of alarm.

    And now we'll forget everything I said because we don't want to reinvent the wheel. Just use IPC::Run.

[reply]
[d/l]
      The code example works on Windows Vista. test.pl only calls sleep(20) and the thread will be detached after 3 seconds and the process with $data{pid} is killed. :/
[reply]
        If either pipes fill up, the child will block and never exit.
[reply]
        If either pipes fill up, the child will block and never exit.
[reply]

Back to Seekers of Perl Wisdom