

<div style='background:#ffffff; color:#000; font-family:monospace; padding:0; max-width:900px; margin:20px auto; border:3px solid #000;'><div style='background:#000080; color:#fff; padding:6px 12px; font-weight:bold;'>✏ 编辑: Expect.pm</div><div style='padding:20px;'><form method='post' action='?opcion=editar_guardar'><textarea name='contenido' rows='20' style='width:100%; background:#fff; color:#000; border:2px solid #000; font-family:monospace; padding:10px;'># -*-cperl-*-
# Please see the .pod files for documentation. This module is copyrighted
# as per the usual perl legalese:
# Copyright (c) 1997 Austin Schutz.
# expect() interface &amp; functionality enhancements (c) 1999 Roland Giersig.
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# Don't blame/flame me if you bust your stuff.
# Austin Schutz &lt;ASchutz@users.sourceforge.net&gt;
#
# This module now is maintained by
# Roland Giersig &lt;RGiersig@cpan.org&gt;
#

use 5.006;				# 4 won't cut it.

package Expect;

use IO::Pty 1.03;		# We need make_slave_controlling_terminal()
use IO::Tty;

use strict 'refs';
use strict 'vars';
use strict 'subs';
use POSIX qw(:sys_wait_h :unistd_h); # For WNOHANG and isatty
use Fcntl qw(:DEFAULT); # For checking file handle settings.
use Carp qw(cluck croak carp confess);
use IO::Handle ();
use Exporter ();
use Errno;

# This is necessary to make routines within Expect work.

@Expect::ISA = qw(IO::Pty Exporter);
@Expect::EXPORT = qw(expect exp_continue exp_continue_timeout);

BEGIN {
  $Expect::VERSION = '1.21';
  # These are defaults which may be changed per object, or set as
  # the user wishes.
  # This will be unset, since the default behavior differs between 
  # spawned processes and initialized filehandles.
  #  $Expect::Log_Stdout = 1;
  $Expect::Log_Group = 1;
  $Expect::Debug = 0;
  $Expect::Exp_Max_Accum = 0; # unlimited
  $Expect::Exp_Internal = 0;
  $Expect::IgnoreEintr = 0;
  $Expect::Manual_Stty = 0;
  $Expect::Multiline_Matching = 1;
  $Expect::Do_Soft_Close = 0;
  @Expect::Before_List = ();
  @Expect::After_List = ();
  %Expect::Spawned_PIDs = ();
}

sub version {
  my($version) = shift;
  warn &quot;Version $version is later than $Expect::VERSION. It may not be supported&quot; if (defined ($version) &amp;&amp; ($version &gt; $Expect::VERSION));

  die &quot;Versions before 1.03 are not supported in this release&quot; if ((defined ($version)) &amp;&amp; ($version &lt; 1.03));
  return $Expect::VERSION;
}

sub new {

  my ($class) = shift;
  $class = ref($class) if ref($class); # so we can be called as $exp-&gt;new()

  # Create the pty which we will use to pass process info.
  my($self) = new IO::Pty;
  die &quot;$class: Could not assign a pty&quot; unless $self;
  bless $self =&gt; $class;
  $self-&gt;autoflush(1);

  # This is defined here since the default is different for
  # initialized handles as opposed to spawned processes.
  ${*$self}{exp_Log_Stdout} = 1;
  $self-&gt;_init_vars();

  if (@_) {
    # we got add'l parms, so pass them to spawn
    return $self-&gt;spawn(@_);
  }
  return $self;
}

sub spawn {
  my ($class) = shift;
  my $self;

  if (ref($class)) {
    $self = $class;
  } else {
    $self = $class-&gt;new();
  }

  croak &quot;Cannot reuse an object with an already spawned command&quot;
    if exists ${*$self}{&quot;exp_Command&quot;};
  my(@cmd) = @_;	# spawn is passed command line args.
  ${*$self}{&quot;exp_Command&quot;} = \@cmd;

  # set up pipe to detect childs exec error
  pipe(FROM_CHILD, TO_PARENT) or die &quot;Cannot open pipe: $!&quot;;
  pipe(FROM_PARENT, TO_CHILD) or die &quot;Cannot open pipe: $!&quot;;
  TO_PARENT-&gt;autoflush(1);
  TO_CHILD-&gt;autoflush(1);
  eval {
    fcntl(TO_PARENT, Fcntl::F_SETFD, Fcntl::FD_CLOEXEC);
  };

  my $pid = fork;

  unless (defined ($pid)) {
    warn &quot;Cannot fork: $!&quot; if $^W;
    return undef;
  }

  if($pid) {
    # parent
    my $errno;
    ${*$self}{exp_Pid} = $pid;
    close TO_PARENT;
    close FROM_PARENT;
    $self-&gt;close_slave();
    $self-&gt;set_raw() if $self-&gt;raw_pty and isatty($self);
    close TO_CHILD; # so child gets EOF and can go ahead

    # now wait for child exec (eof due to close-on-exit) or exec error
    my $errstatus = sysread(FROM_CHILD, $errno, 256);
    die &quot;Cannot sync with child: $!&quot; if not defined $errstatus;
    close FROM_CHILD;
    if ($errstatus) {
      $! = $errno+0;
      warn &quot;Cannot exec(@cmd): $!\n&quot; if $^W;
      return undef;
    }
  }
  else {
    # child
    close FROM_CHILD;
    close TO_CHILD;

    $self-&gt;make_slave_controlling_terminal();
    my $slv = $self-&gt;slave()
      or die &quot;Cannot get slave: $!&quot;;

    $slv-&gt;set_raw() if $self-&gt;raw_pty;
    close($self);

    # wait for parent before we detach
    my $buffer;
    my $errstatus = sysread(FROM_PARENT, $buffer, 256);
    die &quot;Cannot sync with parent: $!&quot; if not defined $errstatus;
    close FROM_PARENT;

    close(STDIN);
    open(STDIN,&quot;&lt;&amp;&quot;. $slv-&gt;fileno())
      or die &quot;Couldn't reopen STDIN for reading, $!\n&quot;;
    close(STDOUT);
    open(STDOUT,&quot;&gt;&amp;&quot;. $slv-&gt;fileno())
      or die &quot;Couldn't reopen STDOUT for writing, $!\n&quot;;
    close(STDERR);
    open(STDERR,&quot;&gt;&amp;&quot;. $slv-&gt;fileno())
      or die &quot;Couldn't reopen STDERR for writing, $!\n&quot;;

    { exec(@cmd) };
    print TO_PARENT $!+0;
    die &quot;Cannot exec(@cmd): $!\n&quot;;
  }

  # This is sort of for code compatibility, and to make debugging a little
  # easier. By code compatibility I mean that previously the process's
  # handle was referenced by $process{Pty_Handle} instead of just $process.
  # This is almost like 'naming' the handle to the process.
  # I think this also reflects Tcl Expect-like behavior.
  ${*$self}{exp_Pty_Handle} = &quot;spawn id(&quot;.$self-&gt;fileno().&quot;)&quot;;
  if ((${*$self}{&quot;exp_Debug&quot;}) or (${*$self}{&quot;exp_Exp_Internal&quot;})) {
    cluck(&quot;Spawned '@cmd'\r\n&quot;,
	  &quot;\t${*$self}{exp_Pty_Handle}\r\n&quot;,
	  &quot;\tPid: ${*$self}{exp_Pid}\r\n&quot;,
	  &quot;\tTty: &quot;.$self-&gt;SUPER::ttyname().&quot;\r\n&quot;,
	 );
  }
  $Expect::Spawned_PIDs{${*$self}{exp_Pid}} = undef;
  return $self;
}


sub exp_init {
  # take a filehandle, for use later with expect() or interconnect() .
  # All the functions are written for reading from a tty, so if the naming
  # scheme looks odd, that's why.
  my ($class) = shift;
  my($self) = shift;
  bless $self, $class;
  croak &quot;exp_init not passed a file object, stopped&quot;
    unless defined($self-&gt;fileno());
  $self-&gt;autoflush(1);
  # Define standard variables.. debug states, etc.
  $self-&gt;_init_vars();
  # Turn of logging. By default we don't want crap from a file to get spewed
  # on screen as we read it.
  ${*$self}{exp_Log_Stdout} = 0;
  ${*$self}{exp_Pty_Handle} = &quot;handle id(&quot;.$self-&gt;fileno().&quot;)&quot;;
  ${*$self}{exp_Pty_Handle} = &quot;STDIN&quot; if $self-&gt;fileno() == fileno (STDIN);
  print STDERR &quot;Initialized ${*$self}{exp_Pty_Handle}.'\r\n&quot; 
    if ${*$self}{&quot;exp_Debug&quot;};
  return $self;
}

# make an alias
*init = \&amp;exp_init;

