view release on metacpan or  search on metacpan

lib/Expect.pm  view on Meta::CPAN

package Expect;
use strict;
use warnings;

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

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   qw(import);
use Errno;
use Scalar::Util qw/ looks_like_number /;

# This is necessary to make routines within Expect work.

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

BEGIN {
	$Expect::VERSION = '1.38';

	# 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) = @_;

	warn "Version $version is later than $Expect::VERSION. It may not be supported"
		if ( defined($version) && ( $version > $Expect::VERSION ) );

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

sub new {
	my ($class, @args) = @_;

	$class = ref($class) if ref($class); # so we can be called as $exp->new()

	# Create the pty which we will use to pass process info.
	my ($self) = IO::Pty->new;
	die "$class: Could not assign a pty" unless $self;
	bless $self => $class;
	$self->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->_init_vars();

	if (@args) {

		# we got add'l parms, so pass them to spawn
		return $self->spawn(@args);
	}
	return $self;
}

sub timeout {
    my $self = shift;
    ${*$self}{expect_timeout} = shift if @_;
    return ${*$self}{expect_timeout};
}

sub spawn {
	my ($class, @cmd) = @_;
	# spawn is passed command line args.

	my $self;

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

	croak "Cannot reuse an object with an already spawned command"
		if exists ${*$self}{"exp_Command"};
	${*$self}{"exp_Command"} = \@cmd;

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

	my $pid = fork;

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

	if ($pid) {

		# parent
		my $errno;
		${*$self}{exp_Pid} = $pid;
		close TO_PARENT;
		close FROM_PARENT;
		$self->close_slave();
		$self->set_raw() if $self->raw_pty and isatty($self);