#!/etrade/bin/perl
for ($i=0; $i<=10; $i++) {
        wait_for_a_kid() if keys %pid_to_node > 3;
        $pid = fork;
        if ($pid) {
                ## parent does...
                $pid_to_node{$pid} = $i;
        }
        else {
                print "$i $$\n";
                local $SIG {ALRM} = sub {
                print "\tKilled PID $$\n";
                kill 15, $$ or die "kill: $!"}; # Just SIGTERM
                alarm 6;
                eval {
                        ## child does...
                        exit !&Test;
                        waitpid $pid => 0;
                };
        }
}
## final reap:
1 while wait_for_a_kid();

sub wait_for_a_kid {
        my $pid = wait;
        return 0 if $pid < 0;
        delete $pid_to_node{$pid} or warn("Why did I see $pid ($?)\n")
+, next;
}

sub Test {
        sleep 5;
}
[download]

Glad to know it's fixed.

As I think about it a little, though, sending yourself a SIGTERM is a bit redundant, you could of course just 'die' or 'exit' in the SIGALRM handler.

Also...you're calling 'waitpid' in the child (which is odd) after a call to exit (which is odder).

The other way of doing this, of course, is to get the parent to periodically wake up (you can do this with waitpid and a sleep) and calculate if it should kill off a child (just store each pid's start time and kill off the old ones, maybe keeping them in a sorted list of age or something).

One case where you might need to have the parent do it is if your long-running code calls out to some XS code which doesn't return up to perl when it receives a signal.

Since perl 5.8, perl uses 'safe signals' by default, which means that your signal handlers only fire when control returns to the perl interpreter. This can be a long time (or never) when you call out of perl into C/XS code. (Safe signals are 'better', but you sometimes need to be aware of this issue when doing signal handling in perl).

Thanks again. Like I mentioned in the original post, I wasn't quite sure what some of the stuff was doing. Not much "fork" experience and what I was using was just bits n pieces I found via google. Using your last post, this is what I came up with and still seems to work just fine. I like doing just the exit instead of the kill.

#!/etrade/bin/perl
for ($i=0; $i<=10; $i++) {
        wait_for_a_kid() if keys %pid_to_node > 3;
        $pid = fork;
        if ($pid) {
                ## parent does...
                $pid_to_node{$pid} = $i;
        }
        else {
                print "$i $$\n";
                local $SIG {ALRM} = sub {
                        print "\tKilled PID $$\n";
                        exit(1)};
                alarm 2;
                eval {
                        ## child does...
                        &Test;
                };
        }
}
## final reap:
1 while wait_for_a_kid();

sub wait_for_a_kid {
        my $pid = wait;
        return 0 if $pid < 0;
        delete $pid_to_node{$pid} or warn("Why did I see $pid ($?)\n")
+, next;
}

sub Test {
        sleep 5;
}
[download]

Hmm, thought it was working fine... But, the exit here seems to be necessary... I took it out and let it run and after getting back from getting my coffee I found that I had 1900+ processes running. Oops. Putting the exit back in before the call to the sub seems to stopped that from happening.

        else {
                local $SIG {ALRM} = sub {
                        print "$node KILLED $$\n";
                        exit(1)};
                alarm 20;
                eval {
                        ## child does...
                        exit !&GetSvrStatus($node);
                };
        }
[download]