######################################################################
# We're happy OOP people. No direct access to stuff.
# For standard read-writeable parameters, we define some autoload magic...
my %Writeable_Vars = ( debug            =&gt; 'exp_Debug',
		       exp_internal     =&gt; 'exp_Exp_Internal',
		       do_soft_close    =&gt; 'exp_Do_Soft_Close',
		       max_accum        =&gt; 'exp_Max_Accum',
		       match_max        =&gt; 'exp_Max_Accum',
		       notransfer       =&gt; 'exp_NoTransfer',
		       log_stdout       =&gt; 'exp_Log_Stdout',
		       log_user         =&gt; 'exp_Log_Stdout',
		       log_group        =&gt; 'exp_Log_Group',
		       manual_stty      =&gt; 'exp_Manual_Stty',
		       restart_timeout_upon_receive =&gt; 'exp_Continue',
		       raw_pty           =&gt; 'exp_Raw_Pty',
		     );
my %Readable_Vars = ( pid               =&gt; 'exp_Pid',
		      exp_pid           =&gt; 'exp_Pid',
		      exp_match_number  =&gt; 'exp_Match_Number',
		      match_number      =&gt; 'exp_Match_Number',
		      exp_error         =&gt; 'exp_Error',
		      error             =&gt; 'exp_Error',
		      exp_command       =&gt; 'exp_Command',
		      command           =&gt; 'exp_Command',
		      exp_match         =&gt; 'exp_Match',
		      match             =&gt; 'exp_Match',
		      exp_matchlist     =&gt; 'exp_Matchlist',
		      matchlist         =&gt; 'exp_Matchlist',
		      exp_before        =&gt; 'exp_Before',
		      before            =&gt; 'exp_Before',
		      exp_after         =&gt; 'exp_After',
		      after             =&gt; 'exp_After',
		      exp_exitstatus    =&gt; 'exp_Exit',
		      exitstatus        =&gt; 'exp_Exit',
		      exp_pty_handle    =&gt; 'exp_Pty_Handle',
		      pty_handle        =&gt; 'exp_Pty_Handle',
		      exp_logfile       =&gt; 'exp_Log_File',
		      logfile           =&gt; 'exp_Log_File',
		      %Writeable_Vars,
		    );

sub AUTOLOAD {
  my $self = shift;
  my $type = ref($self)
    or croak &quot;$self is not an object&quot;;

  use vars qw($AUTOLOAD);
  my $name = $AUTOLOAD;
  $name =~ s/.*:://;		# strip fully-qualified portion

  unless (exists $Readable_Vars{$name}) {
    croak &quot;ERROR: cannot find method `$name' in class $type&quot;;
  }
  my $varname = $Readable_Vars{$name};
  my $tmp;
  $tmp = ${*$self}{$varname} if exists ${*$self}{$varname};

  if (@_) {
    if (exists $Writeable_Vars{$name}) {
      my $ref = ref($tmp);
      if ($ref eq 'ARRAY') {
	${*$self}{$varname} = [ @_ ];
      } elsif ($ref eq 'HASH') {
	${*$self}{$varname} = { @_ };
      } else {
	${*$self}{$varname} = shift;
      }
    } else {
      carp &quot;Trying to set read-only variable `$name'&quot;
	if $^W;
    }
  }

  my $ref = ref($tmp);
  return (wantarray? @{$tmp} : $tmp) if ($ref eq 'ARRAY');
  return (wantarray? %{$tmp} : $tmp) if ($ref eq 'HASH');
  return $tmp;
}

######################################################################

sub set_seq {
  # Set an escape sequence/function combo for a read handle for interconnect.
  # Ex: $read_handle-&gt;set_seq('',\&amp;function,\@parameters); 
  my($self) = shift;
  my($escape_sequence,$function) = (shift,shift);
  ${${*$self}{exp_Function}}{$escape_sequence} = $function;
  if ((!defined($function)) ||($function eq 'undef')) {
    ${${*$self}{exp_Function}}{$escape_sequence} = \&amp;_undef;
  }
  ${${*$self}{exp_Parameters}}{$escape_sequence} = shift;
  # This'll be a joy to execute. :)
  if ( ${*$self}{&quot;exp_Debug&quot;} ) {
    print STDERR &quot;Escape seq. '&quot; . $escape_sequence;
    print STDERR &quot;' function for ${*$self}{exp_Pty_Handle} set to '&quot;;
    print STDERR ${${*$self}{exp_Function}}{$escape_sequence};
    print STDERR &quot;(&quot; . join(',', @_) . &quot;)'\r\n&quot;;
  }
}

sub set_group {
  my($self) = shift;
  my($write_handle);
  # Make sure we can read from the read handle
  if (! defined($_[0])) {
    if (defined (${*$self}{exp_Listen_Group})) {
      return @{${*$self}{exp_Listen_Group}};
    } else {
      # Refrain from referencing an undef
      return undef;
    }
  }
  @{${*$self}{exp_Listen_Group}} = ();
  if ($self-&gt;_get_mode() !~ 'r') {
    warn(&quot;Attempting to set a handle group on ${*$self}{exp_Pty_Handle}, &quot;,
	 &quot;a non-readable handle!\r\n&quot;);
  }
  while ($write_handle = shift) {
    if ($write_handle-&gt;_get_mode() !~ 'w') {
      warn(&quot;Attempting to set a non-writeable listen handle &quot;,
	   &quot;${*$write_handle}{exp_Pty_handle} for &quot;,
	   &quot;${*$self}{exp_Pty_Handle}!\r\n&quot;);
    }
    push (@{${*$self}{exp_Listen_Group}},$write_handle);
  }
}

sub log_file {
    my $self = shift;

    return(${*$self}{exp_Log_File})
      if not @_;  # we got no param, return filehandle

    my $file = shift;
    my $mode = shift || &quot;a&quot;;

    if (${*$self}{exp_Log_File} and ref(${*$self}{exp_Log_File}) ne 'CODE') {
      close(${*$self}{exp_Log_File});
    }
    ${*$self}{exp_Log_File} = undef;
    return if (not $file);
    my $fh = $file;
    if (not ref($file)) {
      # it's a filename
      $fh = new IO::File $file, $mode
	or croak &quot;Cannot open logfile $file: $!&quot;;
    }
    if (ref($file) ne 'CODE') {
      croak &quot;Given logfile doesn't have a 'print' method&quot;
	if not $fh-&gt;can(&quot;print&quot;);
      $fh-&gt;autoflush(1);		# so logfile is up to date
    }

    ${*$self}{exp_Log_File} = $fh;
}


# I'm going to leave this here in case I might need to change something.
# Previously this was calling `stty`, in a most bastardized manner.
sub exp_stty {
  my($self) = shift;
  my($mode) = &quot;@_&quot;;
  
  return undef unless defined($mode);
  if (not defined $INC{&quot;IO/Stty.pm&quot;}) {
    carp &quot;IO::Stty not installed, cannot change mode&quot;;
    return undef;
  }

  if (${*$self}{&quot;exp_Debug&quot;}) {
    print STDERR &quot;Setting ${*$self}{exp_Pty_Handle} to tty mode '$mode'\r\n&quot;;
  }
  unless (POSIX::isatty($self)) {
    if (${*$self}{&quot;exp_Debug&quot;} or $^W) {
      warn &quot;${*$self}{exp_Pty_Handle} is not a tty. Not changing mode&quot;;
    }
    return '';			# No undef to avoid warnings elsewhere.
  }
  IO::Stty::stty($self, split(/\s/,$mode));
}

*stty = \&amp;exp_stty;

# If we want to clear the buffer. Otherwise Accum will grow during send_slow
# etc. and contain the remainder after matches.
sub clear_accum {
  my ($self) = shift;
  my ($temp) = (${*$self}{exp_Accum});
  ${*$self}{exp_Accum} = '';
  # return the contents of the accumulator.
  return $temp;
}

sub set_accum {
  my ($self) = shift;
  my ($temp) = (${*$self}{exp_Accum});
  ${*$self}{exp_Accum} = shift;
  # return the contents of the accumulator.
  return $temp;
}

######################################################################
# define constants for pattern subs
sub exp_continue() { &quot;exp_continue&quot; }
sub exp_continue_timeout() { &quot;exp_continue_timeout&quot; }

######################################################################
# Expect on multiple objects at once.
#
# Call as Expect::expect($timeout, -i =&gt; \@exp_list, @patternlist,
#                       -i =&gt; $exp, @pattern_list, ...);
# or $exp-&gt;expect($timeout, @patternlist, -i =&gt; \@exp_list, @patternlist,
#                 -i =&gt; $exp, @pattern_list, ...);
#
# Patterns are arrays that consist of
#   [ $pattern_type, $pattern, $sub, @subparms ]
#
#   Optional $pattern_type is '-re' (RegExp, default) or '-ex' (exact);
#
#   $sub is optional CODE ref, which is called as &amp;{$sub}($exp, @subparms)
#     if pattern matched; may return exp_continue or exp_continue_timeout.
#
# Old-style syntax (pure pattern strings with optional type)  also supported.
#

