Add a utility function called ParRun which is a reorg of Rob's

original code in node_reboot/vnode_setup to fork off a bunch
of children. Does pretty much the same thing, but is generalized
to allow it to be used in any context via code references (which in
perl are also closures!).

db/emutil.pm.in

@@ -270,6 +270,191 @@ sub TBGetUniqueIndex($;$$)
     return $curidx;
 }
 
+#
+# A utility function for forking off a bunch of children and
+# waiting for them.
+#
+# TODO: A fatal error will leave children. Need to catch that.
+#
+sub ParRun($$$@)
+{
+    my ($options, $pref, $function, @objects) = @_;
+    my %children = ();
+    my @results  = ();
+    my $counter  = 0;
+    my $signaled = 0;
+
+    # options.
+    my $maxchildren = 10;
+    my $maxwaittime = 200;
+
+    if (defined($options)) {
+	$maxchildren = $options->{'maxchildren'}
+	    if (exists($options->{'maxchildren'}));
+	$maxwaittime = $options->{'maxwaittime'}
+	    if (exists($options->{'maxwaittime'}));
+    }
+
+    #
+    # Set up a signal handler in the parent to handle termination.
+    #
+    my $coderef = sub {
+	my ($signame) = @_;
+
+	print STDERR "Caught SIG${signame}! Killing parrun ...";
+
+	$SIG{TERM} = 'IGNORE';
+	$signaled = 1;
+
+	foreach my $pid (keys(%children)) {
+	    kill('TERM', $pid);
+	}
+	sleep(1);
+    };
+    local $SIG{QUIT} = $coderef;
+    local $SIG{TERM} = $coderef;
+    local $SIG{HUP}  = $coderef;
+    local $SIG{INT}  = 'IGNORE';
+
+    #
+    # Initialize return.
+    #
+    for (my $i = 0; $i < scalar(@objects); $i++) {
+	$results[$i] = -1;
+    }
+
+    while (@objects || keys(%children)) {
+	#
+	# Something to do and still have free slots.
+	#
+	if (@objects && keys(%children) < $maxchildren && !$signaled) {
+	    # Space out the invocation of child processes a little.
+	    sleep(1);
+	    
+	    #
+	    # Run command in a child process, protected by an alarm to
+	    # ensure that whatever happens is not hung up forever in
+	    # some funky state.
+	    #
+	    my $object = shift(@objects);
+	    my $syspid = fork();
+
+	    if ($syspid) {
+		#
+		# Just keep track of it, we'll wait for it finish down below
+		#
+		$children{$syspid} = [$object, $counter, time()];
+		$counter++;
+	    }
+	    else {
+		$SIG{TERM} = 'DEFAULT';
+		$SIG{QUIT} = 'DEFAULT';
+		$SIG{HUP}  = 'DEFAULT';
+		
+		TBdbfork();	# So we get the event system fork too ...
+		exit(&$function($object));
+	    }
+	}
+	elsif ($signaled) {
+	    my $childpid   = wait();
+	    my $exitstatus = $?;
+
+	    if (exists($children{$childpid})) {
+		delete($children{$childpid});
+	    }
+	}
+	else {
+	    #
+	    # We have too many of the little rugrats, wait for one to die
+	    #
+	    #
+	    # Set up a timer - we want to kill processes after they
+	    # hit timeout, so we find the first one marked for death.
+	    #
+	    my $oldest;
+	    my $oldestpid = 0;
+	    my $oldestobj;
+	    
+	    while (my ($pid, $aref) = each %children) {
+		my ($object, $which, $birthtime) = @$aref;
+
+		if ((!$oldestpid) || ($birthtime < $oldest)) {
+		    $oldest    = $birthtime;
+		    $oldestpid = $pid;
+		    $oldestobj = $object;
+		}
+	    }
+
+	    #
+	    # Sanity check
+	    #
+	    if (!$oldest) {
+		print STDERR 
+		    "*** ParRun: ".
+		    "Uh oh, I have no children left, something is wrong!\n";
+	    }
+
+	    #
+	    # If the oldest has already expired, just kill it off
+	    # right now, and go back around the loop
+	    #
+	    my $now = time();
+	    my $waittime = ($oldest + $maxwaittime) - time();
+
+	    #
+	    # Kill off the oldest if it gets too old while we are waiting.
+	    #
+	    my $childpid = -1;
+	    my $exitstatus = -1;
+
+	    eval {
+		local $SIG{ALRM} = sub { die "alarm clock" };
+
+		if ($waittime <= 0) {
+		    print STDERR
+			"*** ParRun: timeout waiting for child: $oldestpid\n";
+		    kill("TERM", $oldestpid);
+		}
+		else {
+		    alarm($waittime);
+		}
+		$childpid = wait();
+		alarm 0;
+		$exitstatus = $?;
+	    };
+	    if ($@) {
+		die unless $@ =~ /alarm clock/;
+		next;
+	    }
+
+	    #
+	    # Another sanity check
+	    #
+	    if ($childpid < 0) {
+		print STDERR
+		    "*** ParRun:\n".
+		    "wait() returned <0, something is wrong!\n";
+		next;
+	    }
+
+	    #
+	    # Look up to see what object this was associated with - if we
+	    # do not know about this child, ignore it
+	    #
+	    my $aref = $children{$childpid};
+	    next unless @$aref;	
+	    my ($object, $which, $birthtime) = @$aref;
+	    delete($children{$childpid});
+	    $results[$which] = $exitstatus;
+	}
+    }
+    @$pref = @results
+	if (defined($pref));
+    return -1
+	if ($signaled);
+    return 0;
+}
+
 # _Always_ make sure that this 1 is at the end of the file...
 
 1;