jsttyplay/Term/Emulator.pm

package Term::Emulator;
use strict;

use IO::Pty;
use IO::Tty qw/ TIOCSWINSZ TCGETA TCSETA ICANON ISIG IEXTEN ECHO ECHOE ECHOKE ECHOCTL PENDIN ICRNL IXON IXANY IMAXBEL BRKINT OPOST ONLCR TIOCGETP TIOCSETN /;
use Term::Emulator::Parser;

use IO::Handle;
use Carp;
use Time::HiRes qw/ time sleep /;

our $STDIN, $STDOUT, $STDERR;
open $STDIN, "<&=", \*STDIN or die;
open $STDOUT, ">&=", \*STDOUT or die;
open $STDERR, ">&=", \*STDERR or die;

sub new {
    my ($class, %args) = @_;
    my $self = bless {}, $class;

    my $width  = exists $args{'width'}  ? delete $args{'width'}  : 80;
    my $height = exists $args{'height'} ? delete $args{'height'} : 24;

    $self->{'term'} = Term::Emulator::Parser->new(width => $width, height => $height);
    $self->{'pty'}  = IO::Pty->new;
    $self->{'pid'}  = undef;

    $self->{'buffers'} = {
        ptysend => '',
    };

    $self->set_size($width, $height);

    return $self;
}

sub set_size {
    my ($self, $width, $height) = @_;

    # TODO - kill WINCH the subproccess
    # TODO - update the Term::Emulator::Parser size

    ioctl $self->pty->slave, TIOCSWINSZ, pack "S!S!S!S!", $height, $width, $height, $width;

    return $self;
}

sub spawn {
    # based on IO::Pty::Easy v0.03
    my ($self, @program) = @_;
    my $slave = $self->pty->slave;

    croak "Can't spawn a process when one is already running!"
        if $self->is_active;

    # for returning errors from the child process
    my ($readp, $writep);
    unless ( pipe($readp, $writep) ) {
        croak "Failed to create a pipe";
    }
    $writep->autoflush(1);

    # fork the child
    my $pid = fork;
    croak "Couldn't fork" unless defined $pid;

    unless ( $pid ) {
        # child process
        close $readp;

        $self->pty->make_slave_controlling_terminal;
        close $self->pty;
        $slave->set_raw;

        # reopen STD{IN,OUT,ERR} to use the pty
    eval {
        open($STDIN,  "<&", $slave->fileno) or croak "Couldn't reopen STDIN for reading: $!";
        open($STDOUT, ">&", $slave->fileno) or croak "Couldn't reopen STDOUT for writing: $!";
        open($STDERR, ">&", $slave->fileno) or croak "Couldn't reopen STDERR for writing: $!";
    };
    warn "t: $@" if $@;
    die "t: $@" if $@;

        close $slave;

        system("stty","sane");

        exec(@program);

        # exec failed, tell our parent what happened
        print $writep $! + 0;
        carp "Cannot exec(@program): $!";

        exit 1;
    }

    # parent process continues
    close $writep;
    $self->{'pid'} = $pid;

    $self->pty->close_slave;
    $self->pty->set_raw;

    # this will block until EOF (exec killed the filehandle) or we get the error (exec failed)
    my $errno;
    my $read_bytes = sysread($readp, $errno, 256);

    unless ( defined $read_bytes ) {
        # something went bad wrong with the sysread
        my $err = $!;
        kill TERM => $pid;
        close $readp;
        # wait up to 2 seconds for the process to die
        my $starttime = time;
        sleep 0.01 while time() - $starttime < 2 and $self->is_active;
        if ( time() - $starttime >= 2 ) { # harmless race condition
            # beat the living crap out of the process
            kill KILL => $pid;
        }
        croak "Cannot sync with child: $err";
    }

    close $readp;

    if ( $read_bytes > 0 ) {
        # child couldn't exec
        $errno = $errno + 0;
        $self->_wait_for_inactive;
        croak "Cannot exec(@program): $errno";
    }

    return $self;
}

sub userinput {
    my ($self, $input) = @_;
    $self->term->userinput($input);
    $self->_move_term_sendbuf;
    $self->work_for(0);
    return $self;
}

sub key {
    my ($self, $key) = @_;
    $self->term->key($key);
    $self->_move_term_sendbuf;
    $self->work_for(0);
    return $self;
}

