+package Jobs;
+
+use strict;
+use warnings;
+
+use Errno;
+use POSIX ':sys_wait_h';
+
+sub newjob {
+ my $f = shift;
+ my $jobs = shift;
+ my $debug = shift;
+ my $pid;
+
+ if (not $debug) {
+ $pid = fork();
+ if (not defined($pid)) {
+ die("fork: $!");
+ }
+ }
+
+ if ($debug or $pid == 0) {
+ exit($f->());
+ }
+
+ if ($pid == 0) {
+ exit($f->());
+ }
+
+ push(@$jobs, $pid);
+
+ return $pid;
+}
+
+sub deljob {
+ my $pid = shift;
+ my $status = shift;
+ my $jobs = shift;
+
+ for (my $i = 0; $i <= $#$jobs; $i++) {
+ if ($pid == $jobs->[$i]) {
+ splice(@$jobs, $i, 1);
+ last;
+ }
+ }
+
+ return ($pid, $status);
+}
+
+sub run {
+ my %o = @_;
+ my $maxjobs = $o{'max-jobs'};
+ my $get_job = $o{'get-job'};
+ my $notify_start = $o{'notify-start'};
+ my $notify_finish = $o{'notify-finish'};
+ my @jobs;
+ my $pid;
+
+ # Call notifier function if given.
+ sub call {
+ my $f = shift or return;
+ ref($f) eq 'CODE' or return;
+ $f->(@_);
+ }
+
+ while (1) {
+ if (@jobs <= $maxjobs) {
+ my $job;
+ while (defined($job = $get_job->())) {
+ $pid = newjob($job, \@jobs, $o{'debug'});
+ call($notify_start, $pid, @jobs);
+ @jobs < $maxjobs or last;
+ }
+
+ # No jobs running and get-job returned undef; we're finished.
+ if (@jobs == 0 and not defined($job)) {
+ return;
+ }
+ }
+
+ # Now running as many jobs as we can, block waiting for one to die.
+ do {
+ $pid = waitpid(-1, 0);
+ } while ($pid == 0
+ or ($pid == -1 and ($!{ECHILD} or $!{EINTR})));
+ $pid == -1 and die("waitpid(-1): $!");
+
+ # Before starting more, see if any others have finished.
+ do {
+ call($notify_finish, deljob($pid, $?, \@jobs), @jobs);
+ } while (($pid = waitpid(-1, WNOHANG)) > 0);
+ if ($pid == -1) {
+ $!{ECHILD} or $!{EINTR} or die("waitpid(-1): $!");
+ }
+ }
+}
+
+\f
+################################################################################
+package main;
+