#! /usr/bin/perl
use strict;
use warnings;

my $NUMLOOPS   = 250;
my $MAXPROCESS = 10;
my $DATALEN    = 100;
my $VERBOSE    = 1;

# --------------------------------------

my( %pid );
pipe( CHILD, PARENT );

if(! $VERBOSE ) { close( STDERR ) }

foreach my $num ( 1 .. $NUMLOOPS )
{
  print STDERR ">$num> processing\n";
  
  if( keys( %pid ) >= $MAXPROCESS )
  { 
    print STDERR ">$num> waiting for reap\n";
    &reap();
  }
  
  if( my $pid = fork() )
  {
    print STDERR ">$num> forked\n";
    $pid{$pid} = $num;
  }
  else
  {
    close( CHILD );
    print PARENT "x" x $DATALEN . "\n";
    close( PARENT );
    select( '', '', '', rand );
    print STDERR ">$num> finished\n";
    exit 0;
  }
}

while( %pid ) { &reap() }


close( PARENT );

print "parent received: ";
while( my $child = <CHILD> )
{
  print ".";
}
print "\n";

close( CHILD );


sub reap
{
  my( $pid ) = wait();
  
  if( $pid == -1  ) { die( "no more kids to reap!\n" ) }
  if(! $pid{$pid} ) { die( "why did I see $pid?\n"   ) }
  
  print STDERR ">$pid{$pid}> reaped\n";
  delete( $pid{$pid} );
}
[download]