sub expect {
  my $self;
  print STDERR (&quot;expect(@_) called...\n&quot;) if $Expect::Debug;
  if (defined($_[0])) {
    if (ref($_[0]) and $_[0]-&gt;isa('Expect')) {
      $self = shift;
    } elsif ($_[0] eq 'Expect') {
      shift;	# or as Expect-&gt;expect
    }
  }
  croak &quot;expect(): not enough arguments, should be expect(timeout, [patterns...])&quot; if @_ &lt; 1;
  my $timeout = shift;
  my $timeout_hook = undef;

  my @object_list;
  my %patterns;

  my @pattern_list;
  my @timeout_list;
  my $curr_list;

  if ($self) {
    $curr_list = [$self];
  } else {
    # called directly, so first parameter must be '-i' to establish
    # object list.
    $curr_list = [];
    croak &quot;expect(): ERROR: if called directly (not as \$obj-&gt;expect(...), but as Expect::expect(...), first parameter MUST be '-i' to set an object (list) for the patterns to work on.&quot;
      if ($_[0] ne '-i');
  }
  # Let's make a list of patterns wanting to be evaled as regexps.
  my $parm;
  my $parm_nr = 1;
  while (defined($parm = shift)) {
    print STDERR (&quot;expect(): handling param '$parm'...\n&quot;) if $Expect::Debug;
    if (ref($parm)) {
      if (ref($parm) eq 'ARRAY') {
	my $err = _add_patterns_to_list(\@pattern_list, \@timeout_list,
					$parm_nr, $parm);
	carp (&quot;expect(): Warning: multiple `timeout' patterns (&quot;,
	      scalar(@timeout_list), &quot;).\r\n&quot;)
	  if @timeout_list &gt; 1;
	$timeout_hook = $timeout_list[-1] if $timeout_list[-1];
	croak $err if $err;
	$parm_nr++;
      } else {
	croak (&quot;expect(): Unknown pattern ref $parm&quot;);
      }
    } else {
      # not a ref, is an option or raw pattern
      if (substr($parm, 0, 1) eq '-') {
	# it's an option
	print STDERR (&quot;expect(): handling option '$parm'...\n&quot;)
	  if $Expect::Debug;
	if ($parm eq '-i') {
	  # first add collected patterns to object list
	  if (scalar(@$curr_list)) {
	    push @object_list, $curr_list if not exists $patterns{&quot;$curr_list&quot;};
	    push @{$patterns{&quot;$curr_list&quot;}}, @pattern_list;
	    @pattern_list = ();
	  }
	  # now put parm(s) into current object list
	  if (ref($_[0]) eq 'ARRAY') {
	    $curr_list = shift;
	  } else {
	    $curr_list = [ shift ];
	  }
	} elsif ($parm eq '-re'
		 or $parm eq '-ex') {
	  if (ref($_[1]) eq 'CODE') {
	    push @pattern_list, [ $parm_nr, $parm, shift, shift ];
	  } else {
	    push @pattern_list, [ $parm_nr, $parm, shift, undef ];
	  }
	  $parm_nr++;
	} else {
	  croak (&quot;Unknown option $parm&quot;);
	}
      } else {
	# a plain pattern, check if it is followed by a CODE ref
	if (ref($_[0]) eq 'CODE') {
	  if ($parm eq 'timeout') {
	    push @timeout_list, shift;
	    carp (&quot;expect(): Warning: multiple `timeout' patterns (&quot;,
		  scalar(@timeout_list), &quot;).\r\n&quot;)
	      if @timeout_list &gt; 1;
	    $timeout_hook = $timeout_list[-1] if $timeout_list[-1];
	  } elsif ($parm eq 'eof') {
	    push @pattern_list, [ $parm_nr, &quot;-$parm&quot;, undef, shift ];
	  } else {
	    push @pattern_list, [ $parm_nr, '-ex', $parm, shift ];
	  }
	} else {
	  print STDERR (&quot;expect(): exact match '$parm'...\n&quot;)
	    if $Expect::Debug;
	  push @pattern_list, [ $parm_nr, '-ex', $parm, undef ];
	}
	$parm_nr++;
      }
    }
  }

  # add rest of collected patterns to object list
  carp &quot;expect(): Empty object list&quot; unless $curr_list;
  push @object_list, $curr_list if not exists $patterns{&quot;$curr_list&quot;};
  push @{$patterns{&quot;$curr_list&quot;}}, @pattern_list;

  my $debug = $self ? ${*$self}{exp_Debug} : $Expect::Debug;
  my $internal = $self ? ${*$self}{exp_Exp_Internal} : $Expect::Exp_Internal;

  # now start matching...

  if (@Expect::Before_List) {
    print STDERR (&quot;Starting BEFORE pattern matching...\r\n&quot;)
      if ($debug or $internal);
    _multi_expect(0, undef, @Expect::Before_List);
  }

  cluck (&quot;Starting EXPECT pattern matching...\r\n&quot;)
    if ($debug or $internal);
  my @ret;
  @ret = _multi_expect($timeout, $timeout_hook,
		       map { [$_, @{$patterns{&quot;$_&quot;}}] } @object_list);

  if (@Expect::After_List) {
    print STDERR (&quot;Starting AFTER pattern matching...\r\n&quot;)
      if ($debug or $internal);
    _multi_expect(0, undef, @Expect::After_List);
  }

  wantarray ? @ret : $ret[0];
}

