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

use Socket;
use IO::Select;

my ($child, $parent);

socketpair $child, $parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC
    or die "socketpair: $!";
$child->autoflush(1);
$parent->autoflush(1);

if (my $pid = fork) {
    close $parent  or die "close: $!\n";
    print STDOUT time % 100, ": polling child\n";
    my $select = 'IO::Select'->new;
    $select->add($child);
    my $buf = '';
  COMMUNICATION:
    while (1) {
        if ($select->can_read(0)) {
            sysread $child, $buf, 4096, length $buf
                or last COMMUNICATION;
            if ($buf =~ s/(.*)\n//) {
                print STDOUT time % 100, ": received <$1>\n";
            }
        } else {
            print STDOUT time % 100, ": waiting for child.\n";
            sleep 1;
        }
    }
    print STDOUT time % 100, ": end of input from child\n";
    wait;
} elsif (defined $pid) {
    close $child or die "close: $!\n";
    print STDOUT time % 100, ": child started\n";
    sleep 5;
    print $parent time % 100, ": child printed\n";
    sleep 2;
    print $parent time % 100, ": child printed again\n";
    close $parent
        or die "close: $!\n";
    exit
} else {
    die "cannot fork: $!"
}