捕获下标中的输出，超时

Question

I have a perl script that runs a subscript to gather 5 lines of information. At present it is being done like this:

my @info = split(/\n/,`/script/directory/$devtype.pl $ip $port`);

However, for various reasons outside of my control, the subscript can sometimes hang, and in those cases i would like to just stop the subscript and move on. What would be the best approach to

• Get the PID of the subscript
• Wait for those 5 lines of output, and kill -9 the pid if output isn't received before a set timeout

I was thinking of use ing Forks::Super , share @info with the subscript, and have a loop that waits for the array to fill up, up to the timeout. However, i'm not sure how to achieve this without rewriting the subscript, something i'd prefer not to because of backwards-compatibility with other scripts.

Answer 1

The following code uses IPC::Run to fetch 5 lines to @info with a timeout of 30 seconds and assure the child process is dead:

#!/usr/bin/env perl
use strict;
use warnings qw(all);

use IPC::Run qw(start timeout new_chunker input_avail);

my @info;
my $h;

# trap timeout exception
eval {
    $h = start
        # beware of injection here!
        # also, $^X holds the name of your actual Perl interpreter
        [$^X, "/script/directory/$devtype.pl", $ip, $port],

        # read STDOUT line-by line
        '>', new_chunker,

        # handle each line
        sub {
            my ($in, $out) = @_;
            if (input_avail) {
                if (5 > @info) {
                    chomp $in;
                    push @info, $in;
                    return 1;
                } else {
                    return 0;
                }
            }
        },
        timeout(30);

    # is it dead yet?
    $h->finish;
};

# make sure it is dead
if ($@) {
    warn "exception: $@";
    $h->kill_kill;
}