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.



#!/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

Popular posts from this blog

Xubuntu Home Server on Dell XPS 13 9370

Cygwin + syslog-ng

Installing Fedora 21 on a (late 2014) Mac Mini