view release on metacpan or  search on metacpan

lib/App/Tel/Expect.pm  view on Meta::CPAN

package App::Tel::Expect;
use strict;
use warnings;

=head1 NAME

App::Tel::Expect - Monkeypatching Expect to support callbacks and large buffer reads

=cut


use POSIX qw(:sys_wait_h :unistd_h); # For WNOHANG and isatty

$Expect::read_buffer_size = 10240;

*Expect::set_cb = sub {
    my ( $self, $object, $function, $params, @args ) = @_;

    # Set an escape sequence/function combo for a read handle for interconnect.
    # Ex: $read_handle->set_seq('',\&function,\@parameters);
    ${ ${*$object}{exp_cb_Function} } = $function;
    if ( ( !defined($function) ) || ( $function eq 'undef' ) ) {
        ${ ${*$object}{exp_cb_Function} } = \&_undef;
    }
    ${ ${*$object}{exp_cb_Parameters} } = $params;
};

no warnings 'redefine';
*Expect::interconnect = sub {
    my (@handles) = @_;

    #  my ($handle)=(shift); call as Expect::interconnect($spawn1,$spawn2,...)
    my ( $nread );
    my ( $rout, $emask, $eout );
    my ( $escape_character_buffer );
    my ( $read_mask, $temp_mask ) = ( '', '' );

    # Get read/write handles
    foreach my $handle (@handles) {
        $temp_mask = '';
        vec( $temp_mask, $handle->fileno(), 1 ) = 1;

        # Under Linux w/ 5.001 the next line comes up w/ 'Uninit var.'.
        # It appears to be impossible to make the warning go away.
        # doing something like $temp_mask='' unless defined ($temp_mask)
        # has no effect whatsoever. This may be a bug in 5.001.
        $read_mask = $read_mask | $temp_mask;
    }
    if ($Expect::Debug) {
        print STDERR "Read handles:\r\n";
        foreach my $handle (@handles) {
            print STDERR "\tRead handle: ";
            print STDERR "'${*$handle}{exp_Pty_Handle}'\r\n";
            print STDERR "\t\tListen Handles:";
            foreach my $write_handle ( @{ ${*$handle}{exp_Listen_Group} } ) {
                print STDERR " '${*$write_handle}{exp_Pty_Handle}'";
            }
            print STDERR ".\r\n";
        }
    }

    #  I think if we don't set raw/-echo here we may have trouble. We don't
    # want a bunch of echoing crap making all the handles jabber at each other.
    foreach my $handle (@handles) {
        unless ( ${*$handle}{"exp_Manual_Stty"} ) {

            # This is probably O/S specific.