#!/usr/bin/perl
#

{
package Runner;

use strict;
use warnings;
use threads;
use Thread::Queue;
use IPC::Open3;

sub new {
    my $class = shift;
    return bless {}, $class;
}

sub load {
    my $self=shift;
    for (@_) {
        $self->{$_}={};
    }
}

sub run {
    my $self=shift;
    my $timeout=shift;
    my $running_commands = 0;
    my @threads;
    local $SIG{CHLD}='IGNORE'; # incantation against zombies is this voodoo ?

    while (my ($command, $info) = each %$self) {
        $info->{stdout}    = new Thread::Queue;
        $info->{stderr}    = new Thread::Queue;
        $info->{signaling} = new Thread::Queue;
        push @threads, threads->create(
            \&RunInThread,
            $command,
            $info->{stdout},
            $info->{stderr},
            $info->{signaling},
        );
        $info->{output} = [];
        $info->{error}  = [];
        $info->{status} = 2;
        $info->{pid}    = $info->{signaling}->dequeue;
        $running_commands++;
    }

    for my $time (1..$timeout) {
        last unless $running_commands;
        sleep 1;
        for my $info (values %$self) {
            next unless ($info->{status})>>1;
            while (my $result = $info->{signaling}->dequeue_nb) {
                $info->{outcome}=$result;
                if ($result eq "command complete") {
                    $info->{status}=0;
                    $info->{time}=$time;
                    $running_commands--;
                    next;
                } else {
                    # something bad is being signalled
                    $info->{status}=1;
                }
            }
            while (my $result = $info->{stdout}->dequeue_nb) {
                push @{$info->{output}}, $result;
            }
            while (my $error  = $info->{stderr}->dequeue_nb) {
                push @{$info->{error}}, $error;
            }
        }
    }
    # time is up
    # kill those that did not complete

    my $killed=0;
    if ($running_commands) {
        for my $info (values %$self) {
            next unless $info->{status} == 2;
            $killed++;
            # politeness costs nothing ?
            kill 15, $info->{pid};
            while (my $result = $info->{stdout}->dequeue_nb) {
                if ($result eq "command complete") {
                    $info->{status}=0;
                    $info->{time}=$timeout;
                    next;
                }
                push @{$info->{output}}, $result;
            }
            kill 9, $info->{pid};
            waitpid $info->{pid}, 0;
        }
    }
    $_->join for @threads;
    return $killed;
}

sub RunInThread {
    my ( $cmd, $stdout, $stderr, $signaling) = @_;
    my ( $in, $out, $err, $pid);
    # duplicate stderr and stdout
    open( $out, ">&STDOUT" ) or
        die "Can't dup STDOUT to OUTPUT: $!\n";
    open( $err, ">&STDERR" ) or
        die "Can't dup STDERR to OUTERR: $!\n";
    eval { $pid = open3($in, $out, $err, $cmd) };
    if ($@) {
        $signaling->enqueue($@);
        exit 1; # this will be in a forked child
    } else {
        $signaling->enqueue($pid);
        $stdout->enqueue( $_ ) while <$out>;
        $stderr->enqueue( $_ ) while <$err>;
        $signaling->enqueue("command complete");
    }
}

# the following right bracket closes the package
}
1;