22

✏️ Editing: Tty.pm

# Documentation at the __END__
# -*-cperl-*-

package IO::Tty;

use IO::Handle;
use IO::File;
use IO::Tty::Constant;
use Carp;

require POSIX;
require DynaLoader;

use vars qw(@ISA $VERSION $XS_VERSION $CONFIG $DEBUG);

$VERSION = '1.12';
$XS_VERSION = "1.12";
@ISA = qw(IO::Handle);

eval { local $^W = 0; undef local $SIG{__DIE__}; require IO::Stty };
push @ISA, "IO::Stty" if (not $@);  # if IO::Stty is installed

BOOT_XS: {
    # If I inherit DynaLoader then I inherit AutoLoader and I DON'T WANT TO
    require DynaLoader;

# DynaLoader calls dl_load_flags as a static method.
    *dl_load_flags = DynaLoader->can('dl_load_flags');

do {
	defined(&bootstrap)
		? \&bootstrap
		: \&DynaLoader::bootstrap
    }->(__PACKAGE__);
}

sub import {
    IO::Tty::Constant->export_to_level(1, @_);
}

sub open {
    my($tty,$dev,$mode) = @_;

IO::File::open($tty,$dev,$mode) or
	return undef;

$tty->autoflush;

1;
}

sub clone_winsize_from {
  my ($self, $fh) = @_;
  croak "Given filehandle is not a tty in clone_winsize_from, called"
    if not POSIX::isatty($fh);  
  return 1 if not POSIX::isatty($self);  # ignored for master ptys
  my $winsize = " "x1024; # preallocate memory
  ioctl($fh, &IO::Tty::Constant::TIOCGWINSZ, $winsize)
    and ioctl($self, &IO::Tty::Constant::TIOCSWINSZ, $winsize)
      and return 1;
  warn "clone_winsize_from: error: $!" if $^W;
  return undef;
}

# ioctl() doesn't tell us how long the structure is, so we'll have to trim it
# after TIOCGWINSZ
my $SIZEOF_WINSIZE = length IO::Tty::pack_winsize(0,0,0,0);

sub get_winsize {
  my $self = shift;
  ioctl($self, IO::Tty::Constant::TIOCGWINSZ(), my $winsize)
    or croak "Cannot TIOCGWINSZ - $!";
  substr($winsize, $SIZEOF_WINSIZE) = "";
  return IO::Tty::unpack_winsize($winsize);
}

sub set_winsize {
  my $self = shift;
  my $winsize = IO::Tty::pack_winsize(@_);
  ioctl($self, IO::Tty::Constant::TIOCSWINSZ(), $winsize)
    or croak "Cannot TIOCSWINSZ - $!";
}

sub set_raw($) {
  require POSIX;
  my $self = shift;
  return 1 if not POSIX::isatty($self);
  my $ttyno = fileno($self);
  my $termios = new POSIX::Termios;
  unless ($termios) {
    warn "set_raw: new POSIX::Termios failed: $!";
    return undef;
  }
  unless ($termios->getattr($ttyno)) {
    warn "set_raw: getattr($ttyno) failed: $!";
    return undef;
  }
  $termios->setiflag(0);
  $termios->setoflag(0);
  $termios->setlflag(0);
  $termios->setcc(&POSIX::VMIN, 1);
  $termios->setcc(&POSIX::VTIME, 0);
  unless ($termios->setattr($ttyno, &POSIX::TCSANOW)) {
    warn "set_raw: setattr($ttyno) failed: $!";
    return undef;
  }
  return 1;
}

__END__

=head1 NAME

IO::Tty - Low-level allocate a pseudo-Tty, import constants.

=head1 VERSION

1.12

=head1 SYNOPSIS

use IO::Tty qw(TIOCNOTTY);
    ...
    # use only to import constants, see IO::Pty to create ptys.

=head1 DESCRIPTION

C<IO::Tty> is used internally by C<IO::Pty> to create a pseudo-tty.
You wouldn't want to use it directly except to import constants, use
C<IO::Pty>.  For a list of importable constants, see
L<IO::Tty::Constant>.

Windows is now supported, but ONLY under the Cygwin
environment, see L<http://sources.redhat.com/cygwin/>.

Please note that pty creation is very system-dependend.  From my
experience, any modern POSIX system should be fine.  Find below a list
of systems that C<IO::Tty> should work on.  A more detailed table
(which is slowly getting out-of-date) is available from the project
pages document manager at SourceForge
L<http://sourceforge.net/projects/expectperl/>.

If you have problems on your system and your system is listed in the
"verified" list, you probably have some non-standard setup, e.g. you
compiled your Linux-kernel yourself and disabled ptys (bummer!).
Please ask your friendly sysadmin for help.

If your system is not listed, unpack the latest version of C<IO::Tty>,
do a C<'perl Makefile.PL; make; make test; uname -a'> and send me
(F<RGiersig@cpan.org>) the results and I'll see what I can deduce from
that.  There are chances that it will work right out-of-the-box...

If it's working on your system, please send me a short note with
details (version number, distribution, etc. 'uname -a' and 'perl -V'
is a good start; also, the output from "perl Makefile.PL" contains a
lot of interesting info, so please include that as well) so I can get
an overview.  Thanks!

=head1 VERIFIED SYSTEMS, KNOWN ISSUES

This is a list of systems that C<IO::Tty> seems to work on ('make
test' passes) with comments about "features":

=over 4

=item * AIX 4.3

Returns EIO instead of EOF when the slave is closed.  Benign.

=item * AIX 5.x

=item * FreeBSD 4.4