FM / examples

/usr/share/doc/libio-pty-perl/examples

Name	Size	Mode	Actions
try	2896	0644	edit dl rm

Edit: /usr/share/doc/libio-pty-perl/examples/try (2896B)

#!/usr/bin/perl

use blib;
use IO::Pty;
require POSIX;
$^W = 1;

my $pty = new IO::Pty;
my $pid;

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 $pty;
  print "Done.\n";
  exit 0;
} else {
  pipe(STAT_RDR, STAT_WTR)
    or die "Cannot open pipe: $!";
  STAT_WTR->autoflush(1);
  $pid = fork();
  die "Cannot fork" if not defined $pid;
  unless ($pid) {
    close STAT_RDR;
    $pty->make_slave_controlling_terminal();
    my $slave = $pty->slave();
    close $pty;
    $slave->clone_winsize_from(\*STDIN);
    $slave->set_raw();

open(STDIN,"<&". $slave->fileno())
      or die "Couldn't reopen STDIN for reading, $!\n";
    open(STDOUT,">&". $slave->fileno())
      or die "Couldn't reopen STDOUT for writing, $!\n";
    open(STDERR,">&". $slave->fileno())
      or die "Couldn't reopen STDERR for writing, $!\n";

close $slave;

{ exec(@ARGV) };
    print STAT_WTR $!+0;
    die "Cannot exec(@ARGV): $!";
  }
  close STAT_WTR;
  $pty->close_slave();
  $pty->set_raw();
  # now wait for child exec (eof due to close-on-exit) or exec error
  my $errstatus = sysread(STAT_RDR, $errno, 256);
  die "Cannot sync with child: $!" if not defined $errstatus;
  close STAT_RDR;
  if ($errstatus) {
    $! = $errno+0;
    die "Cannot exec(@ARGV): $!";
  }
  $SIG{WINCH} = \&winch;
  parent($pty);
}

sub winch {
  $pty->slave->clone_winsize_from(\*STDIN);
  kill WINCH => $pid if $pid;
  print "STDIN terminal size changed.\n";
  $SIG{WINCH} = \&winch;
}

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);
}

cmd: