run foo-bar-id
foo-foo-foo
bar-bar-bar
qux-qux-qux
.

##</code><code>##


#!/usr/bin/perl

use warnings;
use IO::Handle;
use IO::Select;
use File::Temp;
use Data::Dumper;

#use constant SCRIPT_PATH => '/path/to/obscure/program'; # It's always there.

if (-x SCRIPT_PATH) {
  print "OK\n";
} else {
  print "FAIL No script found at " . SCRIPT_PATH . "\n";
  exit(1);
};

STDIN->blocking(0);
STDOUT->blocking(0);

my $io = IO::Handle->new_from_fd(fileno(STDIN), "r");
my $select = IO::Select->new($io);


my $buf = "";

$DEADER = 0;

sub Zombie_Alert {
  $DEADER = wait;
#  $SIG{CHLD} = \&Zombie_Alert;
};

$SIG{CHLD} = \&Zombie_Alert;

%CHILDREN = ();

KEEPEMCOMIN: while (my @ready = $select->can_read(undef)) {
  foreach my $handle (@ready) {
    my $line = ""; my $bufline = "";

    my $rv = $handle->sysread($bufline, 4096);
    $line .= $bufline;
    while ($rv == 4096) {

      $rv = $handle->sysread($bufline, 4096);
      $line .= $bufline unless !$rv;
    };

    if ($handle->fileno == fileno(STDIN)) { # process commands from STDIN
      $buf .= $line;
      next KEEPEMCOMIN if $buf !~ /(^(run).*?^\.$)|(^(kill|quit).*?$)/sim;

      $buf =~ s#\r\n#\n#g;

YESSIR: while ($buf =~ /(^run.*?^\.$)|(^kill.*?$)|(^q(uit)?$)/gsim) {
        my $lbuf; $lbuf = $1 if $1; $lbuf = $2 if !$1 && $2;
        $lbuf = $3 if !$1 && !$2 && $3; my $savebuf = $lbuf;
        $lbuf =~ s#^\.\n##g;

        if ($lbuf =~ s/(^run.*?^)//sim) { $cmd = $1; chomp $cmd; };

        if ($cmd =~ /^run(\s+nowatch)?\s+(.*?)$/i) { # RUN command
          my $id = $2;
          my $watch = $1 && $1 =~ /nowatch/i ? 0 : 1;

          if (!$id) { print "FAIL No id specified\n"; next; };

         print spawn($id, $watch, $lbuf), "\n";
        } elsif ($cmd =~ /^kill\s+(.*?)$/i) {        # KILL command
          my $id = $1;

          if (my $pid = $CHILDREN{'id'.$id}) {
            my $fd = $CHILDREN{'id'.$id}{'io'}->fileno;

            kill SIGTERM, $pid;
            $select->remove($fd);
            undef $CHILDREN{'id'.$id}{'io'};
            delete($CHILDREN{'id'.$id});
            delete($CHILDREN{'pid'.$pid});
            delete($CHILDREN{'fd'.$fd});

            print "OK\n";
          } else {
            print "FAILED $2 No such id\n";
          };
        } elsif ($cmd =~ /^quit$/i) {   # QUIT command
          $SIG{CHLD} = 'IGNORE';
          foreach my $key (keys %CHILDREN) {
            next unless $key =~ /pid\d+/;
            kill SIGTERM, $CHILDREN{$key}{'pid'};

          };
          print "OK\n";
          exit(0);
        };
        $buf =~ s/$savebuf// unless !$savebuf;
        $buf =~ s/^\s*//g;
        next YESSIR if $buf;
      };
    } else {                          # process input from children
      local $id = $CHILDREN{'fd'.$handle->fileno}{'id'} . " ";
      foreach my $chunk (split /\n/, $line) { print "${id}${chunk}\n"; };
    };
  };
  if ($DEADER > 0) {   # ZOMBIE ALERT!
      if (exists($CHILDREN{'pid'.$DEADER})) {
        my $id = $CHILDREN{'pid'.$DEADER}{'id'};
        my $pid = $CHILDREN{'pid'.$DEADER}{'pid'};
        my $io = $CHILDREN{'pid'.$DEADER}{'io'};
        my $watch = $CHILDREN{'pid'.$DEADER}{'watch'};
        my $buf = $CHILDREN{'pid'.$DEADER}{'buf'};

        delete($CHILDREN{'id'.$id});
        delete($CHILDREN{'pid'.$pid});

        delete($CHILDREN{'fd'.$io->fileno});
        $select->remove($io->fileno);
        undef $io;

        if ($watch) {
          $ret = spawn($id, $watch, $buf);
          if ($ret =~ /FAIL/) { print "$ret\n"; }
        };
      } else { print "FAIL Unknown id died\n"; };
    $DEADER = 0;
    next KEEPEMCOMIN;
  };
};

exit(0);

$HANDLE = 1; # initial file handle number
$TMPNAME = undef; # temp file name

sub spawn {
  my ($id, $watch, $buf) = @_;

  unlink $TMPNAME unless !$TMPNAME;

  ($tmph, $TMPNAME) = File::Temp::tempfile();
  print $tmph $buf, "\n";
  close($tmph);

  $HANDLE++;

  if (my $pid = open('CHILD'.$HANDLE, "-|")) {    # parent process here
    my $rd = IO::Handle->new_from_fd(fileno('CHILD'.$HANDLE), "r");
    $select->add($rd);

    my %kid;
    $kid{'id'} = $id;
    $kid{'pid'} = $pid;
    $kid{'io'} = $rd;
    $kid{'watch'} = $watch;
    $kid{'buf'} = $buf;

    $CHILDREN{'id'.$id} = \%kid;
    $CHILDREN{'pid'.$pid} = \%kid;
    $CHILDREN{'fd'.$rd->fileno} = \%kid;

    return "RUNNING $id";
  } elsif (defined($pid)) {  # child process here
    $SIG{INT} = $SIG{TERM} = $SIG{CHLD} = 'DEFAULT';
    open(STDIN, "<$TMPNAME");
    select STDOUT; $| = 1;
    exec(SCRIPT_PATH) or return "FAIL $id Cannot exec: $!";
  } else {
    return "FAIL $id Cannot fork: $!";
  };
};