my %children = (); # keys are current child process IDs my $children = 0; # current number of children # Install signal handlers for children. $SIG{CHLD} = \&REAPER; $SIG{INT} = \&HUNTSMAN; # create a set of children for (1..$max_connections) { my $group = shift @groups; bear_child( $group) if defined $group; last if @groups == 0; } # And maintain the population. MAINTAIN: while (@groups > 0) { sleep; # wait for a signal (i.e., child's death) for (my $i = $children; $i < $max_connections; $i++) { my $group = shift @groups; bear_child( $group); # top up the child pool last MAINTAIN if @groups == 0; } } # wait for the last of the children to complete scanning sleep while $children > 0; # reap any wayward children and exit cleanly HUNTSMAN(); sub REAPER { $SIG{CHLD} = \&REAPER; my $pid = wait; $children--; delete $children{$pid}; print "reaping child $pid\n"; } # handler for SIGINT and normal exit - kill all the children sub HUNTSMAN { local($SIG{CHLD}) = \&REAPER; # we're going to kill our children kill 'INT' => keys %children; exit; } # spawn subprocesses to search groups sub bear_child { my $group = shift; my $pid; my $sigset; # block signal for fork $sigset = POSIX::SigSet->new(SIGINT); sigprocmask( SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: $!\n"; # fork a subprocess die "fork: $!" unless defined ($pid = fork); if ($pid) { # Parent records the child's birth and returns. sigprocmask( SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; $children{$pid} = 1; $children++; return; } else { # Child process must *not* return from this subroutine. $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before # unblock signals sigprocmask( SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; # open a connection to the news server undef $nntp; until ($nntp) { $nntp = Net::NNTP->new( $news_server, Timeout => 60); } $nntp->authinfo( $username, $password) if defined $username; print "child $$ searching $group\n"; # do assigned group process_group( $group); # close connection to news server $nntp->quit; print "child $$ is done processing $group\n"; exit; # make sure sub never returns } }