Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I've read through various documentation on the "fork" command, and basically the fork just seems to execute the same program all over again. I would like for a parent program to spawn 6 children, and be aware whenever one child finishes, so that it can call another child in its place. Furthermore, these children should be just calls to a particular subroutine within the program. How can I go about doing this? Thanks

Replies are listed 'Best First'.
Re: forking subroutines?
by mikfire (Deacon) on Jul 25, 2000 at 06:58 UTC
    My version will spawn N number of children immediately and then spawn one more every time an already existing child dies until a job queue is exhausted. It will then wait for every existing child to die. Oh, it also prints a message before spawning a new child.

    Notice I never install a SIGCHLD handler. That is because the parent will process them itself. Also, the waitpids are done non-blocking. The sleep makes sure we do not loop too tightly.

    As splinky said, if you call a subroutine, make sure it exits or you call exit after it returns. The original code I took this from actually exec'd and so I didn't worry about it.

    $num_children is a command line arg, not shown here so you don't have to see my lame mp3 ripping code. It, obviously, controls how many child procs will be spawned.

    # Interesting stuff has happened to load the job queue and par # the command line, and whatever else you want to happen. sub SPAWN { $counter++; if ( $cpid = fork ) { $tracker{$cpid} = $ref->[1]; } else { # This can be a call like this, or my_sub( @_ ); exit; # You can exec some external proc like # exec "/bin/ls -FC /var"; } } my $dpid = 0; while( @job_q ) { my $ref = shift @job_q; #-- # Initial loop to spawn children #-- if ( $counter < $num_children ) { &SPAWN( $ref ); } else { do { sleep 5; $dpid = waitpid( -1, 1 ); } until $dpid; last if ( $dpid == -1 ); # No children left printf "%s has finished, spawning next child (%d left)\n", $tr +acker{$dpi d}, scalar @job_q; &SPAWN( $ref ); } } do { sleep 5; $dpid = waitpid( -1, 1 ); printf("%s has finished\n", $tracker{$dpid}) if(defined( $tracker{ +$dpid} ) ); } until $dpid == -1;

    I will warn you this isn't the most robust code. I haven't had problems with it, but it is something only I use. It is a slightly different solution to the problem though.

    mikfire

Re: forking subroutines?
by splinky (Hermit) on Jul 25, 2000 at 03:38 UTC
    A complete answer to your question may be found in perldoc perlipc. However, a brief synopsis would look something like this (taken almost directly from perlipc):

    use POSIX ":sys_wait_h"; sub REAPER { my $child; while ($child = waitpid(-1,WNOHANG)) { $Kid_Status{$child} = $?; } $SIG{CHLD} = \&REAPER; # still loathe sysV } $SIG{CHLD} = \&REAPER; .............. for (1..6) { do { $pid = fork(); unless (defined $pid) { warn "cannot fork: $!"; sleep 10; } } until defined $pid; if ($pid) { # parent print "forked process $pid\n"; } else { # child my_sub(@parms); exit; # don't forget this } }

    Untested. Have fun.

    *Woof*

RE: forking subroutines?
by Anonymous Monk on Jul 26, 2000 at 02:54 UTC
    ok, I've read the two above replies, and figured out a bare-bones (no error checking) way to do it. This program launches subroutine "ABC" a total of 20 times, but is only allowed to launch 6 at a time.
    #!/opt/perl/bin/perl # This is the simple child-process subroutine. sub ABC { sleep(2); print "abc with counter = $counter.\n"; } # This section spawns the initial 6 children. for ($counter = 1; $counter <= 6; $counter++) { $pid = fork(); if ($pid) # parent { $child{$pid} = $counter; $procnum[$counter] = $pid; print "forked process $counter.\n"; } else # child { ABC(); exit $counter; } } # This section spawns additional children 7-20. $diecount = 0; while ($counter <= 20) { $doneproc = wait(); $doneval = $? >> 8; $pid = fork(); if ($pid) # parent { $child{$pid} = $counter; print "child $doneval ($doneproc) exited, forking process $cou +nter.\n"; $counter++; $diecount++; } else # child { ABC(); exit $counter; } } # This section waits for all children to die. while ($diecount <= 20) { wait(); $diecount++; } print "exiting.\n";

    BazB added code tags.