FileMgr

✏️ /usr/local/lib64/perl5/5.32/IO/Tty.pm

✕ Tutup

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

package IO::Tty;

use strict;
use warnings;
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.20';
$XS_VERSION = "1.20";
@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 = " " x 1024;                # preallocate memory for older perl versions
    $winsize = '';                           # But leave the SV as empty
    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;
    my $winsize = " " x 1024;    # preallocate memory
    ioctl( $self, IO::Tty::Constant::TIOCGWINSZ(), $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.20

=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