IO::Pty::Easy - Easy interface to IO::Pty

    use IO::Pty::Easy;

    my $pty = IO::Pty::Easy->new;
    $pty->spawn("nethack");

    while ($pty->is_active) {
        my $input = # read a key here...
        $input = 'Elbereth' if $input eq "\ce";
        my $chars = $pty->write($input, 0);
        last if defined($chars) && $chars == 0;
        my $output = $pty->read(0);
        last if defined($output) && $output eq '';
        $output =~ s/Elbereth/\e[35mElbereth\e[m/;
        print $output;
    }

    $pty->close;

    perldoc IO::Pty::Easy

package IO::Pty::Easy;
our $VERSION = '0.08';

use warnings;
use strict;
use base 'IO::Pty';
use Carp;
use POSIX ();
use Scalar::Util qw(weaken);

sub new {
    my $class = shift;
    my %args = @_;

    my $handle_pty_size = 1;
    $handle_pty_size = delete $args{handle_pty_size}
        if exists $args{handle_pty_size};
    $handle_pty_size = 0 unless POSIX::isatty(*STDIN);
    my $def_max_read_chars = 8192;
    $def_max_read_chars = delete $args{def_max_read_chars}
        if exists $args{def_max_read_chars};
    my $raw = 1;
    $raw = delete $args{raw}
        if exists $args{raw};

    my $self = $class->SUPER::new(%args);
    bless $self, $class;
    $self->handle_pty_size($handle_pty_size);
    $self->def_max_read_chars($def_max_read_chars);
    ${*{$self}}{io_pty_easy_raw} = $raw;
    ${*{$self}}{io_pty_easy_final_output} = '';
    ${*{$self}}{io_pty_easy_did_handle_pty_size} = 0;

    return $self;
}

sub spawn {
    my $self = shift;
    my $slave = $self->slave;

    croak "Attempt to spawn a subprocess when one is already running"
        if $self->is_active;

    # set up a pipe to use for keeping track of the child process during exec
    my ($readp, $writep);
    unless (pipe($readp, $writep)) {
        croak "Failed to create a pipe";
    }
    $writep->autoflush(1);

    # fork a child process
    # if the exec fails, signal the parent by sending the errno across the pipe
    # if the exec succeeds, perl will close the pipe, and the sysread will
    # return due to EOF
    ${*{$self}}{io_pty_easy_pid} = fork;
    unless ($self->pid) {
        close $readp;
        $self->make_slave_controlling_terminal;
        close $self;
        $slave->clone_winsize_from(\*STDIN) if $self->handle_pty_size;
        $slave->set_raw if ${*{$self}}{io_pty_easy_raw};
        # reopen the standard file descriptors in the child to point to the
        # pty rather than wherever they have been pointing during the script's
        # execution
        open(STDIN,  "<&" . $slave->fileno)
            or carp "Couldn't reopen STDIN for reading";
        open(STDOUT, ">&" . $slave->fileno)
            or carp "Couldn't reopen STDOUT for writing";
        open(STDERR, ">&" . $slave->fileno)
            or carp "Couldn't reopen STDERR for writing";
        close $slave;
        { exec(@_) };
        print $writep $! + 0;
        carp "Cannot exec(@_): $!";
        exit 1;
    }

    close $writep;
    $self->close_slave;
    # this sysread will block until either we get an EOF from the other end of
    # the pipe being closed due to the exec, or until the child process sends
    # us the errno of the exec call after it fails
    my $errno;
    my $read_bytes = sysread($readp, $errno, 256);
    unless (defined $read_bytes) {
        # XXX: should alarm here and follow up with SIGKILL if the process
        # refuses to die
        kill TERM => $self->pid;
        close $readp;
        $self->_wait_for_inactive;
        croak "Cannot sync with child: $!";
    }
    close $readp;
    if ($read_bytes > 0) {
        $errno = $errno + 0;
        $self->_wait_for_inactive;
        croak "Cannot exec(@_): $errno";
    }

    if ($self->handle_pty_size) {
        my $weakself = weaken($self);
        $SIG{WINCH} = sub {
            return unless $weakself;
            $weakself->slave->clone_winsize_from(\*STDIN);
            kill WINCH => $weakself->pid if $weakself->is_active;
        };
        ${*{$self}}{io_pty_easy_did_handle_pty_size} = 1;
    }
}

sub read {
    my $self = shift;
    my ($timeout, $max_chars) = @_;
    $max_chars ||= $self->def_max_read_chars;

    my $rin = '';
    vec($rin, fileno($self), 1) = 1;
    my $nfound = select($rin, undef, undef, $timeout);
    my $buf;
    if ($nfound > 0) {
        my $nchars = sysread($self, $buf, $max_chars);
        $buf = '' if defined($nchars) && $nchars == 0;
    }
    if (length(${*{$self}}{io_pty_easy_final_output}) > 0) {
        no warnings 'uninitialized';
        $buf = ${*{$self}}{io_pty_easy_final_output} . $buf;
        ${*{$self}}{io_pty_easy_final_output} = '';
    }
    return $buf;
}

sub write {
    my $self = shift;
    my ($text, $timeout) = @_;

    my $win = '';
    vec($win, fileno($self), 1) = 1;
    my $nfound = select(undef, $win, undef, $timeout);
    my $nchars;
    if ($nfound > 0) {
        $nchars = syswrite($self, $text);
    }
    return $nchars;
}

sub is_active {
    my $self = shift;

    return 0 unless defined $self->pid;
    # XXX FreeBSD 7.0 will not allow a session leader to exit until the kernel
    # tty output buffer is empty.  Make it so.
    my $rin = '';
    vec($rin, fileno($self), 1) = 1;
    my $nfound = select($rin, undef, undef, 0);
    if ($nfound > 0) {
        sysread($self, ${*{$self}}{io_pty_easy_final_output},
                $self->def_max_read_chars,
                length ${*{$self}}{io_pty_easy_final_output});
    }

    my $active = kill 0 => $self->pid;
    if ($active) {
        my $pid = waitpid($self->pid, POSIX::WNOHANG());
        $active = 0 if $pid == $self->pid;
    }
    if (!$active) {
        $SIG{WINCH} = 'DEFAULT'
            if ${*{$self}}{io_pty_easy_did_handle_pty_size};
        ${*{$self}}{io_pty_easy_did_handle_pty_size} = 0;
        delete ${*{$self}}{io_pty_easy_pid};
    }
    return $active;
}

sub kill {
    my $self = shift;
    my ($sig, $non_blocking) = @_;
    $sig = "TERM" unless defined $sig;

    my $kills = kill $sig => $self->pid if $self->is_active;
    $self->_wait_for_inactive unless $non_blocking;

    return $kills;
}

sub close {
    my $self = shift;

    $self->kill;
    close $self;
}

sub handle_pty_size {
    my $self = shift;
    ${*{$self}}{io_pty_easy_handle_pty_size} = $_[0] if @_;
    ${*{$self}}{io_pty_easy_handle_pty_size};
}

sub def_max_read_chars {
    my $self = shift;
    ${*{$self}}{io_pty_easy_def_max_read_chars} = $_[0] if @_;
    ${*{$self}}{io_pty_easy_def_max_read_chars};
}

sub pid {
    my $self = shift;
    ${*{$self}}{io_pty_easy_pid};
}

sub _wait_for_inactive {
    my $self = shift;

    select(undef, undef, undef, 0.01) while $self->is_active;
}

sub DESTROY {
    my $self = shift;
    local $@;
    local $?;
    $self->close;
}

1;