#!/usr/bin/perl

use diagnostics;
use strict 'subs';
use strict 'refs';
use Socket;
use IO::Handle;
use IO::Select;

my $child;      # filehandle to child process
my $parent;     # filehandle to parent process
my $pid;        # Process ID of child process

#       w r i t e L i n e
# Writes a buffer to the filehandle.
sub writeLine {
    my ($fh, $buf) = @_;
    print $fh $buf;
#   while( length $buf ) # alternate to yours, but single print is the same
#     {
#     my $stat = syswrite $fh, $buf;
#     $stat and substr $buf, 0, $stat, '';
#     }
}                                               #writeLine()

socketpair($child, $parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
  or die "socketpair: $!";
$child->autoflush(1);
$parent->autoflush(1);
if ($pid = fork()) {                    #parent
    close $parent  or die "close: $!\n";
    my $sel = IO::Select->new($child);
    my @handles;
    my $buf = '';
    while ($sel->count)
      {
#     print STDOUT time%100, ": polling child\n";
      for my $fh ( @handles = $sel->can_read(1) )
        {
        if( sysread $fh, $buf, 1e6, length $buf )
          {
          print STDOUT time%100, ": received <$1>\n" # because you may get more
            while $buf =~ s/(.*)\n//;                # than one line at a time
          }
        else
          {
          $sel->remove($fh);
          }
        }
      @handles or print STDOUT time%100, ": no input from child at this time\n";
      }
    my $stat = wait;
    die "wait returned $stat\n"  unless $stat == $pid;
    print STDOUT time%100, ": child reaped, parent exiting\n";
    exit 0;
    }
  else {
    die "cannot fork: $!"  unless defined $pid;
    close $child or die "close: $!\n";
    writeLine($parent, time%100 . ": child started\n");
    sleep 4;
    writeLine($parent, time%100 . ": child wrote again\nwith two lines\n");
    sleep 2;
    writeLine($parent, "E_O_F\n");
    close $parent or die "close: $!\n";          #causes termination
    print STDOUT time%100, ": child exiting\n";
    exit;
}