Forking in Perl

Yesterday I posted how to thread in perl. Today I figured I'd explain forking. There are a few reasons you might choose to fork instead of thread. One of them is that threading is a compile time option for perl that isn't enabled in every installation. Another is that not every module is thread safe. Most of the time you can just unload any modules that are not before you start threading, but if you need the module inside your thread, you'll need to switch to forking. Lastly forking is more effecient than threading in some cases. I'll actually explain this more in detail in a later post.

Here I've written a sample script that is similar to my threading function.


######################################
# http://greg-techblog.blogspot.com
# Fork child processes for a list of hosts running a function
# you pass to it. Passes host to function as argument.
# args:
# needs numbers of child to fork at a time
# ref to sub to run
# ref array of hosts or instances (will be passed to sub as arg)
# returns:
# a hash of returns from sub keyed by host or instance name
######################################
use strict;
use warnings;
my $debug;

sub fork_run {
use POSIX qw( WNOHANG );
my ($children,$func_to_fork, $hosts) = @_;
my %stdout;
my $n = 0;

# This makes sure we don't start more than $threads threads at a time
my $m = $children-1 > $#{$hosts} ? $#{$hosts} : $children-1;

while (1) {
last if $n >= $#{$hosts}+1;
foreach my $host (@{$hosts}[$n..$m]) {
print "Forking for $host $n-$m\n" if $debug;
local *FROM_CHILD;
pipe(FROM_CHILD,TO_PARENT);
my $pid = fork();
if ( not defined $pid) {
# Something is wrong
print "resources not available.\n";
}
elsif ($pid == 0 ) {
# This is the child
# Turn on autoflush
$| = 1;
close(FROM_CHILD);
select(TO_PARENT);
$func_to_fork->($host);
close(TO_PARENT);
exit;
}
else {
# This is the parent
close(TO_PARENT);
$stdout{$host} = ;
close FROM_CHILD;
}
}

# wait for some children to finish
my $kid;
do {
$kid = waitpid(-1, WNOHANG);
} while $kid > 0;

# work out the next range of instances to work on
$n = $m == 0 ? 1 : $m+1;
$m = $n+$children-1 < $#{$hosts} ? $n+$children-1 : $#{$hosts};
print "$n-$m\n\n" if $debug;
}
return %stdout;
}


To use this, simply do something like this;

use Data::Dumper;
my @hosts = qw{ host1 host2 host3 host4 host5 };
sub myFunc { my $hostname = shift; print TO_PARENT `ping -c 1 $hostname` ; return 1; }

# Launch two threads at a time that ping hosts
my %stdout = fork_run( 2, \&myFunc, \@hosts);
map { print $stdout{$_}; } keys %stdout;