#!/usr/bin/perl
#
# thread pooler (public domain)
#

sub do_action ($@) {
    my ($logfile, @cmd) = (@_);

    print "Spawning $logfile as pid $$ - @cmd...\n";
    open STDOUT, ">>log.$logfile";
    open STDERR, ">&STDOUT";
    open STDIN, "</dev/null";
    exec @cmd;
}


sub do_actions($$@) {
# keep four threads
    my $NUM_THREADS = 4;
    local $active_threads = 0;

# %pidtracker is a mapping of pids to module names
# %modstatus is a mapping of module names to exit codes
    local (%pidtracker, %modstatus, %starttime, %finishtime);

# donelist is added to by the signal handler that reaps children
    local @donelist;
    sub showdone {
 while ($#donelist >= 0) {
     $a=pop @donelist;
     $delta = $finishtime{$pidtracker{$a}} -
  $starttime{$pidtracker{$a}}; 
     if ($modstatus{$pidtracker{$a}} & 255) {
  print "We culled $pidtracker{$a} with signal " .
      "$modstatus{$pidtracker{$a}}\n";
     } else {
  $rtncode = ($modstatus{$pidtracker{$a}} >> 8);
  if ($rtncode == 0) {
      print "Module $pidtracker{$a} returned ok after ${delta}s\n";
  } else {
      print "Module $pidtracker{$a} exited with error code " .
   "$rtncode after ${delta}s\n";
  }
     }
     delete $pidtracker{$a};
 }
    }

    $SIG{CHLD} = sub {  # a lot in a signal handler, but hey.
 my $pid = wait;
 --$active_threads;
 $modstatus{$pidtracker{$pid}} = $?;
 push @donelist, $pid;
 $finishtime{$pidtracker{$pid}} = time();
    };
    $SIG{ALRM} = sub { };

    my ($cmd,$timeout,@modules) = (@_);
    print "Running modules @modules\n";
    @modules = reverse @modules;

    while (($#modules >= 0) or ($active_threads > 0)) {
 if ($active_threads < $NUM_THREADS and ($#modules >= 0)) {
     my $this_module = pop @modules;
     $modstatus{$this_module} = "still running";
     $finishtime{$this_module} = 0;
     my $pid;
     if ($pid = fork) {
  ++$active_threads;
  $pidtracker{$pid} = $this_module;  # running (allocate space so
  # the signal handler doesn't core)
  $starttime{$this_module} = time();
     } else {
  do_action $this_module, "$cmd";
  die; # not reached
     }
 } else {
     for (values %pidtracker) {
  if (not $oldestchild or $oldestchild > $starttime{$_}) {
      $oldestchild = $_;
  }
     }
     $sleeptime = ($oldestchild + $timeout - time());
     if ($sleeptime < 2) {$sleeptime = 2};
     sleep $sleeptime;   # will abort if children return
   }
 
 for (keys %pidtracker) {
     my $age = time() - $starttime{$pidtracker{$_}} - $timeout;
     if ($age > 0) {
  if ($age > 5) {
      print "Killing hard $pidtracker{$_}\n";
      kill "KILL", $_;
  } else {
      print "Killing $pidtracker{$_} (timeout " .
   "${timeout}s)\n";
      kill "TERM", $_;
  }
     }
 }
 pause;
 &showdone;
    }
}

#---------------------------------------------------------------------
+--------
#  MAIN SECTION STARTS HERE
#---------------------------------------------------------------------
+--------

@modules = qw(foo bar baz bat banana snafu fubar as many we like);

do_actions "sleep `perl -e 'print int rand 20'`", 10, @modules;
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.