#!/usr/local/bin/perl -w

use blib;
use IO::Pty;
require POSIX;


$pty = new IO::Pty;

unless (@ARGV)
 {
  my $slave  = $pty->slave;

  print %{*$pty},"\n";
  print "master $pty $$pty ",$pty->ttyname,"\n";
  print "slave  $slave $$slave ",$slave->ttyname,"\n";

  foreach $val (1..10)
   {            
    print $pty "$val\n";
    $_ = <$slave>;
    print "$_"; 
   }            
  close($slave);
 }
else
 {
  my $pid = fork;
  die "Cannot fork:$!" if ($pid < 0);
  if ($pid)
   {
    parent($pty);
   }
  else
   {
    child($pty);
   }
 }

sub child
{
 my ($pty) = @_; 
 POSIX::setsid();
 my $tty = $pty->slave;
 close($pty);
 print $tty "From the Child\n";
# setpgrp(0,$$);
 open(STDIN, "<&".fileno($tty)) || (sleep(5),die "Cannot open STDIN");
 open(STDOUT,">&".fileno($tty)) || (sleep(5),die "Cannot open STDOUT");
 open(STDERR,">&STDOUT")        || (sleep(5),die "Cannot open STDERR");
 printf "STDIN=%d STDOUT=%d STDERR=%d\n",fileno(STDIN),fileno(STDOUT),fileno(STDERR);
 close($tty);
 my $prog = shift(@ARGV);
 if (!@ARGV && $prog =~ /sh$/)
  {
   exec $prog '-sh'
  }
 exec($prog,@ARGV);
 die "Cannot exec"; 
}

sub process
{
 my ($rin,$src,$dst) = @_;
 my $buf = '';
 my $read = sysread($src, $buf, 1);
 if (defined $read && $read)
  {
   syswrite($dst,$buf,$read);
   syswrite(LOG,$buf,$read); 
  }
 else
  {
   print STDERR "Nothing for $src i.e. $read\n";
   vec($rin, fileno($src), 1) = 0;
  }
 return $rin;
}

sub parent
{
 open(LOG,">log") || die;
 my ($pty) = @_; 
 my $tty = $pty;
 my ($rin,$win,$ein) = ('','','');
 vec($rin, fileno(STDIN), 1) = 1;
 vec($rin, fileno($tty), 1) = 1;
 vec($win, fileno($tty), 1) = 1;
 vec($ein, fileno($tty), 1) = 1;
 select($tty);
 $| = 1;
 select(STDOUT);
 $| = 1;
 while (1)
  {
   my ($rout,$wout,$eout,$timeleft);
   ($nfound,$timeleft) = select($rout=$rin,$wout=$win,$eout=$ein,3600);
   die "select failed:$!" if ($nfound < 0);
   if ($nfound > 0)
    {
     if (vec($eout, fileno($tty), 1))
      {
#       print STDERR "Exception on $tty\n";
      }
     if (vec($rout, fileno($tty), 1))
      {
       $rin = process($rin,$tty,STDOUT);
       last unless (vec($rin, fileno($tty), 1));
      }
     elsif (vec($rout, fileno(STDIN), 1) && vec($wout, fileno($tty), 1))
      {
       $rin = process($rin,STDIN,$tty);
      }
    }
  }
 close(LOG);
}