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;

Threading in Perl

Threading in Perl may seem daunting at first, but it's actually easier than it looks. In some ways, threading is more straight forward than forking. Communication between the threads and a parent process is much more straight forward in my opinion than communication between child and parent processes.

Here I've written a little sample function that will take a number of threads to launch at a time, a reference to a function and an array of hostnames. Then it will launch one thread for each hostname passing the hostname to the function, until the limit has been reached. It then waits for each thread to become joinable (finishes) and then launches more threads till the limit is reached again. When all threads are finished, it returns the output form all threads as a hash keyed by the hostnames.


######################################
# http://greg-techblog.blogspot.com
# Spawns threads for a list of hosts running a function
# you pass to it. Passes host to function as argument.
# args:
# needs numbers of threads to launch 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 threads;
my $debug;
sub run_threaded {
my ($threads,$func_to_thread, $hosts) = @_;
my (%stdout, %threads);
my $n = 0;

# This makes sure we don't start more than $threads threads at a time
my $m = $threads-1 > $#{$hosts} ? $#{$hosts} : $threads-1;
while (1) {
last if $n >= $#{$hosts}+1;
foreach my $host (@{$hosts}[$n..$m]) {
print "Launching thread for $host $n-$m\n" if $debug;
unless ( $threads{$host} = new threads $func_to_thread, $host) {
print "Error on $host\n";
}
}
map { $stdout{$_} = $threads{$_}->join if $threads{$_}; } @{$hosts}[$n..$m];
# work out the next range of instances to work on
$n = $m == 0 ? 1 : $m+1;
$m = $n+$threads-1 < $#{$hosts} ? $n+$threads-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 };
sub myFunc { my $hostname = shift; return `ping $hostname` ; }

# Launch two threads at a time that ping hosts
my %stdout = run_threaded( 2, \&myFunc, \@hosts);
print Dumper \%stdout;