#!perl -w

use strict;
use IO::Select;
use Socket;
use POSIX;
use FileHandle;

socketpair(SOCK_READ,SOCK_WRITE,AF_UNIX,SOCK_STREAM,PF_UNSPEC)
    or die "Couldn't create socket pair: $!\n";
binmode SOCK_READ, ':crlf';
binmode SOCK_WRITE, ':crlf';

use vars qw($grandchild_pid);
$SIG{INT} = sub { 
    # For some reason, an INT signal doesn't do anything...
    kill 9, $grandchild_pid 
    if ($grandchild_pid);
    exit(2);
};

print "STDOUT print 1.\n";
$grandchild_pid = open(CMD,'perl -e "$|=1; while(1) { sleep(5); warn q
+q:boing\n:; print q:The time is now :,time,qq:\n:; };"|')
    or die "Couldn't run perl: $!\n";

if (!defined(my $f = fork()))
{
    die "Fork error: $!\n";
}
elsif (!$f)
{
    # child
    close(SOCK_READ);
    autoflush SOCK_WRITE 1;
    print SOCK_WRITE
    while (<CMD>);
    close(CMD);
    exit($? & 255 
     ? 255 
     : $?>>8
    );
}
# parent
close(SOCK_WRITE);

warn "Parent is PID $$\n";

# We can't reliably print to STDOUT after this point (at some point,
# it will start going to the socket)

#sleep(5);

print "STDOUT print 2.\n";
my $sel = IO::Select->new;
$sel->add(\*SOCK_READ)
    or die "Couldn't add pipe to IO::Select: $!\n";

print "STDOUT print 3.\n";
while (1)
{
    print "STDOUT print 4.\n";
    warn "DEBUG: select on ",$sel->count," handles.\n";
    my @ready = $sel->can_read(10);
    warn "Parent DEBUG: ",scalar(@ready)," handles readable.\n";
    print "STDOUT print 5.\n";
    foreach my $rh (@ready)
    {
    my $line=<$rh>;
    warn "Parent read $rh: $line";
    }
    sleep(3);
}
[download]