sub work_for {
    my ($self, $time) = @_;
    my $start = time;
    my $ptyfn = fileno($self->pty);
    my $loops = 0;
    while ( 1 ) {
        my $readvec = '';
        vec($readvec, $ptyfn, 1) = 1;

        my $writevec = '';
        if ( length $self->{'buffers'}->{'ptysend'} ) {
            vec($writevec, $ptyfn, 1) = 1;
        }

        my $len = ($start + $time) - time;
        if ( $len < 0 ) {
            last if $loops;
            $len = 0;
        }
        my $nfound = select($readvec, $writevec, undef, $len);
        last unless $nfound; # if no handles have been written to, we've finished our time chunk

        # check for reads
        if ( vec($readvec, $ptyfn, 1) ) {
            # pty can read

            my $buf = '';
            my $n = sysread $self->pty, $buf, 16384;
            if ( $n == 0 ) {
                # EOF
                $self->kill if $self->is_active;
                last;
            }
            $self->term->parse($buf); # pass data sent from the pty slave to the terminal
            $self->_move_term_sendbuf;
        }

        # check for writes if we have outstanding buffers
        if ( vec($writevec, $ptyfn, 1) ) {
            my $nchars = syswrite $self->pty, $self->{'buffers'}->{'ptysend'};
            if ( $nchars ) {
                $self->{'buffers'}->{'ptysend'} = substr $self->{'buffers'}->{'ptysend'}, $nchars;
            }
        }

        # TODO: check for error conditions
        $loops++;
    }

    return $self;
}

sub _move_term_sendbuf {
    my ($self) = @_;
    my $buf = $self->term->output;
    if ( length $buf ) {
        $self->{'buffers'}->{'ptysend'} .= $buf;
        $self->term->output = '';
    }
}

sub is_active {
    my ($self) = @_;

    return 0 unless defined $self->{'pid'};
    if ( kill 0, $self->{'pid'} ) {
        return 1;
    } else {
        undef $self->{'pid'};
    }
}

sub kill {
    my ($self, $signal) = @_;
    $signal = "KILL" unless defined $signal;

    return 0 unless $self->is_active;
    return kill $signal, $self->{'pid'};
}

sub stop_it_in {
    my ($self, $maxtime) = @_;
    $maxtime = 5 unless defined $maxtime;
    return 0 unless $self->is_active;

    kill KILL => $self->{'pid'};
    my $killtime = time;
    while ( time() - $killtime < $maxtime ) {
        return 1 if not $self->is_active;
        sleep 0.05;
    }

    kill TERM => $self->{'pid'};

    sleep 0.01;
    return $self->is_active;
}

sub _wait_for_inactive {
    my ($self) = @_;
    sleep 0.01 while $self->is_active;
}

sub pty  { $_[0]->{'pty'}  }
sub term { $_[0]->{'term'} }

1;