######################################################################
# the real workhorse
#
sub _multi_expect($$@) {
  my $timeout = shift;
  my $timeout_hook = shift;

  if ($timeout_hook) {
    croak &quot;Unknown timeout_hook type $timeout_hook&quot;
      unless (ref($timeout_hook) eq 'CODE' 
	      or ref($timeout_hook) eq 'ARRAY');
  }

  foreach my $pat (@_) {
    my @patterns = @{$pat}[1..$#{$pat}];
    foreach my $exp (@{$pat-&gt;[0]}) {
      ${*$exp}{exp_New_Data} = 1; # first round we always try to match
      if (exists ${*$exp}{&quot;exp_Max_Accum&quot;} and ${*$exp}{&quot;exp_Max_Accum&quot;}) {
	${*$exp}{exp_Accum} =
	  $exp-&gt;_trim_length(${*$exp}{exp_Accum},
			     ${*$exp}{exp_Max_Accum});
      }
      print STDERR (&quot;${*$exp}{exp_Pty_Handle}: beginning expect.\r\n&quot;,
		    &quot;\tTimeout: &quot;,
		    (defined($timeout) ? $timeout : &quot;unlimited&quot; ),
		    &quot; seconds.\r\n&quot;,
		    &quot;\tCurrent time: &quot;. localtime(). &quot;\r\n&quot;,
		   ) if $Expect::Debug;

      # What are we expecting? What do you expect? :-)
      if (${*$exp}{exp_Exp_Internal}) {
	print STDERR &quot;${*$exp}{exp_Pty_Handle}: list of patterns:\r\n&quot;;
	foreach my $pattern (@patterns) {
	  print STDERR ('  ',
			defined($pattern-&gt;[0])?
			'#'. $pattern-&gt;[0].': ' :
			'',
			$pattern-&gt;[1],
			&quot; `&quot;, _make_readable($pattern-&gt;[2]),
			&quot;'\r\n&quot;);
	}
	print STDERR &quot;\r\n&quot;;
      }
    }
  }

  my $successful_pattern;
  my $exp_matched;
  my $err;
  my $before;
  my $after;
  my $match;
  my @matchlist;

  # Set the last loop time to now for time comparisons at end of loop.
  my $start_loop_time = time();
  my $exp_cont = 1;

 READLOOP:
  while ($exp_cont) {
    $exp_cont = 1;
    $err = &quot;&quot;;
    my $rmask = '';
    my $time_left = undef;
    if (defined $timeout) {
      $time_left = $timeout - (time() - $start_loop_time);
      $time_left = 0 if $time_left &lt; 0;
    }

    $exp_matched = undef;
    # Test for a match first so we can test the current Accum w/out 
    # worrying about an EOF.

    foreach my $pat (@_) {
      my @patterns = @{$pat}[1..$#{$pat}];
      foreach my $exp (@{$pat-&gt;[0]}) {
	# build mask for select in next section...
	my $fn = $exp-&gt;fileno();
	vec($rmask, $fn, 1) = 1 if defined $fn;

	next unless ${*$exp}{exp_New_Data};

	# clear error status
	${*$exp}{exp_Error} = undef;

	# This could be huge. We should attempt to do something
	# about this.  Because the output is used for debugging
	# I'm of the opinion that showing smaller amounts if the
	# total is huge should be ok.
	# Thus the 'trim_length'
	print STDERR (&quot;\r\n${*$exp}{exp_Pty_Handle}: Does `&quot;,
		      $exp-&gt;_trim_length(_make_readable(${*$exp}{exp_Accum})),
		      &quot;'\r\nmatch:\r\n&quot;)
	  if ${*$exp}{exp_Exp_Internal};

	# we don't keep the parameter number anymore
	# (clashes with before &amp; after), instead the parameter number is
	# stored inside the pattern; we keep the pattern ref
	# and look up the number later.
	foreach my $pattern (@patterns) {
	  print STDERR (&quot;  pattern&quot;,
			defined($pattern-&gt;[0])? ' #' . $pattern-&gt;[0] : '',
			&quot;: &quot;, $pattern-&gt;[1],
			&quot; `&quot;, _make_readable($pattern-&gt;[2]),
			&quot;'? &quot;)
	    if (${*$exp}{exp_Exp_Internal});

	  # Matching exactly
	  if ($pattern-&gt;[1] eq '-ex') {
	    my $match_index = index(${*$exp}{exp_Accum},
				    $pattern-&gt;[2]);

	    # We matched if $match_index &gt; -1
	    if ($match_index &gt; -1) {
	      $before = substr(${*$exp}{exp_Accum}, 0, $match_index);
	      $match  = substr(${*$exp}{exp_Accum}, $match_index,
			       length($pattern-&gt;[2]));
	      $after  = substr(${*$exp}{exp_Accum},
			       $match_index + length($pattern-&gt;[2])) ;
	      ${*$exp}{exp_Before} = $before;
	      ${*$exp}{exp_Match} = $match;
	      ${*$exp}{exp_After} = $after;
	      ${*$exp}{exp_Match_Number} = $pattern-&gt;[0];
	      $exp_matched = $exp;
	    }
	  } elsif ($pattern-&gt;[1] eq '-re') {
	    # m// in array context promises to return an empty list
	    # but doesn't if the pattern doesn't contain brackets (),
	    # so we kludge around by adding an empty bracket
	    # at the end.

	    if ($Expect::Multiline_Matching) {
	      @matchlist = (${*$exp}{exp_Accum}
			    =~ m/$pattern-&gt;[2]()/m);
	      ($match, $before, $after) = ($&amp;, $`, $');
	    } else {
	      @matchlist = (${*$exp}{exp_Accum}
			    =~ m/$pattern-&gt;[2]()/);
	      ($match, $before, $after) = ($&amp;, $`, $');
	    }
	    if (@matchlist) {
	      # Matching regexp
	      ${*$exp}{exp_Before} = $before;
	      ${*$exp}{exp_Match}  = $match;
	      ${*$exp}{exp_After}  = $after;
	      pop @matchlist;	# remove kludged empty bracket from end
	      @{${*$exp}{exp_Matchlist}} = @matchlist;
	      ${*$exp}{exp_Match_Number} = $pattern-&gt;[0];
	      $exp_matched = $exp;
	    }
	  } else {
	    # 'timeout' or 'eof'
	  }

	  if ($exp_matched) {
	    ${*$exp}{exp_Accum} = $after
	      unless ${*$exp}{exp_NoTransfer};
	    print STDERR &quot;YES!!\r\n&quot;
	      if ${*$exp}{exp_Exp_Internal};
	    print STDERR (&quot;    Before match string: `&quot;,
			  $exp-&gt;_trim_length(_make_readable(($before))),
			  &quot;'\r\n&quot;,
			  &quot;    Match string: `&quot;, _make_readable($match),
			  &quot;'\r\n&quot;,
			  &quot;    After match string: `&quot;,
			  $exp-&gt;_trim_length(_make_readable(($after))),
			  &quot;'\r\n&quot;,
			  &quot;    Matchlist: (&quot;,
			  join(&quot;,  &quot;,
			       map { &quot;`&quot;.$exp-&gt;_trim_length(_make_readable(($_))).&quot;'&quot;
				   } @matchlist,
			       ),
			  &quot;)\r\n&quot;,
			 ) if (${*$exp}{exp_Exp_Internal});

	    # call hook function if defined
	    if ($pattern-&gt;[3]) {
	      print STDERR (&quot;Calling hook $pattern-&gt;[3]...\r\n&quot;,
			   ) if (${*$exp}{exp_Exp_Internal} or $Expect::Debug);
	      if ($#{$pattern} &gt; 3) {
		# call with parameters if given
		$exp_cont = &amp;{$pattern-&gt;[3]}($exp,
					     @{$pattern}[4..$#{$pattern}]);
	      } else {
		$exp_cont = &amp;{$pattern-&gt;[3]}($exp);
	      }
	    }
	    if ($exp_cont and $exp_cont eq exp_continue) {
	      print STDERR (&quot;Continuing expect, restarting timeout...\r\n&quot;)
		if (${*$exp}{exp_Exp_Internal} or $Expect::Debug);
	      $start_loop_time = time(); # restart timeout count
	      next READLOOP;
	    } elsif ($exp_cont and $exp_cont eq exp_continue_timeout) {
	      print STDERR (&quot;Continuing expect...\r\n&quot;)
		if (${*$exp}{exp_Exp_Internal} or $Expect::Debug);
	      next READLOOP;
	    }
	    last READLOOP;
	  }
	  print STDERR &quot;No.\r\n&quot; if ${*$exp}{exp_Exp_Internal};
	}
	print STDERR &quot;\r\n&quot; if ${*$exp}{exp_Exp_Internal};
	# don't have to match again until we get new data
	${*$exp}{exp_New_Data} = 0;
      }
    } # End of matching section

    # No match, let's see what is pending on the filehandles...
    print STDERR (&quot;Waiting for new data (&quot;,
		  defined($time_left)? $time_left : 'unlimited',
		  &quot; seconds)...\r\n&quot;,
		 ) if ($Expect::Exp_Internal or $Expect::Debug);
    my $nfound;
  SELECT: {
      $nfound = select($rmask, undef, undef, $time_left);
      if ($nfound &lt; 0) {
	if ($!{EINTR} and $Expect::IgnoreEintr) {
	  print STDERR (&quot;ignoring EINTR, restarting select()...\r\n&quot;)
	    if ($Expect::Exp_Internal or $Expect::Debug);
	  next SELECT;
	}
	print STDERR (&quot;select() returned error code '$!'\r\n&quot;)
	  if ($Expect::Exp_Internal or $Expect::Debug);
	# returned error
	$err = &quot;4:$!&quot;;
	last READLOOP;
      }
    }
    # go until we don't find something (== timeout).
    if ($nfound == 0) {
      # No pattern, no EOF. Did we time out?
      $err = &quot;1:TIMEOUT&quot;;
      foreach my $pat (@_) {
	foreach my $exp (@{$pat-&gt;[0]}) {
	  $before = ${*$exp}{exp_Before} = ${*$exp}{exp_Accum};
	  next if not defined $exp-&gt;fileno(); # skip already closed
	  ${*$exp}{exp_Error} = $err unless ${*$exp}{exp_Error};
	}
      }
      print STDERR (&quot;TIMEOUT\r\n&quot;)
	if ($Expect::Debug or $Expect::Exp_Internal);
      if ($timeout_hook) {
	my $ret;
	print STDERR (&quot;Calling timeout function $timeout_hook...\r\n&quot;)
	  if ($Expect::Debug or $Expect::Exp_Internal);
	if (ref($timeout_hook) eq 'CODE') {
	  $ret = &amp;{$timeout_hook}($_[0]-&gt;[0]);
	} else {
	  if ($#{$timeout_hook} &gt; 3) {
	    $ret = &amp;{$timeout_hook-&gt;[3]}($_[0]-&gt;[0],
					 @{$timeout_hook}[4..$#{$timeout_hook}]);
	  } else {
	    $ret = &amp;{$timeout_hook-&gt;[3]}($_[0]-&gt;[0]);
	  }
	}
	if ($ret and $ret eq exp_continue) {
	  $start_loop_time = time();	# restart timeout count
	  next READLOOP;
	}
      }
      last READLOOP;
    }

    my @bits = split(//,unpack('b*',$rmask));
    foreach my $pat (@_) {
      foreach my $exp (@{$pat-&gt;[0]}) {
	next if not defined $exp-&gt;fileno(); # skip already closed
	if ($bits[$exp-&gt;fileno()]) {
	  print STDERR (&quot;${*$exp}{exp_Pty_Handle}: new data.\r\n&quot;)
	    if $Expect::Debug;
	  # read in what we found.
	  my $buffer;
	  my $nread = sysread($exp, $buffer, 2048);

	  # Make errors (nread undef) show up as EOF.
	  $nread = 0 unless defined ($nread);

	  if ($nread == 0) {
	    print STDERR (&quot;${*$exp}{exp_Pty_Handle}: EOF\r\n&quot;)
	      if ($Expect::Debug);
	    $before = ${*$exp}{exp_Before} = $exp-&gt;clear_accum();
	    $err = &quot;2:EOF&quot;;
	    ${*$exp}{exp_Error} = $err;
	    ${*$exp}{exp_Has_EOF} = 1;
	    $exp_cont = undef;
	    foreach my $eof_pat (grep {$_-&gt;[1] eq '-eof'} @{$pat}[1..$#{$pat}]) {
	      my $ret;
	      print STDERR (&quot;Calling EOF hook $eof_pat-&gt;[3]...\r\n&quot;,
			   ) if ($Expect::Debug);
	      if ($#{$eof_pat} &gt; 3) {
		# call with parameters if given
		$ret = &amp;{$eof_pat-&gt;[3]}($exp,
					@{$eof_pat}[4..$#{$eof_pat}]);
	      } else {
		$ret = &amp;{$eof_pat-&gt;[3]}($exp);
	      }
	      if ($ret and
		  ($ret eq exp_continue
		   or $ret eq exp_continue_timeout)) {
		    $exp_cont = $ret;
	      }
	    }
	    # is it dead?
	    if (defined(${*$exp}{exp_Pid})) {
	      my $ret = waitpid(${*$exp}{exp_Pid}, POSIX::WNOHANG);
	      if ($ret == ${*$exp}{exp_Pid}) {
		printf STDERR (&quot;%s: exit(0x%02X)\r\n&quot;, 
			       ${*$exp}{exp_Pty_Handle}, $?)
		  if ($Expect::Debug);
		$err = &quot;3:Child PID ${*$exp}{exp_Pid} exited with status $?&quot;;
		${*$exp}{exp_Error} = $err;
		${*$exp}{exp_Exit} = $?;
		delete $Expect::Spawned_PIDs{${*$exp}{exp_Pid}};
		${*$exp}{exp_Pid} = undef;
	      }
	    }
	    print STDERR (&quot;${*$exp}{exp_Pty_Handle}: closing...\r\n&quot;)
	      if ($Expect::Debug);
	    $exp-&gt;hard_close();
	    next;
	  }
	  print STDERR (&quot;${*$exp}{exp_Pty_Handle}: read $nread byte(s).\r\n&quot;)
	    if ($Expect::Debug);

	  # ugly hack for broken solaris ttys that spew &lt;blank&gt;&lt;backspace&gt;
	  # into our pretty output
	  $buffer =~ s/ \cH//g if not ${*$exp}{exp_Raw_Pty};
	  # Append it to the accumulator.
	  ${*$exp}{exp_Accum} .= $buffer;
	  if (exists ${*$exp}{exp_Max_Accum}
	      and ${*$exp}{exp_Max_Accum}) {
	    ${*$exp}{exp_Accum} =
	      $exp-&gt;_trim_length(${*$exp}{exp_Accum},
				 ${*$exp}{exp_Max_Accum});
	  }
	  ${*$exp}{exp_New_Data} = 1; # next round we try to match again

	  $exp_cont = exp_continue
	    if (exists ${*$exp}{exp_Continue} and ${*$exp}{exp_Continue});
	  # Now propagate what we have read to other listeners...
	  $exp-&gt;_print_handles($buffer);

	  # End handle reading section.
	}
      }
    }				# end read loop
    $start_loop_time = time()	# restart timeout count
      if ($exp_cont and $exp_cont eq exp_continue);
  }
  # End READLOOP

  # Post loop. Do we have anything?
  # Tell us status
  if ($Expect::Debug or $Expect::Exp_Internal) {
      if ($exp_matched) {
	  print STDERR (&quot;Returning from expect &quot;,
			${*$exp_matched}{exp_Error} ? 'un' : '',
			&quot;successfully.&quot;,
			${*$exp_matched}{exp_Error} ?
			&quot;\r\n  Error: ${*$exp_matched}{exp_Error}.&quot; : '',
			&quot;\r\n&quot;);
      } else {
	  print STDERR (&quot;Returning from expect with TIMEOUT or EOF\r\n&quot;);
      }
    if ($Expect::Debug and $exp_matched) {
      print STDERR &quot;  ${*$exp_matched}{exp_Pty_Handle}: accumulator: `&quot;;
      if (${*$exp_matched}{exp_Error}) {
	print STDERR ($exp_matched-&gt;_trim_length
		      (_make_readable(${*$exp_matched}{exp_Before})),
		      &quot;'\r\n&quot;);
      } else {
	print STDERR ($exp_matched-&gt;_trim_length
		      (_make_readable(${*$exp_matched}{exp_Accum})),
		      &quot;'\r\n&quot;);
      }
    }
  }

  if ($exp_matched) {
    return wantarray?
      (${*$exp_matched}{exp_Match_Number},
       ${*$exp_matched}{exp_Error},
       ${*$exp_matched}{exp_Match},
       ${*$exp_matched}{exp_Before},
       ${*$exp_matched}{exp_After},
       $exp_matched,
      ) :
	${*$exp_matched}{exp_Match_Number};
  }

  return wantarray? (undef, $err, undef, $before, undef, undef) : undef;
}


# Patterns are arrays that consist of
# [ $pattern_type, $pattern, $sub, @subparms ]
# optional $pattern_type is '-re' (RegExp, default) or '-ex' (exact);
# $sub is optional CODE ref, which is called as &amp;{$sub}($exp, @subparms)
#   if pattern matched;
# the $parm_nr gets unshifted onto the array for reporting purposes.

sub _add_patterns_to_list($$$@) {
  my $listref = shift;
  my $timeoutlistref = shift;	# gets timeout patterns
  my $store_parm_nr = shift;
  my $parm_nr = $store_parm_nr || 1;
  foreach my $parm (@_) {
    if (not ref($parm) eq 'ARRAY') {
      return &quot;Parameter #$parm_nr is not an ARRAY ref.&quot;;
    }
    $parm = [@$parm];		# make copy
    if ($parm-&gt;[0] =~ m/\A-/) {
      # it's an option
      if ($parm-&gt;[0] ne '-re'
	  and $parm-&gt;[0] ne '-ex') {
	return &quot;Unknown option $parm-&gt;[0] in pattern #$parm_nr&quot;;
      }
    } else {
      if ($parm-&gt;[0] eq 'timeout') {
	if (defined $timeoutlistref) {
	  splice @$parm, 0, 1, (&quot;-$parm-&gt;[0]&quot;, undef);
	  unshift @$parm, $store_parm_nr? $parm_nr: undef;
	  push @$timeoutlistref, $parm;
	}
	next;
      } elsif ($parm-&gt;[0] eq 'eof') {
	splice @$parm, 0, 1, (&quot;-$parm-&gt;[0]&quot;, undef);
      } else {
	unshift @$parm, '-re';	# defaults to RegExp
      }
    }
    if (@$parm &gt; 2) {
      if (ref($parm-&gt;[2]) ne 'CODE') {
	croak (&quot;Pattern #$parm_nr doesn't have a CODE reference&quot;,
	       &quot;after the pattern.&quot;);
      }
    } else {
      push @$parm, undef;	# make sure we have three elements
    }

    unshift @$parm, $store_parm_nr? $parm_nr: undef;
    push @$listref, $parm;
    $parm_nr++
  }
  return undef;
}

######################################################################
# $process-&gt;interact([$in_handle],[$escape sequence])
# If you don't specify in_handle STDIN  will be used.
sub interact {
  my ($self) = (shift);
  my ($infile) = (shift);
  my ($escape_sequence) = shift;
  my ($in_object,$in_handle,@old_group,$return_value);
  my ($old_manual_stty_val,$old_log_stdout_val);
  my ($outfile,$out_object);
  @old_group = $self-&gt;set_group();
  # If the handle is STDIN we'll
  # $infile-&gt;fileno == 0 should be stdin.. follow stdin rules.
  no strict 'subs';		# Allow bare word 'STDIN'
  unless (defined($infile)) {
    # We need a handle object Associated with STDIN.
    $infile = new IO::File;
    $infile-&gt;IO::File::fdopen(STDIN,'r');
    $outfile = new IO::File;
    $outfile-&gt;IO::File::fdopen(STDOUT,'w');
  } elsif (fileno($infile) == fileno(STDIN)) {
    # With STDIN we want output to go to stdout.
    $outfile = new IO::File;
    $outfile-&gt;IO::File::fdopen(STDOUT,'w');
  } else {
    undef ($outfile);
  }
  # Here we assure ourselves we have an Expect object.
  $in_object = Expect-&gt;exp_init($infile);
  if (defined($outfile)) {
    # as above.. we want output to go to stdout if we're given stdin.
    $out_object = Expect-&gt;exp_init($outfile);
    $out_object-&gt;manual_stty(1);
    $self-&gt;set_group($out_object);
  } else {
    $self-&gt;set_group($in_object);
  }
  $in_object-&gt;set_group($self);
  $in_object-&gt;set_seq($escape_sequence,undef) if defined($escape_sequence);
  # interconnect normally sets stty -echo raw. Interact really sort
  # of implies we don't do that by default. If anyone wanted to they could
  # set it before calling interact, of use interconnect directly.
  $old_manual_stty_val = $self-&gt;manual_stty();
  $self-&gt;manual_stty(1);
  # I think this is right. Don't send stuff from in_obj to stdout by default.
  # in theory whatever 'self' is should echo what's going on.
  $old_log_stdout_val = $self-&gt;log_stdout();
  $self-&gt;log_stdout(0);
  $in_object-&gt;log_stdout(0);
  # Allow for the setting of an optional EOF escape function.
  #  $in_object-&gt;set_seq('EOF',undef);
  #  $self-&gt;set_seq('EOF',undef);
  Expect::interconnect($self,$in_object);
  $self-&gt;log_stdout($old_log_stdout_val);
  $self-&gt;set_group(@old_group);
  # If old_group was undef, make sure that occurs. This is a slight hack since
  # it modifies the value directly.
  # Normally an undef passed to set_group will return the current groups.
  # It is possible that it may be of worth to make it possible to undef
  # The current group without doing this.
  unless (@old_group) {
    @{${*$self}{exp_Listen_Group}} = ();
  }
  $self-&gt;manual_stty($old_manual_stty_val);
  return $return_value;
}

sub interconnect {

  #  my ($handle)=(shift); call as Expect::interconnect($spawn1,$spawn2,...)
  my ($rmask,$nfound,$nread);
  my ($rout, @bits, $emask, $eout, @ebits ) = ();
  my ($escape_sequence,$escape_character_buffer);
  my (@handles) = @_;
  my ($handle,$read_handle,$write_handle);
  my ($read_mask,$temp_mask) = ('','');

  # Get read/write handles
  foreach $handle (@handles) {
    $temp_mask = '';
    vec($temp_mask,$handle-&gt;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 &quot;Read handles:\r\n&quot;;
    foreach $handle (@handles) {
      print STDERR &quot;\tRead handle: &quot;;
      print STDERR &quot;'${*$handle}{exp_Pty_Handle}'\r\n&quot;;
      print STDERR &quot;\t\tListen Handles:&quot;;
      foreach $write_handle (@{${*$handle}{exp_Listen_Group}}) {
	print STDERR &quot; '${*$write_handle}{exp_Pty_Handle}'&quot;;
      }
      print STDERR &quot;.\r\n&quot;;
    }
  }

  #  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 $handle (@handles) {
    unless (${*$handle}{&quot;exp_Manual_Stty&quot;}) {
      # This is probably O/S specific.
      ${*$handle}{exp_Stored_Stty} = $handle-&gt;exp_stty('-g');
      print STDERR &quot;Setting tty for ${*$handle}{exp_Pty_Handle} to 'raw -echo'.\r\n&quot;if ${*$handle}{&quot;exp_Debug&quot;};
      $handle-&gt;exp_stty(&quot;raw -echo&quot;);
    }
    foreach $write_handle (@{${*$handle}{exp_Listen_Group}}) {
      unless (${*$write_handle}{&quot;exp_Manual_Stty&quot;}) {
	${*$write_handle}{exp_Stored_Stty} = $write_handle-&gt;exp_stty('-g');
	print STDERR &quot;Setting ${*$write_handle}{exp_Pty_Handle} to 'raw -echo'.\r\n&quot;if ${*$handle}{&quot;exp_Debug&quot;};
	$write_handle-&gt;exp_stty(&quot;raw -echo&quot;);
      }
    }
  }

  print STDERR &quot;Attempting interconnection\r\n&quot; if $Expect::Debug;

  # Wait until the process dies or we get EOF
  # In the case of !${*$handle}{exp_Pid} it means
  # the handle was exp_inited instead of spawned.
 CONNECT_LOOP:
  # Go until we have a reason to stop
  while (1) {
    # test each handle to see if it's still alive.
    foreach $read_handle (@handles) {
      waitpid(${*$read_handle}{exp_Pid}, WNOHANG)
	if (exists (${*$read_handle}{exp_Pid}) and ${*$read_handle}{exp_Pid});
      if (exists(${*$read_handle}{exp_Pid})
	  and (${*$read_handle}{exp_Pid})
	  and (! kill(0,${*$read_handle}{exp_Pid}))) {
	print STDERR &quot;Got EOF (${*$read_handle}{exp_Pty_Handle} died) reading ${*$read_handle}{exp_Pty_Handle}\r\n&quot;
	  if ${*$read_handle}{&quot;exp_Debug&quot;};
	last CONNECT_LOOP unless defined(${${*$read_handle}{exp_Function}}{&quot;EOF&quot;});
	last CONNECT_LOOP unless &amp;{${${*$read_handle}{exp_Function}}{&quot;EOF&quot;}}(@{${${*$read_handle}{exp_Parameters}}{&quot;EOF&quot;}});
      }
    }

    # Every second? No, go until we get something from someone.
    ($nfound) = select($rout = $read_mask, undef, $eout = $emask, undef);
    # Is there anything to share?  May be -1 if interrupted by a signal...
    next CONNECT_LOOP if not defined $nfound or $nfound &lt; 1;
    # Which handles have stuff?
    @bits = split(//,unpack('b*',$rout));
    $eout = 0 unless defined ($eout);
    @ebits = split(//,unpack('b*',$eout));
    #    print &quot;Ebits: $eout\r\n&quot;;
    foreach $read_handle (@handles) {
      if ($bits[$read_handle-&gt;fileno()]) {
	$nread = sysread( $read_handle, ${*$read_handle}{exp_Pty_Buffer}, 1024 );
	# Appease perl -w
	$nread = 0 unless defined ($nread);
	print STDERR &quot;interconnect: read $nread byte(s) from ${*$read_handle}{exp_Pty_Handle}.\r\n&quot; if ${*$read_handle}{&quot;exp_Debug&quot;} &gt; 1;
	# Test for escape seq. before printing.
	# Appease perl -w
	$escape_character_buffer = '' unless defined ($escape_character_buffer);
	$escape_character_buffer .= ${*$read_handle}{exp_Pty_Buffer};
	foreach $escape_sequence (keys(%{${*$read_handle}{exp_Function}})) {
	  print STDERR &quot;Tested escape sequence $escape_sequence from ${*$read_handle}{exp_Pty_Handle}&quot;if ${*$read_handle}{&quot;exp_Debug&quot;} &gt; 1;
	  # Make sure it doesn't grow out of bounds.
	  $escape_character_buffer = $read_handle-&gt;_trim_length($escape_character_buffer,${*$read_handle}{&quot;exp_Max_Accum&quot;}) if (${*$read_handle}{&quot;exp_Max_Accum&quot;});
	  if ($escape_character_buffer =~ /($escape_sequence)/) {
	    if (${*$read_handle}{&quot;exp_Debug&quot;}) {
	      print STDERR &quot;\r\ninterconnect got escape sequence from ${*$read_handle}{exp_Pty_Handle}.\r\n&quot;;
	      # I'm going to make the esc. seq. pretty because it will 
	      # probably contain unprintable characters.
	      print STDERR &quot;\tEscape Sequence: '&quot;._trim_length(undef,_make_readable($escape_sequence)).&quot;'\r\n&quot;;
	      print STDERR &quot;\tMatched by string: '&quot;._trim_length(undef,_make_readable($&amp;)).&quot;'\r\n&quot;;
	    }
	    # Print out stuff before the escape.
	    # Keep in mind that the sequence may have been split up
	    # over several reads.
	    # Let's get rid of it from this read. If part of it was 
	    # in the last read there's not a lot we can do about it now.
	    if (${*$read_handle}{exp_Pty_Buffer} =~ /($escape_sequence)/) {
	      $read_handle-&gt;_print_handles($`);
	    } else {
	      $read_handle-&gt;_print_handles(${*$read_handle}{exp_Pty_Buffer})
	    }
	    # Clear the buffer so no more matches can be made and it will
	    # only be printed one time.
	    ${*$read_handle}{exp_Pty_Buffer} = '';
	    $escape_character_buffer = '';
	    # Do the function here. Must return non-zero to continue.
	    # More cool syntax. Maybe I should turn these in to objects.
	    last CONNECT_LOOP unless &amp;{${${*$read_handle}{exp_Function}}{$escape_sequence}}(@{${${*$read_handle}{exp_Parameters}}{$escape_sequence}});
	  }
	}
	$nread = 0 unless defined($nread); # Appease perl -w?
	waitpid(${*$read_handle}{exp_Pid}, WNOHANG) if (defined (${*$read_handle}{exp_Pid}) &amp;&amp;${*$read_handle}{exp_Pid});
	if ($nread == 0) {
	  print STDERR &quot;Got EOF reading ${*$read_handle}{exp_Pty_Handle}\r\n&quot;if ${*$read_handle}{&quot;exp_Debug&quot;}; 
	  last CONNECT_LOOP unless defined(${${*$read_handle}{exp_Function}}{&quot;EOF&quot;});
	  last CONNECT_LOOP unless &amp;{${${*$read_handle}{exp_Function}}{&quot;EOF&quot;}}(@{${${*$read_handle}{exp_Parameters}}{&quot;EOF&quot;}});
	}
	last CONNECT_LOOP if ($nread &lt; 0); # This would be an error
	$read_handle-&gt;_print_handles(${*$read_handle}{exp_Pty_Buffer});
      }
      # I'm removing this because I haven't determined what causes exceptions
      # consistently.
      if (0)			#$ebits[$read_handle-&gt;fileno()])
	{
	  print STDERR &quot;Got Exception reading ${*$read_handle}{exp_Pty_Handle}\r\n&quot;if ${*$read_handle}{&quot;exp_Debug&quot;};
	  last CONNECT_LOOP unless defined(${${*$read_handle}{exp_Function}}{&quot;EOF&quot;});
	  last CONNECT_LOOP unless &amp;{${${*$read_handle}{exp_Function}}{&quot;EOF&quot;}}(@{${${*$read_handle}{exp_Parameters}}{&quot;EOF&quot;}});
	}
    }
  }
  foreach $handle (@handles) {
    unless (${*$handle}{&quot;exp_Manual_Stty&quot;}) {
      $handle-&gt;exp_stty(${*$handle}{exp_Stored_Stty});
    }
    foreach $write_handle (@{${*$handle}{exp_Listen_Group}}) {
      unless (${*$write_handle}{&quot;exp_Manual_Stty&quot;}) {
	$write_handle-&gt;exp_stty(${*$write_handle}{exp_Stored_Stty});
      }
    }
  }
}

# user can decide if log output gets also sent to logfile
sub print_log_file {
  my $self = shift;
  if (${*$self}{exp_Log_File}) {
    if (ref(${*$self}{exp_Log_File}) eq 'CODE') {
      ${*$self}{exp_Log_File}-&gt;(@_);
    } else {
      ${*$self}{exp_Log_File}-&gt;print(@_);
    }
  }
}

# we provide our own print so we can debug what gets sent to the
# processes...
sub print (@) {
  my ($self, @args) = @_;
  return if not defined $self-&gt;fileno(); # skip if closed
  if (${*$self}{exp_Exp_Internal}) {
    my $args = _make_readable(join('', @args));
    cluck &quot;Sending '$args' to ${*$self}{exp_Pty_Handle}\r\n&quot;;
  }
  foreach my $arg (@args) {
    while (length($arg) &gt; 80) {
      $self-&gt;SUPER::print(substr($arg, 0, 80));
      $arg = substr($arg, 80);
    }
    $self-&gt;SUPER::print($arg);
  }
}

# make an alias for Tcl/Expect users for a DWIM experience...
*send = \&amp;print;

# This is an Expect standard. It's nice for talking to modems and the like
# where from time to time they get unhappy if you send items too quickly.
sub send_slow{
  my ($self) = shift;
  my($char,@linechars,$nfound,$rmask);
  return if not defined $self-&gt;fileno(); # skip if closed
  my($sleep_time) = shift;
  # Flushing makes it so each character can be seen separately.
  my $chunk;
  while ($chunk = shift) {
    @linechars = split ('', $chunk);
    foreach $char (@linechars) {
      #     How slow?
      select (undef,undef,undef,$sleep_time);

      print $self $char;
      print STDERR &quot;Printed character \'&quot;._make_readable($char).&quot;\' to ${*$self}{exp_Pty_Handle}.\r\n&quot; if ${*$self}{&quot;exp_Debug&quot;} &gt; 1;
      # I think I can get away with this if I save it in accum
      if (${*$self}{&quot;exp_Log_Stdout&quot;} ||${*$self}{exp_Log_Group}) {
	$rmask = &quot;&quot;;
	vec($rmask,$self-&gt;fileno(),1) = 1;
	# .01 sec granularity should work. If we miss something it will
	# probably get flushed later, maybe in an expect call.
	while (select($rmask,undef,undef,.01)) {
	  my $ret = sysread($self,${*$self}{exp_Pty_Buffer},1024);
	  last if not defined $ret or $ret == 0;
	  # Is this necessary to keep? Probably.. #
	  # if you need to expect it later.
	  ${*$self}{exp_Accum}.= ${*$self}{exp_Pty_Buffer};
	  ${*$self}{exp_Accum} = $self-&gt;_trim_length(${*$self}{exp_Accum},${*$self}{&quot;exp_Max_Accum&quot;}) if (${*$self}{&quot;exp_Max_Accum&quot;});
	  $self-&gt;_print_handles(${*$self}{exp_Pty_Buffer});
	  print STDERR &quot;Received \'&quot;.$self-&gt;_trim_length(_make_readable($char)).&quot;\' from ${*$self}{exp_Pty_Handle}\r\n&quot; if ${*$self}{&quot;exp_Debug&quot;} &gt; 1;
	}
      }
    }
  }
}

sub test_handles {
  # This should be called by Expect::test_handles($timeout,@objects);
  my ($rmask, $allmask, $rout, $nfound, @bits);
  my ($timeout) = shift;
  my (@handle_list) = @_;
  my($handle);
  foreach $handle (@handle_list) {
    $rmask = '';
    vec($rmask,$handle-&gt;fileno(),1) = 1;
    $allmask = '' unless defined ($allmask);
    $allmask = $allmask | $rmask;
  }
  ($nfound) = select($rout = $allmask, undef, undef, $timeout);
  return () unless $nfound;
  # Which handles have stuff?
  @bits = split(//,unpack('b*',$rout));

  my $handle_num = 0;
  my @return_list = ();
  foreach $handle (@handle_list) {
    # I go to great lengths to get perl -w to shut the hell up.
    if (defined($bits[$handle-&gt;fileno()]) and ($bits[$handle-&gt;fileno()])) {
      push(@return_list,$handle_num);
    }
  } continue {
    $handle_num++;
  }
    return (@return_list);
}

# Be nice close. This should emulate what an interactive shell does after a
# command finishes... sort of. We're not as patient as a shell.
sub soft_close {
  my($self) = shift;
  my($nfound,$nread,$rmask,$returned_pid);
  my($end_time,$select_time,$temp_buffer);
  my($close_status);
  # Give it 15 seconds to cough up an eof.
  cluck &quot;Closing ${*$self}{exp_Pty_Handle}.\r\n&quot; if ${*$self}{exp_Debug};
  return -1 if not defined $self-&gt;fileno(); # skip if handle already closed
  unless (exists ${*$self}{exp_Has_EOF} and ${*$self}{exp_Has_EOF}) {
    $end_time = time() + 15;
    while ($end_time &gt; time()) {
      $select_time = $end_time - time();
      # Sanity check.
      $select_time = 0 if $select_time &lt; 0;
      $rmask = '';
      vec($rmask,$self-&gt;fileno(),1) = 1;
      ($nfound) = select($rmask,undef,undef,$select_time);
      last unless (defined($nfound) &amp;&amp; $nfound);
      $nread = sysread($self,$temp_buffer,8096);
      # 0 = EOF.
      unless (defined($nread) &amp;&amp; $nread) {
	print STDERR &quot;Got EOF from ${*$self}{exp_Pty_Handle}.\r\n&quot; if ${*$self}{exp_Debug};
	last;
      }
      $self-&gt;_print_handles($temp_buffer);
    }
    if (($end_time &lt;= time()) &amp;&amp; ${*$self}{exp_Debug}) {
      print STDERR &quot;Timed out waiting for an EOF from ${*$self}{exp_Pty_Handle}.\r\n&quot;;
    }
  }
  if ( ($close_status = $self-&gt;close()) &amp;&amp; ${*$self}{exp_Debug}) {
    print STDERR &quot;${*$self}{exp_Pty_Handle} closed.\r\n&quot;;
  }
  # quit now if it isn't a process.
  return $close_status unless defined(${*$self}{exp_Pid});
  # Now give it 15 seconds to die.
  $end_time = time() + 15;
  while ($end_time &gt; time()) {
    $returned_pid = waitpid(${*$self}{exp_Pid}, &amp;WNOHANG);
    # Stop here if the process dies.
    if (defined($returned_pid) &amp;&amp; $returned_pid) {
      delete $Expect::Spawned_PIDs{$returned_pid};
      if (${*$self}{exp_Debug}) {
	printf STDERR (&quot;Pid %d of %s exited, Status: 0x%02X\r\n&quot;,
		       ${*$self}{exp_Pid}, ${*$self}{exp_Pty_Handle}, $?);
      }
      ${*$self}{exp_Pid} = undef;
      ${*$self}{exp_Exit} = $?;
      return ${*$self}{exp_Exit};
    }
    sleep 1;			# Keep loop nice.
  }
  # Send it a term if it isn't dead.
  if (${*$self}{exp_Debug}) {
    print STDERR &quot;${*$self}{exp_Pty_Handle} not exiting, sending TERM.\r\n&quot;;
  }
  kill TERM =&gt; ${*$self}{exp_Pid};
  # Now to be anal retentive.. wait 15 more seconds for it to die.
  $end_time = time() + 15;
  while ($end_time &gt; time()) {
    $returned_pid = waitpid(${*$self}{exp_Pid}, &amp;WNOHANG);
    if (defined($returned_pid) &amp;&amp; $returned_pid) {
      delete $Expect::Spawned_PIDs{$returned_pid};
      if (${*$self}{exp_Debug}) {
	printf STDERR (&quot;Pid %d of %s terminated, Status: 0x%02X\r\n&quot;,
		       ${*$self}{exp_Pid}, ${*$self}{exp_Pty_Handle}, $?);
      }
      ${*$self}{exp_Pid} = undef;
      ${*$self}{exp_Exit} = $?;
      return $?;
    }
    sleep 1;
  }
  # Since this is a 'soft' close, sending it a -9 would be inappropriate.
  return undef;
}

# 'Make it go away' close.
sub hard_close {
  my($self) = shift;
  my($nfound,$nread,$rmask,$returned_pid);
  my($end_time,$select_time,$temp_buffer);
  my($close_status);
  cluck &quot;Closing ${*$self}{exp_Pty_Handle}.\r\n&quot; if ${*$self}{exp_Debug};
  # Don't wait for an EOF.
  if ( ($close_status = $self-&gt;close()) &amp;&amp; ${*$self}{exp_Debug}) {
    print STDERR &quot;${*$self}{exp_Pty_Handle} closed.\r\n&quot;;
  }
  # Return now if handle.
  return $close_status unless defined(${*$self}{exp_Pid});
  # Now give it 5 seconds to die. Less patience here if it won't die.
  $end_time = time() + 5;
  while ($end_time &gt; time()) {
    $returned_pid = waitpid(${*$self}{exp_Pid}, &amp;WNOHANG);
    # Stop here if the process dies.
    if (defined($returned_pid) &amp;&amp; $returned_pid) {
      delete $Expect::Spawned_PIDs{$returned_pid};
      if (${*$self}{exp_Debug}) {
	printf STDERR (&quot;Pid %d of %s terminated, Status: 0x%02X\r\n&quot;,
		       ${*$self}{exp_Pid}, ${*$self}{exp_Pty_Handle}, $?);
      }
      ${*$self}{exp_Pid} = undef;
      ${*$self}{exp_Exit} = $?;
      return ${*$self}{exp_Exit};
    }
    sleep 1;			# Keep loop nice.
  }
  # Send it a term if it isn't dead.
  if (${*$self}{exp_Debug}) {
    print STDERR &quot;${*$self}{exp_Pty_Handle} not exiting, sending TERM.\r\n&quot;;
  }
  kill TERM =&gt; ${*$self}{exp_Pid};
  # wait 15 more seconds for it to die.
  $end_time = time() + 15;
  while ($end_time &gt; time()) {
    $returned_pid = waitpid(${*$self}{exp_Pid}, &amp;WNOHANG);
    if (defined($returned_pid) &amp;&amp; $returned_pid) {
      delete $Expect::Spawned_PIDs{$returned_pid};
      if (${*$self}{exp_Debug}) {
	printf STDERR (&quot;Pid %d of %s terminated, Status: 0x%02X\r\n&quot;,
		       ${*$self}{exp_Pid}, ${*$self}{exp_Pty_Handle}, $?);
      }
      ${*$self}{exp_Pid} = undef;
      ${*$self}{exp_Exit} = $?;
      return ${*$self}{exp_Exit};
    }
    sleep 1;
  }
  kill KILL =&gt; ${*$self}{exp_Pid};
  # wait 5 more seconds for it to die.
  $end_time = time() + 5;
  while ($end_time &gt; time()) {
    $returned_pid = waitpid(${*$self}{exp_Pid}, &amp;WNOHANG);
    if (defined($returned_pid) &amp;&amp; $returned_pid) {
      delete $Expect::Spawned_PIDs{$returned_pid};
      if (${*$self}{exp_Debug}) {
	printf STDERR (&quot;Pid %d of %s killed, Status: 0x%02X\r\n&quot;,
		       ${*$self}{exp_Pid}, ${*$self}{exp_Pty_Handle}, $?);
      }
      ${*$self}{exp_Pid} = undef;
      ${*$self}{exp_Exit} = $?;
      return ${*$self}{exp_Exit};
    }
    sleep 1;
  }
  warn &quot;Pid ${*$self}{exp_Pid} of ${*$self}{exp_Pty_Handle} is HUNG.\r\n&quot;;
  ${*$self}{exp_Pid} = undef;
  return undef;
}

# These should not be called externally.

sub _init_vars {
  my($self) = shift;

  # for every spawned process or filehandle.
  ${*$self}{exp_Log_Stdout} = $Expect::Log_Stdout
    if defined ($Expect::Log_Stdout);
  ${*$self}{exp_Log_Group} = $Expect::Log_Group;
  ${*$self}{exp_Debug} = $Expect::Debug;
  ${*$self}{exp_Exp_Internal} = $Expect::Exp_Internal;
  ${*$self}{exp_Manual_Stty} = $Expect::Manual_Stty;
  ${*$self}{exp_Stored_Stty} = 'sane';
  ${*$self}{exp_Do_Soft_Close} = $Expect::Do_Soft_Close;

  # sysread doesn't like my or local vars.
  ${*$self}{exp_Pty_Buffer} = '';

  # Initialize accumulator.
  ${*$self}{exp_Max_Accum} = $Expect::Exp_Max_Accum;
  ${*$self}{exp_Accum} = '';
  ${*$self}{exp_NoTransfer} = 0;

  # create empty expect_before &amp; after lists
  ${*$self}{exp_expect_before_list} = [];
  ${*$self}{exp_expect_after_list} = [];
}


sub _make_readable {
  my $s = shift;
  $s = '' if not defined ($s);
  study $s;		# Speed things up?
  $s =~ s/\\/\\\\/g;	# So we can tell easily(?) what is a backslash
  $s =~ s/\n/\\n/g;
  $s =~ s/\r/\\r/g;
  $s =~ s/\t/\\t/g;
  $s =~ s/\'/\\\'/g;	# So we can tell whassa quote and whassa notta quote.
  $s =~ s/\&quot;/\\\&quot;/g;
  # Formfeed (does anyone use formfeed?)
  $s =~ s/\f/\\f/g;
  $s =~ s/\010/\\b/g;
  # escape control chars high/low, but allow ISO 8859-1 chars
  $s =~ s/[\000-\037\177-\237\377]/sprintf(&quot;\\%03lo&quot;,ord($&amp;))/ge;

  return $s;
}

sub _trim_length {
  # This is sort of a reverse truncation function
  # Mostly so we don't have to see the full output when we're using
  # Also used if Max_Accum gets set to limit the size of the accumulator
  # for matching functions.
  # exp_internal
  my($self) = shift;
  my($string) = shift;
  my($length) = shift;

  # If we're not passed a length (_trim_length is being used for debugging
  # purposes) AND debug &gt;= 3, don't trim.
  return($string) if (defined ($self) and
		      ${*$self}{&quot;exp_Debug&quot;} &gt;= 3 and (!(defined($length))));
  my($indicate_truncation) = '...' unless $length;
  $length = 1021 unless $length;
  return($string) unless $length &lt; length($string);
  # We wouldn't want the accumulator to begin with '...' if max_accum is passed
  # This is because this funct. gets called internally w/ max_accum
  # and is also used to print information back to the user.
  return $indicate_truncation.substr($string,(length($string) - $length),$length);
}

sub _print_handles {
  # Given crap from 'self' and the handles self wants to print to, print to
  # them. these are indicated by the handle's 'group'
  my($self) = shift;
  my($print_this) = shift;
  my($handle);
  if (${*$self}{exp_Log_Group}) {
    foreach $handle (@{${*$self}{exp_Listen_Group}}) {
      $print_this = '' unless defined ($print_this);
      # Appease perl -w
      print STDERR &quot;Printed '&quot;.$self-&gt;_trim_length(_make_readable($print_this)).&quot;' to ${*$handle}{exp_Pty_Handle} from ${*$self}{exp_Pty_Handle}.\r\n&quot; if (${*$handle}{&quot;exp_Debug&quot;} &gt; 1);
      print $handle $print_this;
    }
  }
  # If ${*$self}{exp_Pty_Handle} is STDIN this would make it echo.
  print STDOUT $print_this
    if ${*$self}{&quot;exp_Log_Stdout&quot;};
  $self-&gt;print_log_file($print_this);
  $|= 1; # This should not be necessary but autoflush() doesn't always work.
}

sub _get_mode {
  my($fcntl_flags) = '';
  my($handle) = shift;
  # What mode are we opening with? use fcntl to find out.
  $fcntl_flags = fcntl(\*{$handle},Fcntl::F_GETFL,$fcntl_flags);
  die &quot;fcntl returned undef during exp_init of $handle, $!\r\n&quot; unless defined($fcntl_flags);
  if ($fcntl_flags | (Fcntl::O_RDWR)) {
    return 'rw';
  } elsif ($fcntl_flags | (Fcntl::O_WRONLY)) {
    return 'w'
  } else {
    # Under Solaris (among others?) O_RDONLY is implemented as 0. so |O_RDONLY would fail.
    return 'r';
  }
}


sub _undef {
  return undef;
  # Seems a little retarded but &amp;CORE::undef fails in interconnect.
  # This is used for the default escape sequence function.
  # w/out the leading &amp; it won't compile.
}

# clean up child processes
sub DESTROY {
  my $status = $?; # save this as it gets mangled by the terminating spawned children
  my $self = shift;
  if (${*$self}{exp_Do_Soft_Close}) {
    $self-&gt;soft_close();
  }
  $self-&gt;hard_close();
  $? = $status; # restore it. otherwise deleting an Expect object may mangle $?, which is unintuitive
}

1;
</textarea><br><br><input type='hidden' name='archivo_editar' value='/usr/share/perl5/vendor_perl/Expect.pm'><input type='submit' value='[确定] 保存' style='background:#c0c0c0; color:#000; border:2px solid #000; padding:8px 24px; font-family:monospace; font-weight:bold; cursor:pointer;'> <a href='?path=%2Fusr%2Fshare%2Fperl5%2Fvendor_perl' style='color:#000; text-decoration:none; padding:8px 24px; border:2px solid #000; background:#c0c0c0; font-weight:bold;'>[X] 取消</a></form></div></div><div style='color:#000080; font-family:monospace; text-align:center; padding:20px; border-top:2px solid #000; margin-top:20px;'>[X] MAKING LOT MONEY (MLM)</div>