From 65dc022f687b3bf5016853b220033e266ed37a09 Mon Sep 17 00:00:00 2001 From: jluehrs2 Date: Thu, 16 Aug 2007 19:00:36 -0500 Subject: move the module into place, add some boilerplate pod stuff --- Easy.pm | 153 ---------------------------------- lib/IO/Pty/Easy.pm | 236 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 236 insertions(+), 153 deletions(-) delete mode 100644 Easy.pm create mode 100644 lib/IO/Pty/Easy.pm diff --git a/Easy.pm b/Easy.pm deleted file mode 100644 index dc54b45..0000000 --- a/Easy.pm +++ /dev/null @@ -1,153 +0,0 @@ -package IO::Pty::Easy; -use warnings; -use strict; -use IO::Pty; - -our $VERSION = '0.01'; - -sub new { - my $class = shift; - my $self = { - # options - handle_pty_size => 1, - def_max_read_chars => 8192, - def_max_write_chars => 8192, - @_, - - # state - pty => undef, - pid => undef, - }; - - bless $self, $class; - - $self->{pty} = new IO::Pty; - - return $self; -} - -sub spawn { - my $self = shift; - my $slave = $self->{pty}->slave; - - # set up a pipe to use for keeping track of the child process during exec - my ($readp, $writep); - unless (pipe($readp, $writep)) { - warn "Failed to create a pipe"; - return; - } - $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->{pid} = fork; - unless ($self->{pid}) { - close $readp; - $self->{pty}->make_slave_controlling_terminal; - close $self->{pty}; - $slave->clone_winsize_from(\*STDIN) if $self->{handle_pty_size}; - $slave->set_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 warn "Couldn't reopen STDIN for reading"; - open(STDOUT, ">&" . $slave->fileno) - or warn "Couldn't reopen STDOUT for writing"; - open(STDERR, ">&" . $slave->fileno) - or warn "Couldn't reopen STDERR for writing"; - close $slave; - { exec(@_) }; - print $writep $! + 0; - die "Cannot exec(@_): $!"; - } - - close $writep; - $self->{pty}->close_slave; - $self->{pty}->set_raw; - # 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) { - warn "Cannot sync with child: $!"; - kill TERM => $self->{pid}; - close $readp; - return; - } - close $readp; - if ($read_bytes > 0) { - $errno = $errno + 0; - warn "Cannot exec(@_): $errno"; - return; - } - - my $pid = $self->{pid}; - my $winch; - $winch = sub { - $self->{pty}->slave->clone_winsize_from(\*STDIN); - kill WINCH => $self->{pid} if $self->is_active; - # XXX: does this work? - $SIG{WINCH} = $winch; - }; - $SIG{WINCH} = $winch if $self->{handle_pty_size}; - $SIG{CHLD} = sub { $self->{pid} = undef; wait }; -} - -sub read { - my $self = shift; - return 0 unless $self->is_active; - my ($buf, $timeout, $max_chars) = @_; - $max_chars ||= $self->{def_max_read_chars}; - - my $rin = ''; - vec($rin, fileno($self->{pty}), 1) = 1; - my $nfound = select($rin, undef, undef, $timeout); - my $nchars; - if ($nfound > 0) { - $nchars = sysread($self->{pty}, $_[0], $max_chars); - } - return $nchars; -} - -sub write { - my $self = shift; - return 0 unless $self->is_active; - my ($text, $timeout, $max_chars) = @_; - $max_chars ||= $self->{def_max_write_chars}; - - my $win = ''; - vec($win, fileno($self->{pty}), 1) = 1; - my $nfound = select(undef, $win, undef, $timeout); - my $nchars; - if ($nfound > 0) { - $nchars = syswrite($self->{pty}, $text, $max_chars); - } - return $nchars; -} - -sub is_active { - my $self = shift; - - return defined($self->{pid}); -} - -sub kill { - my $self = shift; - - # SIGCHLD should take care of undefing pid - kill TERM => $self->{pid} if $self->is_active; -} - -sub close { - my $self = shift; - - $self->kill; - close $self->{pty}; - $self->{pty} = undef; -} - -1; diff --git a/lib/IO/Pty/Easy.pm b/lib/IO/Pty/Easy.pm new file mode 100644 index 0000000..3faece4 --- /dev/null +++ b/lib/IO/Pty/Easy.pm @@ -0,0 +1,236 @@ +package IO::Pty::Easy; +use warnings; +use strict; +use IO::Pty; + +our $VERSION = '0.01'; + +sub new { + my $class = shift; + my $self = { + # options + handle_pty_size => 1, + def_max_read_chars => 8192, + def_max_write_chars => 8192, + @_, + + # state + pty => undef, + pid => undef, + }; + + bless $self, $class; + + $self->{pty} = new IO::Pty; + + return $self; +} + +sub spawn { + my $self = shift; + my $slave = $self->{pty}->slave; + + # set up a pipe to use for keeping track of the child process during exec + my ($readp, $writep); + unless (pipe($readp, $writep)) { + warn "Failed to create a pipe"; + return; + } + $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->{pid} = fork; + unless ($self->{pid}) { + close $readp; + $self->{pty}->make_slave_controlling_terminal; + close $self->{pty}; + $slave->clone_winsize_from(\*STDIN) if $self->{handle_pty_size}; + $slave->set_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 warn "Couldn't reopen STDIN for reading"; + open(STDOUT, ">&" . $slave->fileno) + or warn "Couldn't reopen STDOUT for writing"; + open(STDERR, ">&" . $slave->fileno) + or warn "Couldn't reopen STDERR for writing"; + close $slave; + { exec(@_) }; + print $writep $! + 0; + die "Cannot exec(@_): $!"; + } + + close $writep; + $self->{pty}->close_slave; + $self->{pty}->set_raw; + # 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) { + warn "Cannot sync with child: $!"; + kill TERM => $self->{pid}; + close $readp; + return; + } + close $readp; + if ($read_bytes > 0) { + $errno = $errno + 0; + warn "Cannot exec(@_): $errno"; + return; + } + + my $pid = $self->{pid}; + my $winch; + $winch = sub { + $self->{pty}->slave->clone_winsize_from(\*STDIN); + kill WINCH => $self->{pid} if $self->is_active; + # XXX: does this work? + $SIG{WINCH} = $winch; + }; + $SIG{WINCH} = $winch if $self->{handle_pty_size}; + $SIG{CHLD} = sub { $self->{pid} = undef; wait }; +} + +sub read { + my $self = shift; + return 0 unless $self->is_active; + my ($buf, $timeout, $max_chars) = @_; + $max_chars ||= $self->{def_max_read_chars}; + + my $rin = ''; + vec($rin, fileno($self->{pty}), 1) = 1; + my $nfound = select($rin, undef, undef, $timeout); + my $nchars; + if ($nfound > 0) { + $nchars = sysread($self->{pty}, $_[0], $max_chars); + } + return $nchars; +} + +sub write { + my $self = shift; + return 0 unless $self->is_active; + my ($text, $timeout, $max_chars) = @_; + $max_chars ||= $self->{def_max_write_chars}; + + my $win = ''; + vec($win, fileno($self->{pty}), 1) = 1; + my $nfound = select(undef, $win, undef, $timeout); + my $nchars; + if ($nfound > 0) { + $nchars = syswrite($self->{pty}, $text, $max_chars); + } + return $nchars; +} + +sub is_active { + my $self = shift; + + return defined($self->{pid}); +} + +sub kill { + my $self = shift; + + # SIGCHLD should take care of undefing pid + kill TERM => $self->{pid} if $self->is_active; +} + +sub close { + my $self = shift; + + $self->kill; + close $self->{pty}; + $self->{pty} = undef; +} + +1; +#!perl +package IO::Pty::Easy; +use strict; +use warnings; + + + +=head1 NAME + +IO::Pty::Easy - ??? + +=head1 VERSION + +Version 0.01 released ??? + +=cut + +our $VERSION = '0.01'; + +=head1 SYNOPSIS + + use IO::Pty::Easy; + do_stuff(); + +=head1 DESCRIPTION + + + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Shawn M Moore, C<< >> + +=head1 BUGS + +No known bugs. + +Please report any bugs through RT: email +C, or browse to +L. + +=head1 SUPPORT + +You can find this documentation for this module with the perldoc command. + + perldoc IO::Pty::Easy + +You can also look for information at: + +=over 4 + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * RT: CPAN's request tracker + +L + +=item * Search CPAN + +L + +=back + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007 Shawn M Moore. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; + -- cgit v1.2.3-54-g00ecf