PERL and IPC with one-way pipes
I have a project that I really need to add some parallelism to increase the speed. I poked around on the perl.org and managed to cobble together this little bit of code to show how the children worked.
This is non-blocking using waitpid.
This is non-blocking using waitpid.
#!/usr/bin/perl
#
# $Id$
#
use strict;
use warnings;
use diagnostics;
use POSIX ":sys_wait_h";
sub main ()
{
my ($CHILDNUM);
my ($childFhPTR,$FHx, $cPID);
my ($sleeptime,$keepgoing,$nextkid,$linenum,$nextline);
foreach $CHILDNUM ( 0,1,2,3,4 )
{
if ( !defined($cPID = open ($FHx, "-|")) )
{
die "can not spawn child for some reason maybe ($!)";
}
if ( $cPID == 0 ) # child
{
$sleeptime = int(rand(25));
print STDOUT "I am child ($$) with CHILDNUM ($CHILDNUM) and will be sleeping for ($sleeptime) seconds\n";
sleep $sleeptime;
print STDOUT "This is child ($$) signing off after ($sleeptime) seconds\n";
exit 0; # make sure the child ends after finishing processing
}
$childFhPTR->{$cPID} = $FHx;
undef ($cPID);
undef ($FHx);
}
select (STDOUT);
$| = 1;
# at this point we should have 5 children doing their thing
print STDOUT "I have (" . scalar(keys(%$childFhPTR)) . ") children: " . join (',',sort(keys(%$childFhPTR))) . "\n";
$keepgoing = scalar(keys(%$childFhPTR));
do
{
print STDOUT "parent: about to check for any finished processes\n";
$nextkid = waitpid (-1,WNOHANG);
if ( $nextkid > 0 ) # process a child
{
print STDOUT "\tparent: got one child pid ($nextkid) is ready, processing...\n";
$FHx = $childFhPTR->{$nextkid};
delete ($childFhPTR->{$nextkid});
print STDOUT "\tparent: number of children should have decreased by 1 from ($keepgoing) to (" . scalar(keys(%$childFhPTR)) . ")\n";
$keepgoing = scalar(keys(%$childFhPTR));
$linenum = 1;
print STDOUT "\tparent: here comes the child's output if defined\n";
while ( defined($nextline = <$FHx>) )
{
chomp($nextline);
print STDOUT "\t\t[$nextkid/" . $linenum++ . "]: $nextline\n";
}
print STDOUT "\tparent: done processing this child\n";
}
else
{
print STDOUT "\tparent: no children ready this time through old ($keepgoing) new (" . scalar(keys(%$childFhPTR)) . ")\n";
$keepgoing = scalar(keys(%$childFhPTR));
sleep 1;
}
} while ( $keepgoing > 0 );
return (0);
}
main ();
Comments
Post a Comment