#!/usr/bin/perl

# http://perlmonks.org/?node_id=1175183

use strict;
use warnings;
use IO::Select;

my $count = 1;

while(1)
  {
  print "parent starting\n";
  my $more = 1;
  $SIG{$_} = sub {$more = 0} for qw( CHLD PIPE USR1 USR2 );

  my @pids = map runchild($_), qw( one two );
  my $sel = IO::Select->new( map $_->[3], @pids );

  while( $more )
    {
    print "parent loop $$\n";
    print { $_->[2] } "message @{[$count++]} parent to $_->[1]\n"
      for @pids;
    for my $fh ( $sel->can_read(10) )
      {
      sysread $fh, my $buffer, 1024;
      print "parent got $buffer";
      }
    sleep 5;
    }
  kill 'TERM', map $_->[0], @pids;
  1 while wait > 0; # reap all children
  }

sub runchild
  {
  my $me = shift;
  pipe( my $from_parent, my $to_child );
  pipe( my $from_child, my $to_parent );
  $to_parent->autoflush(1);
  $to_child->autoflush(1);
  if( my $pid = fork )
    {
    close $from_parent;
    close $to_parent;
    return [ $pid, $me, $to_child, $from_child ];
    }
  elsif( defined $pid )
    {
    close $from_child;
    close $to_child;
    my $sel = IO::Select->new( $from_parent );
    my $more = 1;
    $SIG{TERM} = sub {$more = 0};
    while( $more )
      {
      print "child $me loop $$\n";
      for my $fh ( $sel->can_read(11) )
        {
        sysread $fh, my $buffer, 1024 or die "$me: sysread failed $!";
        print "child $me got $buffer";
        sleep 1;
        print $to_parent "reply from $me for $buffer";
        }
      }
    die "child $me exiting\n";
    }
  else
    {
    die "$! on fork for $me";
    }
  }