1	dpavlin	1	package Term::Emulator;
2			use strict;
3
4			use IO::Pty;
5			use IO::Tty qw/ TIOCSWINSZ TCGETA TCSETA ICANON ISIG IEXTEN ECHO ECHOE ECHOKE ECHOCTL PENDIN ICRNL IXON IXANY IMAXBEL BRKINT OPOST ONLCR TIOCGETP TIOCSETN /;
6			use Term::Emulator::Parser;
7
8			use IO::Handle;
9			use Carp;
10			use Time::HiRes qw/ time sleep /;
11
12			our $STDIN, $STDOUT, $STDERR;
13			open $STDIN, "<&=", \*STDIN or die;
14			open $STDOUT, ">&=", \*STDOUT or die;
15			open $STDERR, ">&=", \*STDERR or die;
16
17			sub new {
18			my ($class, %args) = @_;
19			my $self = bless {}, $class;
20
21			my $width = exists $args{'width'} ? delete $args{'width'} : 80;
22			my $height = exists $args{'height'} ? delete $args{'height'} : 24;
23
24			$self->{'term'} = Term::Emulator::Parser->new(width => $width, height => $height);
25			$self->{'pty'} = IO::Pty->new;
26			$self->{'pid'} = undef;
27
28			$self->{'buffers'} = {
29			ptysend => '',
30			};
31
32			$self->set_size($width, $height);
33
34			return $self;
35			}
36
37			sub set_size {
38			my ($self, $width, $height) = @_;
39
40			# TODO - kill WINCH the subproccess
41			# TODO - update the Term::Emulator::Parser size
42
43			ioctl $self->pty->slave, TIOCSWINSZ, pack "S!S!S!S!", $height, $width, $height, $width;
44
45			return $self;
46			}
47
48			sub spawn {
49			# based on IO::Pty::Easy v0.03
50			my ($self, @program) = @_;
51			my $slave = $self->pty->slave;
52
53			croak "Can't spawn a process when one is already running!"
54			if $self->is_active;
55
56			# for returning errors from the child process
57			my ($readp, $writep);
58			unless ( pipe($readp, $writep) ) {
59			croak "Failed to create a pipe";
60			}
61			$writep->autoflush(1);
62
63			# fork the child
64			my $pid = fork;
65			croak "Couldn't fork" unless defined $pid;
66
67			unless ( $pid ) {
68			# child process
69			close $readp;
70
71			$self->pty->make_slave_controlling_terminal;
72			close $self->pty;
73			$slave->set_raw;
74
75			# reopen STD{IN,OUT,ERR} to use the pty
76			eval {
77			open($STDIN, "<&", $slave->fileno) or croak "Couldn't reopen STDIN for reading: $!";
78			open($STDOUT, ">&", $slave->fileno) or croak "Couldn't reopen STDOUT for writing: $!";
79			open($STDERR, ">&", $slave->fileno) or croak "Couldn't reopen STDERR for writing: $!";
80			};
81			warn "t: $@" if $@;
82			die "t: $@" if $@;
83
84			close $slave;
85
86			system("stty","sane");
87
88			exec(@program);
89
90			# exec failed, tell our parent what happened
91			print $writep $! + 0;
92			carp "Cannot exec(@program): $!";
93
94			exit 1;
95			}
96
97			# parent process continues
98			close $writep;
99			$self->{'pid'} = $pid;
100
101			$self->pty->close_slave;
102			$self->pty->set_raw;
103
104			# this will block until EOF (exec killed the filehandle) or we get the error (exec failed)
105			my $errno;
106			my $read_bytes = sysread($readp, $errno, 256);
107
108			unless ( defined $read_bytes ) {
109			# something went bad wrong with the sysread
110			my $err = $!;
111			kill TERM => $pid;
112			close $readp;
113			# wait up to 2 seconds for the process to die
114			my $starttime = time;
115			sleep 0.01 while time() - $starttime < 2 and $self->is_active;
116			if ( time() - $starttime >= 2 ) { # harmless race condition
117			# beat the living crap out of the process
118			kill KILL => $pid;
119			}
120			croak "Cannot sync with child: $err";
121			}
122
123			close $readp;
124
125			if ( $read_bytes > 0 ) {
126			# child couldn't exec
127			$errno = $errno + 0;
128			$self->_wait_for_inactive;
129			croak "Cannot exec(@program): $errno";
130			}
131
132			return $self;
133			}
134
135			sub userinput {
136			my ($self, $input) = @_;
137			$self->term->userinput($input);
138			$self->_move_term_sendbuf;
139			$self->work_for(0);
140			return $self;
141			}
142
143			sub key {
144			my ($self, $key) = @_;
145			$self->term->key($key);
146			$self->_move_term_sendbuf;
147			$self->work_for(0);
148			return $self;
149			}
150
151			sub work_for {
152			my ($self, $time) = @_;
153			my $start = time;
154			my $ptyfn = fileno($self->pty);
155			my $loops = 0;
156			while ( 1 ) {
157			my $readvec = '';
158			vec($readvec, $ptyfn, 1) = 1;
159
160			my $writevec = '';
161			if ( length $self->{'buffers'}->{'ptysend'} ) {
162			vec($writevec, $ptyfn, 1) = 1;
163			}
164
165			my $len = ($start + $time) - time;
166			if ( $len < 0 ) {
167			last if $loops;
168			$len = 0;
169			}
170			my $nfound = select($readvec, $writevec, undef, $len);
171			last unless $nfound; # if no handles have been written to, we've finished our time chunk
172
173			# check for reads
174			if ( vec($readvec, $ptyfn, 1) ) {
175			# pty can read
176
177			my $buf = '';
178			my $n = sysread $self->pty, $buf, 16384;
179			if ( $n == 0 ) {
180			# EOF
181			$self->kill if $self->is_active;
182			last;
183			}
184			$self->term->parse($buf); # pass data sent from the pty slave to the terminal
185			$self->_move_term_sendbuf;
186			}
187
188			# check for writes if we have outstanding buffers
189			if ( vec($writevec, $ptyfn, 1) ) {
190			my $nchars = syswrite $self->pty, $self->{'buffers'}->{'ptysend'};
191			if ( $nchars ) {
192			$self->{'buffers'}->{'ptysend'} = substr $self->{'buffers'}->{'ptysend'}, $nchars;
193			}
194			}
195
196			# TODO: check for error conditions
197			$loops++;
198			}
199
200			return $self;
201			}
202
203			sub _move_term_sendbuf {
204			my ($self) = @_;
205			my $buf = $self->term->output;
206			if ( length $buf ) {
207			$self->{'buffers'}->{'ptysend'} .= $buf;
208			$self->term->output = '';
209			}
210			}
211
212			sub is_active {
213			my ($self) = @_;
214
215			return 0 unless defined $self->{'pid'};
216			if ( kill 0, $self->{'pid'} ) {
217			return 1;
218			} else {
219			undef $self->{'pid'};
220			}
221			}
222
223			sub kill {
224			my ($self, $signal) = @_;
225			$signal = "KILL" unless defined $signal;
226
227			return 0 unless $self->is_active;
228			return kill $signal, $self->{'pid'};
229			}
230
231			sub stop_it_in {
232			my ($self, $maxtime) = @_;
233			$maxtime = 5 unless defined $maxtime;
234			return 0 unless $self->is_active;
235
236			kill KILL => $self->{'pid'};
237			my $killtime = time;
238			while ( time() - $killtime < $maxtime ) {
239			return 1 if not $self->is_active;
240			sleep 0.05;
241			}
242
243			kill TERM => $self->{'pid'};
244
245			sleep 0.01;
246			return $self->is_active;
247			}
248
249			sub _wait_for_inactive {
250			my ($self) = @_;
251			sleep 0.01 while $self->is_active;
252			}
253
254			sub pty { $_[0]->{'pty'} }
255			sub term { $_[0]->{'term'} }
256
257			1;
258