#!/usr/bin/perl

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

use strict;
use warnings;
use IO::Select;
use POSIX qw(mkfifo);

my $childcount = 3;
my $hasterminal = 1;
my %who;
my $fifodir = '/tmp';

for my $me (1 .. $childcount)
  {
  if( my $pid = fork ) # parent
    {
    $who{$pid} = $me;
    }
  elsif( defined $pid ) # child
    {
    my $mypath = "$fifodir/$$.fifo";
    mkfifo( $mypath, 0700 ) or die "$! on making mypath";
    open my $fifo, '+<', $mypath or die "$! opening $mypath";
    my $sel = IO::Select->new($fifo);
    $me == $hasterminal and $sel->add(*STDIN);

    while(1)
      {
      for my $handle ($sel->can_read)
        {
        defined( my $command = <$handle> ) or exit;
        print "$$ got $command";
        if( $command =~ /^(\d+)\s+(.*\n)/ )
          {
          my $otherpath = "$fifodir/$1.fifo";
          if( -p $otherpath and open my $otherchild, '>', $otherpath )
            {
            print $otherchild $2;
            close $otherchild;
            }
          else
            {
            warn "child $1 does not have a fifo\n";
            }
          }
        }
      }
    }
  else
    {
    die "fork failed with $!";
    }
  }

use Data::Dump 'pp'; pp \%who;
my $pid = wait; # on first exit, kill rest
print "$who{$pid} exited\n";
kill 15, keys %who;
unlink map "$fifodir/$_.fifo", keys %who;
print "$who{$pid} exited\n" while ($pid = wait) > 0;