IO-Tty

 view release on metacpan or  search on metacpan

Pty.pm  view on Meta::CPAN

# Documentation at the __END__

package IO::Pty;

use strict;
use Carp;
use IO::Tty qw(TIOCSCTTY TCSETCTTY TIOCNOTTY);
use IO::File;
require POSIX;

use vars qw(@ISA $VERSION);

$VERSION = '1.20';    # keep same as in Tty.pm

@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

sub new {
    my ($class) = $_[0] || "IO::Pty";
    $class = ref($class) if ref($class);
    @_ <= 1 or croak 'usage: new $class';

    my ( $ptyfd, $ttyfd, $ttyname ) = pty_allocate();

    croak "Cannot open a pty" if not defined $ptyfd;

    my $pty = $class->SUPER::new_from_fd( $ptyfd, "r+" );
    croak "Cannot create a new $class from fd $ptyfd: $!" if not $pty;
    $pty->autoflush(1);
    bless $pty => $class;

    my $slave = IO::Tty->new_from_fd( $ttyfd, "r+" );
    croak "Cannot create a new IO::Tty from fd $ttyfd: $!" if not $slave;
    $slave->autoflush(1);

    ${*$pty}{'io_pty_slave'}     = $slave;
    ${*$pty}{'io_pty_ttyname'}   = $ttyname;
    ${*$slave}{'io_tty_ttyname'} = $ttyname;

    return $pty;
}

sub ttyname {
    @_ == 1 or croak 'usage: $pty->ttyname();';
    my $pty = shift;
    ${*$pty}{'io_pty_ttyname'};
}

sub close_slave {
    @_ == 1 or croak 'usage: $pty->close_slave();';

    my $master = shift;

    if ( exists ${*$master}{'io_pty_slave'} ) {
        close ${*$master}{'io_pty_slave'};
        delete ${*$master}{'io_pty_slave'};
    }
}

sub slave {
    @_ == 1 or croak 'usage: $pty->slave();';

    my $master = shift;

    if ( exists ${*$master}{'io_pty_slave'} ) {
        return ${*$master}{'io_pty_slave'};
    }

    my $tty = ${*$master}{'io_pty_ttyname'};

    my $slave = new IO::Tty;

    $slave->open( $tty, O_RDWR | O_NOCTTY )
      || croak "Cannot open slave $tty: $!";

    return $slave;
}

sub make_slave_controlling_terminal {
    @_ == 1 or croak 'usage: $pty->make_slave_controlling_terminal();';

    my $self = shift;
    local (*DEVTTY);

    # loose controlling terminal explicitly
    if ( defined TIOCNOTTY ) {
        if ( open( \*DEVTTY, "/dev/tty" ) ) {
            ioctl( \*DEVTTY, TIOCNOTTY, 0 );
            close \*DEVTTY;
        }

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 0.565 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )