http://www.perlmonks.org?node_id=237421


in reply to Run N similar tasks in parallel

This work by abigail is one of my favorite pieces of code. I couldn't find the original node, so I include it here.
#!/usr/bin/perl #by abigail #Some times you have a need to fork of several children, but you want +to #limit the maximum number of children that are alive at one time. Here + #are two little subroutines that might help you, mfork and afork. They + are very similar. #They take three arguments, #and differ in the first argument. For mfork, the first #argument is a number, indicating how many children should be forked. +For #afork, the first argument is an array - a child will be #forked for each array element. The second argument indicates the maxi +mum #number of children that may be alive at one time. The third argument +is a #code reference; this is the code that will be executed by the child. +One #argument will be given to this code fragment; for mfork it will be an + increasing number, #starting at one. Each next child gets the next number. For afork, the + array element is #passed. Note that this code will assume no other children will be spa +wned, #and that $SIG {CHLD} hasn't been set to IGNORE. mfork (10,10,\&hello); sub hello{print "hello world\n";} print "all done now\n"; ################################################### sub mfork ($$&) { my ($count, $max, $code) = @_; foreach my $c (1 .. $count) { wait unless $c <= $max; die "Fork failed: $!\n" unless defined (my $pid = fork); exit $code -> ($c) unless $pid; } 1 until -1 == wait; } ################################################## sub afork (\@$&) { my ($data, $max, $code) = @_; my $c = 0; foreach my $data (@$data) { wait unless ++ $c <= $max; die "Fork failed: $!\n" unless defined (my $pid = fork); exit $code -> ($data) unless $pid; } 1 until -1 == wait; } #####################################################