File Coverage

blib/lib/Control/CLI.pm

Criterion	Covered	Total	%
statement	81	1556	5.2
branch	43	1244	3.4
condition	4	288	1.3
subroutine	17	118	14.4
pod	92	92	100.0
total	237	3298	7.1

package Control::CLI;

use strict;
use warnings;
use Exporter qw( import );
use Carp;
use Term::ReadKey;
use Time::HiRes qw( time sleep );
use IO::Handle;
use IO::Socket::INET;
use Errno qw( EINPROGRESS EWOULDBLOCK );

my $Package = __PACKAGE__;
our $VERSION = '2.10';
our %EXPORT_TAGS = (
		use	=> [qw(useTelnet useSsh useSerial useIPv6)],
		prompt	=> [qw(promptClear promptHide promptCredential)],
		args	=> [qw(parseMethodArgs suppressMethodArgs)],
		coderef	=> [qw(validCodeRef callCodeRef)],
		_rest	=> [qw(passphraseRequired parse_errmode stripLastLine poll)],
	);
push @{$EXPORT_TAGS{all}}, @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS;
Exporter::export_ok_tags('all');

########################################### Global Class Variables ###########################################

my $PollTimer = 100;		# Some connection types require a polling loop; this is the loop sleep timer in ms
my $ComPortReadBuffer = 4096;	# Size of serial port read buffers
my $ComReadInterval = 100;	# Timeout between single character reads
my $ComBreakDuration = 300;	# Number of milliseconds the break signal is held for
my $ChangeBaudDelay = 100;	# Number of milliseconds to sleep between tearing down and restarting serial port connection
my $VT100_QueryDeviceStatus	= "\e[5n";	# With report_query_status, if received from host
my $VT100_ReportDeviceOk	= "\e[0n";	# .. sent to host, with report_query_status

my %Default = ( # Hash of default object settings which can be modified on a per object basis
	timeout			=> 10,			# Default Timeout value in secs
	connection_timeout	=> undef,		# Default Connection Timeout value in secs
	connection_timeout_nb	=> 20,			# If above is undefined, still need to set a value for connections in non-blocking mode
	blocking		=> 1,			# Default blocking mode
	return_reference	=> 0,			# Whether methods return data (0) or hard referece to it (1)
	read_attempts		=> 5,			# Empty reads to wait in readwait() before returning
	readwait_timer		=> 100,			# Polling loop timer for readwait() in millisecs, for further input
	data_with_error		=> 0,			# Readwait() behaviour in case of read error following some data read
	prompt_credentials	=> 0,			# Interactively prompt for credentials (1) or not (0)
	tcp_port	=> {
			SSH	=>	22,		# Default TCP port number for SSH
			TELNET	=>	23,		# Default TCP port number for TELNET
	},
	read_block_size	=> {
			SSH		=> 4096,	# Default Read Block Size for SSH
			SERIAL_WIN32	=> 1024,	# Default Read Block Size for Win32::SerialPort
			SERIAL_DEVICE	=> 255,		# Default Read Block Size for Device::SerialPort
	},
	baudrate		=> 9600,		# Default baud rate used when connecting via Serial port
	handshake		=> 'none',		# Default handshake used when connecting via Serial port
	parity			=> 'none',		# Default parity used when connecting via Serial port
	databits		=> 8,			# Default data bits used when connecting via Serial port
	stopbits		=> 1,			# Default stop bits used when connecting via Serial port
	ors			=> "\n",		# Default Output Record Separator used by print() & cmd()
	errmode			=> 'croak',		# Default error mode; can be: die/croak/return/coderef/arrayref
	errmsg_format		=> 'default',		# Default error message format; can be: terse/default/verbose
	poll_obj_complete	=> 'all',		# Default mode for poll() method
	poll_obj_error		=> 'ignore',		# Default error mode for poll() method
	report_query_status	=> 0,			# Default setting of report_query_status for class object
	prompt		=> '.*[\?\$%#>](?:\e\[00?m)?\s?$',	# Default prompt used in login() and cmd() methods
	username_prompt	=> '(?i:user(?: ?name)?|login)[: ]+$',	# Default username prompt used in login() method
	password_prompt	=> '(?i)(?
	terminal_type	=> 'vt100',			# Default terminal type (for SSH)
	window_size	=> [],				# Default terminal window size [width, height]
	debug		=> 0,				# Default debug level; 0 = disabled
);

our @ConstructorArgs = ( 'use', 'timeout', 'errmode', 'return_reference', 'prompt', 'username_prompt', 'password_prompt',
			'input_log', 'output_log', 'dump_log', 'blocking', 'debug', 'prompt_credentials', 'read_attempts',
			'readwait_timer', 'read_block_size', 'output_record_separator', 'connection_timeout', 'data_with_error',
			'terminal_type', 'window_size', 'errmsg_format', 'report_query_status',
			);

# Debug levels can be set using the debug() method or via debug argument to new() constructor
# Debug levels defined:
#	0	: No debugging
#	bit 1	: Debugging activated for for polling methods + readwait() and enables carping on Win32/Device::SerialPort
#		  This level also resets Win32/Device::SerialPort constructor $quiet flag only when supplied in Control::CLI::new()
# 	bit 2	: Debugging is activated on underlying Net::SSH2 and Win32::SerialPort / Device::SerialPort
#		  There is no actual debugging for Net::Telnet


my ($UseTelnet, $UseSSH, $UseSerial, $UseSocketIP);


############################################## Required modules ##############################################

if (eval {require Net::Telnet}) { 		# Make Net::Telnet optional
	import Net::Telnet qw( TELNET_IAC TELNET_SB TELNET_SE TELNET_WILL TELOPT_TTYPE TELOPT_NAWS );
	$UseTelnet = 1
}
$UseSSH    = 1 if eval {require Net::SSH2};	# Make Net::SSH2 optional

if ($^O eq 'MSWin32') {
	$UseSerial = 1 if eval {require Win32::SerialPort};	# Win32::SerialPort optional on Windows
}
else {
	$UseSerial = 1 if eval {require Device::SerialPort};	# Device::SerialPort optional on Unix
}
croak "$Package: no available module installed to operate on" unless $UseTelnet || $UseSSH || $UseSerial;

$UseSocketIP = 1 if eval { require IO::Socket::IP };		# Provides IPv4 and IPv6 support


################################################ Class Methods ###############################################

sub useTelnet {
	return $UseTelnet;
}

sub useSsh {
	return $UseSSH;
}

sub useSerial {
	return $UseSerial;
}

sub useIPv6 {
	return $UseSocketIP;
}

sub promptClear { # Interactively prompt for a username, in clear text
	my $username = shift;
	my $input;
	print "Enter $username: ";
	ReadMode('normal');
	chomp($input = ReadLine(0));
	ReadMode('restore');
	return $input;
}

sub promptHide { # Interactively prompt for a password, input is hidden
	my $password = shift;
	my $input;
	print "Enter $password: ";
	ReadMode('noecho');
	chomp($input = ReadLine(0));
	ReadMode('restore');
	print "\n";
	return $input;
}

sub passphraseRequired { # Inspects a private key to see if it requires a passphrase to be used
	my $privateKey = shift;
	my $passphraseRequired = 0;

	# Open the private key to see if passphrase required.. Net::SSH2 does not do this for us..
	open(my $key, '<', $privateKey) or return;
	while (<$key>) {
		/ENCRYPTED/ && do { # Keys in OpenSSH format and passphrase encrypted
			$passphraseRequired = 1;
			last;
		};
	}
	close $key;
	return $passphraseRequired;
}


sub parseMethodArgs { # Parse arguments fed into a method against accepted arguments; also set them to lower case
	my ($pkgsub, $argsRef, $validArgsRef, $noCarp) = @_;
	return unless @$argsRef;
	my ($even_lc, @argsIn, @argsOut, %validArgs);
	@argsIn = map {++$even_lc%2 && defined $_ ? lc : $_} @$argsRef; # Sets to lowercase the hash keys only
	foreach my $key (@$validArgsRef) { $validArgs{lc $key} = 1 }
	for (my $i = 0; $i < $#argsIn; $i += 2) {
		return unless defined $argsIn[$i];
		if ($validArgs{$argsIn[$i]}) {
			push @argsOut, $argsIn[$i], $argsIn[$i + 1];
			next;
		}
		carp "$pkgsub: Invalid argument \"$argsIn[$i]\"" unless $noCarp;
	}
	return @argsOut;
}


sub suppressMethodArgs { # Parse arguments and remove the ones listed
	my ($argsRef, $suppressArgsRef) = @_;
	return unless @$argsRef;
	my ($even_lc, @argsIn, @argsOut, %suppressArgs);
	@argsIn = map {++$even_lc%2 ? lc : $_} @$argsRef; # Sets to lowercase the hash keys only
	foreach my $key (@$suppressArgsRef) { $suppressArgs{lc $key} = 1 }
	for (my $i = 0; $i < $#argsIn; $i += 2) {
		next if $suppressArgs{$argsIn[$i]};
		push @argsOut, $argsIn[$i], $argsIn[$i + 1];
	}
	return @argsOut;
}


sub parse_errmode { # Parse a new value for the error mode and return it if valid or undef otherwise
	my ($pkgsub, $mode) = @_;

	if (!defined $mode) {
		carp "$pkgsub: Errmode undefined argument; ignoring";
		$mode  = undef;
	}
	elsif ($mode =~ /^\s*die\s*$/i) { $mode = 'die' }
	elsif ($mode =~ /^\s*croak\s*$/i) { $mode = 'croak' }
	elsif ($mode =~ /^\s*return\s*$/i) { $mode = 'return' }
	elsif ( ref($mode) ) {
		unless ( validCodeRef($mode) ) {
			carp "$pkgsub: Errmode first item of array ref must be a code ref; ignoring";
			$mode  = undef;
		}
	}
	else {
		carp "$pkgsub: Errmode invalid argument '$mode'; ignoring";
		$mode  = undef;
	}
	return $mode;
}


sub stripLastLine { # Remove incomplete (not ending with \n) last line, if any from the string ref provided
	my $dataRef = shift;
	$$dataRef =~ s/(.*)\z//;
	return defined $1 ? $1 : '';
}


sub validCodeRef { # Checks validity of code reference / array ref where 1st element is a code ref
	my $codeRef = shift;
	return 1 if ref($codeRef) eq 'CODE';
	return 1 if ref($codeRef) eq 'ARRAY' && ref($codeRef->[0]) eq 'CODE';
	return;
}


sub callCodeRef { # Executes a codeRef either as direct codeRef or array ref where 1st element is a code ref
	my $callRef = shift;
	return &$callRef(@_) if ref($callRef) eq 'CODE';
	# Else ARRAY ref where 1st element is the codeRef
	my @callArgs = @$callRef; # Copy the array before shifting it below, as we need to preserve it
	my $codeRef = shift(@callArgs);
	return &$codeRef(@callArgs, @_);
}


sub promptCredential { # Automatically handles credential prompt for code reference or local prompting
	my ($mode, $privacy, $credential) = @_;
	return callCodeRef($mode, $privacy, $credential) if validCodeRef($mode);
	return promptClear($credential) if lc($privacy) eq 'clear';
	return promptHide($credential) if lc($privacy) eq 'hide';
	return;
}


############################################# Constructors/Destructors #######################################

sub new {
	my $pkgsub = "${Package}::new";
	my $invocant = shift;
	my $class = ref($invocant) || $invocant;
	my (%args, $errmode, $msgFormat, $connectionType, $parent, $comPort, $debug);
	if (@_ == 1) { # Method invoked with just the connection type argument
		$connectionType = shift;
	}
	else {
		%args = parseMethodArgs($pkgsub, \@_, \@ConstructorArgs);
		$connectionType = $args{use};
	}
	$debug = defined $args{debug} ? $args{debug} : $Default{debug};
	$errmode = defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : $Default{errmode};
	$msgFormat = defined $args{errmsg_format} ? $args{errmsg_format} : $Default{errmsg_format};
	return _error(__FILE__, __LINE__, $errmode, "$pkgsub: Connection type must be specified in constructor", $msgFormat) unless defined $connectionType;

	if    ($connectionType =~ /^TELNET$/i) {
		croak "$pkgsub: Module 'Net::Telnet' required for telnet access" unless $UseTelnet;
		@CLI::ISA = qw(Net::Telnet);
		$parent = Net::Telnet->new();
		# Set up callbacks for telnet options
		$parent->option_callback(\&_telnet_opt_callback);
		$parent->suboption_callback(\&_telnet_subopt_callback);
		$connectionType = 'TELNET';
	}
	elsif ($connectionType =~ /^SSH$/i) {
		croak "$pkgsub: Module 'Net::SSH2' required for ssh access" unless $UseSSH;
		@CLI::ISA = qw(Net::SSH2);
		$parent = Net::SSH2->new();
		$connectionType = 'SSH';
	}
	else {
		if ($^O eq 'MSWin32') {
			croak "$pkgsub: Module 'Win32::SerialPort' required for serial access" unless $UseSerial;
			@CLI::ISA = qw(Win32::SerialPort);
			Win32::SerialPort->set_test_mode_active(!($debug & 1));	 # Suppress carping except if debug bit1 set
			Win32::SerialPort::debug($debug & 2 ? 'ON' : 'OFF');
			$parent = Win32::SerialPort->new($connectionType, !($debug & 1))
				or return _error(__FILE__, __LINE__, $errmode, "$pkgsub: Cannot open serial port '$connectionType'", $msgFormat);
		}
		else {
			croak "$pkgsub: Module 'Device::SerialPort' required for serial access" unless $UseSerial;
			@CLI::ISA = qw(Device::SerialPort);
			Device::SerialPort->set_test_mode_active(!($debug & 1)); # Suppress carping except if debug bit1 set
			Device::SerialPort::debug($debug & 2 ? 'ON' : 'OFF');
			$parent = Device::SerialPort->new($connectionType, !($debug & 1))
				or return _error(__FILE__, __LINE__, $errmode, "$pkgsub: Cannot open serial port '$connectionType'", $msgFormat);
		}
		$comPort = $connectionType;
		$connectionType = 'SERIAL';
	}
	my $self = {
		# Lower Case ones can be set by user; Upper case ones are set internaly in the class
		TYPE			=>	$connectionType,
		PARENT			=>	$parent,
		SOCKET			=>	undef,
		SSHCHANNEL		=>	undef,
		SSHAUTH			=>	undef,
		BUFFER			=>	'', # Always defined; greater than 0 length if in use
		QUERYBUFFER		=>	'', # Always defined; greater than 0 length if in use
		COMPORT			=>	$comPort,
		HOST			=>	undef,
		TCPPORT			=>	undef,
		HANDSHAKE		=>	undef,
		BAUDRATE		=>	undef,
		PARITY			=>	undef,
		DATABITS		=>	undef,
		STOPBITS		=>	undef,
		INPUTLOGFH		=>	undef,
		OUTPUTLOGFH		=>	undef,
		DUMPLOGFH		=>	undef,
		USERNAME		=>	undef,
		PASSWORD		=>	undef,
		PASSPHRASE		=>	undef,
		LOGINSTAGE		=>	'',
		LASTPROMPT		=>	undef,
		SERIALEOF		=>	1,
		TELNETMODE		=>	1,
		POLL			=>	undef,	# Storage hash for poll-capable methods
		POLLING			=>	0,	# Flag to track if in polling-capable method or not
		POLLREPORTED		=>	0,	# Flag used by poll() to track already reported objects
		timeout			=>	$Default{timeout},
		connection_timeout	=>	$Default{connection_timeout},
		blocking		=>	$Default{blocking},
		return_reference	=>	$Default{return_reference},
		prompt_credentials	=>	$Default{prompt_credentials},
		read_attempts		=>	$Default{read_attempts},
		readwait_timer		=>	$Default{readwait_timer},
		data_with_error		=>	$Default{data_with_error},
		read_block_size		=>	$Default{read_block_size}{$connectionType},
		ors			=>	$Default{ors},
		errmode			=>	$Default{errmode},
		errmsg			=>	'',
		errmsg_format		=>	$Default{errmsg_format},
		prompt			=>	$Default{prompt},
		prompt_qr		=>	qr/$Default{prompt}/,
		username_prompt		=>	$Default{username_prompt},
		username_prompt_qr	=>	qr/$Default{username_prompt}/,
		password_prompt		=>	$Default{password_prompt},
		password_prompt_qr	=>	qr/$Default{password_prompt}/,
		terminal_type		=>	$connectionType eq 'SSH' ? $Default{terminal_type} : undef,
		window_size		=>	$Default{window_size},
		report_query_status	=>	$Default{report_query_status},
		debug			=>	$Default{debug},
	};
	if ($connectionType eq 'SERIAL') { # Adjust read_block_size defaults for Win32::SerialPort & Device::SerialPort
		$self->{read_block_size} = ($^O eq 'MSWin32') ? $Default{read_block_size}{SERIAL_WIN32}
							      : $Default{read_block_size}{SERIAL_DEVICE};
	}
	bless $self, $class;
	if ($connectionType eq 'TELNET') {
		# We are going to setup option callbacks to handle telnet options terminal type and window size
		# However the callbacks only provide the telnet object and there is no option to feed additional arguments
		# So need to link our object into the telnet one; here we create a key to contain our object
		*$parent->{net_telnet}->{$Package} = $self;
	}
	foreach my $arg (keys %args) { # Accepted arguments on constructor
		if    ($arg eq 'errmode')			{ $self->errmode($args{$arg}) }
		elsif ($arg eq 'errmsg_format')			{ $self->errmsg_format($args{$arg}) }
		elsif ($arg eq 'timeout')			{ $self->timeout($args{$arg}) }
		elsif ($arg eq 'connection_timeout')		{ $self->connection_timeout($args{$arg}) }
		elsif ($arg eq 'read_block_size')		{ $self->read_block_size($args{$arg}) }
		elsif ($arg eq 'blocking')			{ $self->blocking($args{$arg}) }
		elsif ($arg eq 'read_attempts')			{ $self->read_attempts($args{$arg}) }
		elsif ($arg eq 'readwait_timer')		{ $self->readwait_timer($args{$arg}) }
		elsif ($arg eq 'data_with_error')		{ $self->data_with_error($args{$arg}) }
		elsif ($arg eq 'return_reference')		{ $self->return_reference($args{$arg}) }
		elsif ($arg eq 'output_record_separator')	{ $self->output_record_separator($args{$arg}) }
		elsif ($arg eq 'prompt_credentials')		{ $self->prompt_credentials($args{$arg}) }
		elsif ($arg eq 'prompt')			{ $self->prompt($args{$arg}) }
		elsif ($arg eq 'username_prompt')		{ $self->username_prompt($args{$arg}) }
		elsif ($arg eq 'password_prompt')		{ $self->password_prompt($args{$arg}) }
		elsif ($arg eq 'terminal_type')			{ $self->terminal_type($args{$arg}) }
		elsif ($arg eq 'window_size')			{ $self->window_size(@{$args{$arg}}) }
		elsif ($arg eq 'report_query_status')		{ $self->report_query_status($args{$arg}) }
		elsif ($arg eq 'input_log')			{ $self->input_log($args{$arg}) }
		elsif ($arg eq 'output_log')			{ $self->output_log($args{$arg}) }
		elsif ($arg eq 'dump_log')			{ $self->dump_log($args{$arg}) }
		elsif ($arg eq 'debug')				{ $self->debug($args{$arg}) }
	}
	return $self;
}

sub DESTROY { # Run disconnect
	my $self = shift;
	return $self->disconnect;
}


############################################### Object methods ###############################################

sub connect { # Connect to host
	my $pkgsub = "${Package}::connect";
	my $self = shift;
	my %args;
	if (@_ == 1) { # Method invoked in the shorthand form
		$args{host} = shift;
		if ($args{host} =~ /^(.+?)\s+(\d+)$/ || $args{host} =~ /^([^:\s]+?):(\d+)$/) {
			($args{host}, $args{port}) = ($1, $2);
		}
	}
	else {
		my @validArgs = ('host', 'port', 'username', 'password', 'publickey', 'privatekey', 'passphrase',
				 'prompt_credentials', 'baudrate', 'parity', 'databits', 'stopbits', 'handshake',
				 'errmode', 'connection_timeout', 'blocking', 'terminal_type', 'window_size',
				 'callback', 'forcebaud', 'atomic_connect');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}

	# Initialize the base POLL structure
	$self->poll_struct( # $methodName, $codeRef, $blocking, $timeout, $errmode, $outputType, $outputRequested, $returnReference, $returnList
				$pkgsub,
				__PACKAGE__->can('connect_poll'),
				defined $args{blocking} ? $args{blocking} : $self->{blocking},
				defined $args{connection_timeout} ? $args{connection_timeout} : $self->{connection_timeout},
				defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef,
				0,	# no output
				0,	# no output
				undef,	# n/a
				undef,	# n/a
			);
	$self->{POLL}{$pkgsub} = { # Populate structure with method arguments/storage
		# Set method argument keys
		host			=>	$args{host},
		port			=>	$args{port},
		username		=>	$args{username},
		password		=>	$args{password},
		publickey		=>	$args{publickey},
		privatekey		=>	$args{privatekey},
		passphrase		=>	$args{passphrase},
		baudrate		=>	$args{baudrate},
		parity			=>	$args{parity},
		databits		=>	$args{databits},
		stopbits		=>	$args{stopbits},
		handshake		=>	$args{handshake},
		prompt_credentials	=>	defined $args{prompt_credentials} ? $args{prompt_credentials} : $self->{prompt_credentials},
		terminal_type		=>	$args{terminal_type},
		window_size		=>	$args{window_size},
		callback		=>	$args{callback},
		forcebaud		=>	$args{forcebaud},
		atomic_connect		=>	$args{atomic_connect},
		# Declare method storage keys which will be used
		stage			=>	0,
		authPublicKey		=>	0,
		authPassword		=>	0,
	};
	if ($self->{TYPE} ne 'SERIAL' && !$UseSocketIP && defined $args{blocking} && !$args{blocking}) {
		carp "$pkgsub: IO::Socket::IP is required for non-blocking connect";
	}
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};
	return __PACKAGE__->can('poll_connect')->($self, $pkgsub); # Do not call a sub-classed version
}


sub connect_poll { # Poll status of connection (non-blocking mode)
	my $pkgsub = "${Package}::connect_poll";
	my $self = shift;
	carp "$pkgsub: No arguments expected" if @_; # No arguments expected

	unless (defined $self->{POLL} && $self->{POLL}{coderef} == __PACKAGE__->can('connect_poll')) {
		return $self->error("$pkgsub: Method connect() needs to be called first with blocking false");
	}
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};

	# If already completed (1) or we got an error (undef) from previous call (errmsg is already set) then we go no further
	return $self->poll_return($self->{POLL}{complete}) unless defined $self->{POLL}{complete} && $self->{POLL}{complete} == 0;

	# We get here only if we are not complete: $self->{POLL}{complete} == 0
	return __PACKAGE__->can('poll_connect')->($self, $pkgsub); # Do not call a sub-classed version
}


sub read { # Read in data from connection
	my $pkgsub = "${Package}::read";
	my $self = shift;
	my @validArgs = ('blocking', 'timeout', 'errmode', 'return_reference');
	my %args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	my $timeout = defined $args{timeout} ? $args{timeout} : $self->{timeout};
	my $blocking = defined $args{blocking} ? $args{blocking} : $self->{blocking};
	my $returnRef = defined $args{return_reference} ? $args{return_reference} : $self->{return_reference};
	my $errmode = defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef;
	local $self->{errmode} = $errmode if defined $errmode;

	return $self->_read_blocking($pkgsub, $timeout, $returnRef) if $blocking && !length $self->{BUFFER};
	return $self->_read_nonblocking($pkgsub, $returnRef); # if !$blocking || ($blocking && length $self->{BUFFER})
}


sub readwait { # Read in data initially in blocking mode, then perform subsequent non-blocking reads for more
	my $pkgsub = "${Package}::readwait";
	my $self = shift;
	my ($outref, $bufref);
	my $ticks = 0;
	my @validArgs = ('read_attempts', 'readwait_timer', 'blocking', 'timeout', 'errmode', 'return_reference', 'data_with_error');
	my %args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	my $readAttempts = defined $args{read_attempts} ? $args{read_attempts} : $self->{read_attempts};
	my $readwaitTimer = defined $args{readwait_timer} ? $args{readwait_timer} : $self->{readwait_timer};
	my $dataWithError = defined $args{data_with_error} ? $args{data_with_error} : $self->{data_with_error};
	my $timeout = defined $args{timeout} ? $args{timeout} : $self->{timeout};
	my $blocking = defined $args{blocking} ? $args{blocking} : $self->{blocking};
	my $returnRef = defined $args{return_reference} ? $args{return_reference} : $self->{return_reference};
	my $errmode = defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef;
	local $self->{errmode} = $errmode if defined $errmode;

	# Wait until some data is read in
	$bufref = $self->_read_buffer(1);
	if (!length $$bufref && $blocking) {
		$bufref = $self->_read_blocking($pkgsub, $timeout, 1);
		return unless defined $bufref;	# Catch errors in 'return' errmode
	}
	# Then keep reading until there is nothing more to read..
	while ($ticks++ < $readAttempts) {
		sleep($readwaitTimer/1000); # Fraction of a sec sleep using Time::HiRes::sleep
		$outref = $self->read( blocking => 0, return_reference => 1, errmode => 'return' );
		unless (defined $outref) { # Here we catch errors since errmode = 'return'
			last if $dataWithError && length $$bufref; # Data_with_error processing
			return $self->error("$pkgsub: Read error // ".$self->errmsg);
		}
		if (length $$outref) {
			$$bufref .= $$outref;
			$ticks = 0; # Reset ticks to zero upon successful read
		}
		$self->debugMsg(1,"readwait ticks = $ticks\n");
	}
	return $returnRef ? $bufref : $$bufref;
}


sub waitfor { # Wait to find pattern in the device output stream
	my $pkgsub = "${Package}::waitfor";
	my $self = shift;
	my ($pollSyntax, $errmode, @matchpat);
	my $timeout = $self->{timeout};
	my $blocking = $self->{blocking};
	my $returnRef = $self->{return_reference};

	if (@_ == 1) { # Method invoked with single argument form
		$matchpat[0] = shift;
	}
	else { # Method invoked with multiple arguments form
		my @validArgs = ('match', 'match_list', 'timeout', 'errmode', 'return_reference', 'blocking', 'poll_syntax');
		my @args = parseMethodArgs($pkgsub, \@_, \@validArgs);
		for (my $i = 0; $i < $#args; $i += 2) {
			push @matchpat, $args[$i + 1] if $args[$i] eq 'match';
			push @matchpat, @{$args[$i + 1]} if $args[$i] eq 'match_list' && ref($args[$i + 1]) eq "ARRAY";
			$timeout = $args[$i + 1] if $args[$i] eq 'timeout';
			$blocking = $args[$i + 1] if $args[$i] eq 'blocking';
			$returnRef = $args[$i + 1] if $args[$i] eq 'return_reference';
			$errmode = parse_errmode($pkgsub, $args[$i + 1]) if $args[$i] eq 'errmode';
			$pollSyntax = $args[$i + 1] if $args[$i] eq 'poll_syntax';
		}
	}
	my @matchArray = grep {defined} @matchpat;	# Weed out undefined values, if any

	# Initialize the base POLL structure
	$self->poll_struct( # $methodName, $codeRef, $blocking, $timeout, $errmode, $outputType, $outputRequested, $returnReference, $returnList
				$pkgsub,
				__PACKAGE__->can('waitfor_poll'),
				$blocking,
				$timeout,
				$errmode,
				3,
				undef,	# This is set below
				$returnRef,
				undef,	# n/a
			);
	my $waitfor = $self->{POLL}{$pkgsub} = { # Populate structure with method arguments/storage
		# Set method argument keys
		matchpat		=>	\@matchArray,
		# Declare method storage keys which will be used
		stage			=>	0,
		matchpat_qr		=>	undef,
	};
	$self->{POLL}{output_requested} = !$pollSyntax || wantarray; # Always true in legacy syntax and in poll_syntax if wantarray
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};

	my ($ok, $prematch, $match) = __PACKAGE__->can('poll_waitfor')->($self, $pkgsub); # Do not call a sub-classed version
	# We have an old and new syntax
	if ($pollSyntax) { # New syntax
		return wantarray ? ($ok, $prematch, $match) : $ok;
	}
	else { # Old syntax
		return wantarray ? ($prematch, $match) : $prematch;
	}
}


sub waitfor_poll { # Poll status of waitfor (non-blocking mode)
	my $pkgsub = "${Package}::waitfor_poll";
	my $self = shift;
	carp "$pkgsub: No arguments expected" if @_; # No arguments expected

	unless (defined $self->{POLL} && $self->{POLL}{coderef} == __PACKAGE__->can('waitfor_poll')) {
		return $self->error("$pkgsub: Method waitfor() needs to be called first with blocking false");
	}
	$self->{POLL}{output_requested} = wantarray; # This might change at every call
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};

	# If already completed (1) or we got an error (undef) from previous call (errmsg is already set) then we go no further
	return $self->poll_return($self->{POLL}{complete}) unless defined $self->{POLL}{complete} && $self->{POLL}{complete} == 0;

	# We get here only if we are not complete: $self->{POLL}{complete} == 0
	return __PACKAGE__->can('poll_waitfor')->($self, $pkgsub); # Do not call a sub-classed version
}


sub put { # Send character strings to host (no \n appended)
	my $pkgsub = "${Package}::put";
	my $self = shift;
	my %args;
	if (@_ == 1) { # Method invoked with just the command argument
		$args{string} = shift;
	}
	else {
		my @validArgs = ('string', 'errmode');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}
	return 1 unless defined $args{string};
	my $errmode = defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef;
	local $self->{errmode} = $errmode if defined $errmode;

	return $self->_put($pkgsub, \$args{string});
}


sub print { # Send CLI commands to host (\n appended)
	my $pkgsub = "${Package}::print";
	my $self = shift;
	my %args;
	if (@_ == 1) { # Method invoked with just the command argument
		$args{line} = shift;
	}
	else {
		my @validArgs = ('line', 'errmode');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}
	my $errmode = defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef;
	local $self->{errmode} = $errmode if defined $errmode;
	$args{line} .= $self->{ors};

	return $self->_put($pkgsub, \$args{line});
}


sub printlist { # Send multiple lines to host switch (\n appended)
	my $pkgsub = "${Package}::printlist";
	my $self = shift;
	my $output = join($self->{ors}, @_) . $self->{ors};

	return $self->_put($pkgsub, \$output);
}


sub login { # Handles basic username/password login for Telnet/Serial login and locks onto 1st prompt
	my $pkgsub = "${Package}::login";
	my $self =shift;
	my @validArgs = ('username', 'password', 'prompt_credentials', 'prompt', 'username_prompt', 'password_prompt',
		    'timeout', 'errmode', 'return_reference', 'blocking');
	my %args = parseMethodArgs($pkgsub, \@_, \@validArgs);

	# Initialize the base POLL structure
	$self->poll_struct( # $methodName, $codeRef, $blocking, $timeout, $errmode, $outputType, $outputRequested, $returnReference, $returnList
				$pkgsub,
				__PACKAGE__->can('login_poll'),
				defined $args{blocking} ? $args{blocking} : $self->{blocking},
				defined $args{timeout} ? $args{timeout} : $self->{timeout},
				defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef,
				1,
				wantarray,
				defined $args{return_reference} ? $args{return_reference} : $self->{return_reference},
				undef,	# n/a
			);
	$self->{POLL}{$pkgsub} = { # Populate structure with method arguments/storage
		# Set method argument keys
		username		=>	$args{username},
		password		=>	$args{password},
		prompt_credentials	=>	defined $args{prompt_credentials} ? $args{prompt_credentials} : $self->{prompt_credentials},
		prompt			=>	defined $args{prompt} ? $args{prompt} : $self->{prompt_qr},
		username_prompt		=>	defined $args{username_prompt} ? $args{username_prompt} : $self->{username_prompt_qr},
		password_prompt		=>	defined $args{password_prompt} ? $args{password_prompt} : $self->{password_prompt_qr},
		# Declare method storage keys which will be used
		stage			=>	0,
		login_attempted		=>	undef,
	};
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};
	return __PACKAGE__->can('poll_login')->($self, $pkgsub); # Do not call a sub-classed version
}


sub login_poll { # Poll status of login (non-blocking mode)
	my $pkgsub = "${Package}::login_poll";
	my $self = shift;
	carp "$pkgsub: No arguments expected" if @_; # No arguments expected

	unless (defined $self->{POLL} && $self->{POLL}{coderef} == __PACKAGE__->can('login_poll')) {
		return $self->error("$pkgsub: Method login() needs to be called first with blocking false");
	}
	$self->{POLL}{output_requested} = wantarray; # This might change at every call
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};

	# If already completed (1) or we got an error (undef) from previous call (errmsg is already set) then we go no further
	return $self->poll_return($self->{POLL}{complete}) unless defined $self->{POLL}{complete} && $self->{POLL}{complete} == 0;

	# We get here only if we are not complete: $self->{POLL}{complete} == 0
	return __PACKAGE__->can('poll_login')->($self, $pkgsub); # Do not call a sub-classed version
}


sub cmd { # Sends a CLI command to host and returns output
	my $pkgsub = "${Package}::cmd";
	my $self = shift;
	my %args;
	if (@_ == 1) { # Method invoked with just the command argument
		$args{command} = shift;
	}
	else {
		my @validArgs = ('command', 'prompt', 'timeout', 'errmode', 'return_reference', 'blocking', 'poll_syntax');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}
	$args{command} = '' unless defined $args{command};

	# Initialize the base POLL structure
	$self->poll_struct( # $methodName, $codeRef, $blocking, $timeout, $errmode, $outputType, $outputRequested, $returnReference, $returnList
				$pkgsub,
				__PACKAGE__->can('cmd_poll'),
				defined $args{blocking} ? $args{blocking} : $self->{blocking},
				defined $args{timeout} ? $args{timeout} : $self->{timeout},
				defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef,
				1,
				undef,	# This is set below
				defined $args{return_reference} ? $args{return_reference} : $self->{return_reference},
				undef,	# n/a
			);
	my $cmd = $self->{POLL}{$pkgsub} = { # Populate structure with method arguments/storage
		# Set method argument keys
		command			=>	$args{command},
		prompt			=>	defined $args{prompt} ? $args{prompt} : $self->{prompt_qr},
		# Declare method storage keys which will be used
		stage			=>	0,
		cmdEchoRemoved		=>	0,
	};
	$self->{POLL}{output_requested} = !$args{poll_syntax} || wantarray; # Always true in legacy syntax and in poll_syntax if wantarray
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};

	my ($ok, $output) = __PACKAGE__->can('poll_cmd')->($self, $pkgsub); # Do not call a sub-classed version
	# We have a different syntax for scalar output in blocking and non-blocking modes
	if ($args{poll_syntax}) { # New syntax
		return wantarray ? ($ok, $output) : $ok;
	}
	else { # Old syntax
		return wantarray ? ($ok, $output) : $output;
	}
}


sub cmd_poll { # Poll status of cmd (non-blocking mode)
	my $pkgsub = "${Package}::cmd_poll";
	my $self = shift;
	carp "$pkgsub: No arguments expected" if @_; # No arguments expected

	unless (defined $self->{POLL} && $self->{POLL}{coderef} == __PACKAGE__->can('cmd_poll')) {
		return $self->error("$pkgsub: Method cmd() needs to be called first with blocking false");
	}
	$self->{POLL}{output_requested} = wantarray; # This might change at every call
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};

	# If already completed (1) or we got an error (undef) from previous call (errmsg is already set) then we go no further
	return $self->poll_return($self->{POLL}{complete}) unless defined $self->{POLL}{complete} && $self->{POLL}{complete} == 0;

	# We get here only if we are not complete: $self->{POLL}{complete} == 0
	return __PACKAGE__->can('poll_cmd')->($self, $pkgsub); # Do not call a sub-classed version
}


sub change_baudrate { # Change baud rate of active SERIAL connection
	my $pkgsub = "${Package}::change_baudrate";
	my $self = shift;
	my %args;
	if (@_ == 1) { # Method invoked with just the command argument
		$args{baudrate} = shift;
	}
	else {
		my @validArgs = ('baudrate', 'parity', 'databits', 'stopbits', 'handshake', 'blocking', 'errmode', 'forcebaud');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}

	# Initialize the base POLL structure
	$self->poll_struct( # $methodName, $codeRef, $blocking, $timeout, $errmode, $outputType, $outputRequested, $returnReference, $returnList
				$pkgsub,
				__PACKAGE__->can('change_baudrate_poll'),
				defined $args{blocking} ? $args{blocking} : $self->{blocking},
				undef,
				defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : undef,
				0,	# n/a
				undef,	# n/a
				undef,	# n/a
				undef,	# n/a
			);
	$self->{POLL}{$pkgsub} = { # Populate structure with method arguments/storage
		# Set method argument keys
		baudrate		=>	defined $args{baudrate} ? $args{baudrate} : $self->{BAUDRATE},
		parity			=>	defined $args{parity} ? $args{parity} : $self->{PARITY},
		databits		=>	defined $args{databits} ? $args{databits} : $self->{DATABITS},
		stopbits		=>	defined $args{stopbits} ? $args{stopbits} : $self->{STOPBITS},
		handshake		=>	defined $args{handshake} ? $args{handshake} : $self->{HANDSHAKE},
		forcebaud		=>	$args{forcebaud},
		# Declare method storage keys which will be used
		stage			=>	0,
	};
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};
	return __PACKAGE__->can('poll_change_baudrate')->($self, $pkgsub); # Do not call a sub-classed version
}


sub change_baudrate_poll { # Poll status of change_baudrate (non-blocking mode)
	my $pkgsub = "${Package}::change_baudrate_poll";
	my $self = shift;
	carp "$pkgsub: No arguments expected" if @_; # No arguments expected

	unless (defined $self->{POLL} && $self->{POLL}{coderef} == __PACKAGE__->can('change_baudrate_poll')) {
		return $self->error("$pkgsub: Method change_baudrate() needs to be called first with blocking false");
	}
	local $self->{POLLING} = 1; # True until we come out of this polling-capable method
	local $self->{errmode} = $self->{POLL}{errmode} if defined $self->{POLL}{errmode};

	# If already completed (1) or we got an error (undef) from previous call (errmsg is already set) then we go no further
	return $self->poll_return($self->{POLL}{complete}) unless defined $self->{POLL}{complete} && $self->{POLL}{complete} == 0;

	# We get here only if we are not complete: $self->{POLL}{complete} == 0
	return __PACKAGE__->can('poll_change_baudrate')->($self, $pkgsub); # Do not call a sub-classed version
}


sub input_log { # Log to file all input sent to host
	my $pkgsub = "${Package}::input_log";
	my ($self, $fh) = @_;

	unless (defined $fh) { # No input = return current filehandle
		return $self->{INPUTLOGFH};
	}
	if ($self->{TYPE} eq 'TELNET') { # For Telnet use methods provided by Net::Telnet
		$fh = $self->{PARENT}->input_log($fh);
		if (defined $fh && $self->{PARENT}->errmsg =~ /problem creating $fh: (.*)/) {
			return $self->error("$pkgsub: Unable to open input log file: $1");
		}
	}
	else { # SSH & SERIAL We implement logging ourselves
		unless (ref $fh or length $fh) { # Empty input = stop logging
			$self->{INPUTLOGFH} = undef;
			return;
		}
		if (!ref($fh) && !defined(fileno $fh)) { # Open a new filehandle if input is a filename
			my $logfile = $fh;
			$fh = IO::Handle->new;
			open($fh, '>', "$logfile") or return $self->error("$pkgsub: Unable to open input log file: $!");
		}
		$fh->autoflush();
	}
	$self->{INPUTLOGFH} = $fh;
	return $fh;
}


sub output_log { # Log to file all output received from host
	my $pkgsub = "${Package}::output_log";
	my ($self, $fh) = @_;

	unless (defined $fh) { # No input = return current filehandle
		return $self->{OUTPUTLOGFH};
	}
	if ($self->{TYPE} eq 'TELNET') { # For Telnet use methods provided by Net::Telnet
		$fh = $self->{PARENT}->output_log($fh);
		if (defined $fh && $self->{PARENT}->errmsg =~ /problem creating $fh: (.*)/) {
			return $self->error("$pkgsub: Unable to open output log file: $1");
		}
	}
	else { # SSH & SERIAL We implement logging ourselves
		unless (ref $fh or length $fh) { # Empty input = stop logging
			$self->{OUTPUTLOGFH} = undef;
			return;
		}
		if (!ref($fh) && !defined(fileno $fh)) { # Open a new filehandle if input is a filename
			my $logfile = $fh;
			$fh = IO::Handle->new;
			open($fh, '>', "$logfile") or return $self->error("$pkgsub: Unable to open output log file: $!");
		}
		$fh->autoflush();
	}
	$self->{OUTPUTLOGFH} = $fh;
	return $fh;
}


sub dump_log { # Log hex and ascii for both input & output
	my $pkgsub = "${Package}::dump_log";
	my ($self, $fh) = @_;

	unless (defined $fh) { # No input = return current filehandle
		return $self->{DUMPLOGFH};
	}
	if ($self->{TYPE} eq 'TELNET') { # For Telnet use methods provided by Net::Telnet
		$fh = $self->{PARENT}->dump_log($fh);
		if (defined $fh && $self->{PARENT}->errmsg =~ /problem creating $fh: (.*)/) {
			return $self->error("$pkgsub: Unable to open dump log file: $1");
		}
	}
	else { # SSH & SERIAL We implement logging ourselves
		unless (ref $fh or length $fh) { # Empty input = stop logging
			$self->{DUMPLOGFH} = undef;
			return;
		}
		if (!ref($fh) && !defined(fileno $fh)) { # Open a new filehandle if input is a filename
			my $logfile = $fh;
			$fh = IO::Handle->new;
			open($fh, '>', "$logfile") or return $self->error("$pkgsub: Unable to open dump log file: $!");
		}
		$fh->autoflush();
	}
	$self->{DUMPLOGFH} = $fh;
	return $fh;
}


sub eof { # End-Of-File indicator
	my $pkgsub = "${Package}::eof";
	my $self = shift;

	if ($self->{TYPE} eq 'TELNET') {
		# Re-format Net::Telnet's own method to return 0 or 1
		return $self->{PARENT}->eof ? 1 : 0;
	}
	elsif ($self->{TYPE} eq 'SSH') {
		# Make SSH behave as Net::Telnet; return 1 if object created but not yet connected
		return 1 if defined $self->{PARENT} && !defined $self->{SSHCHANNEL};
		# Return Net::SSH2's own method if it is true (but it never is & seems not to work...)
		return 1 if $self->{SSHCHANNEL}->eof;
		# So we fudge it by checking Net::SSH2's last error code..
		my $sshError = $self->{PARENT}->error; # Minimize calls to Net::SSH2 error method, as it leaks in version 0.58
		return 1 if $sshError == -1;  # LIBSSH2_ERROR_SOCKET_NONE
		return 1 if $sshError == -43; # LIBSSH2_ERROR_SOCKET_RECV
		return 0; # If we get here, return 0
	}
	elsif ($self->{TYPE} eq 'SERIAL') {
		return $self->{SERIALEOF};
	}
	else {
		return $self->error("$pkgsub: Invalid connection mode");
	}
	return 1;
}


sub break { # Send the break signal
	my $pkgsub = "${Package}::break";
	my $self = shift;
	my $comBreakDuration = shift || $ComBreakDuration;

	return $self->error("$pkgsub: No connection to write to") if $self->eof;

	if ($self->{TYPE} eq 'TELNET') {
		# Simply use Net::Telnet's implementation
		$self->{PARENT}->break
			or return $self->error("$pkgsub: Unable to send telnet break signal");
	}
	elsif ($self->{TYPE} eq 'SSH') {
		# For SSH we just send '~B' and hope that the other end will interpret it as a break
		$self->put(string => '~B', errmode => 'return')
			or return $self->error("$pkgsub: Unable to send SSH break signal // ".$self->errmsg);
	}
	elsif ($self->{TYPE} eq 'SERIAL') {
		$self->{PARENT}->pulse_break_on($comBreakDuration);
	}
	else {
		return $self->error("$pkgsub: Invalid connection mode");
	}
	return 1;
}


sub disconnect { # Disconnect from host
	my $pkgsub = "${Package}::disconnect";
	my $self = shift;
	my %args;
	if (@_ == 1) { # Method invoked with just the command argument
		$args{close_logs} = shift;
	}
	else {
		my @validArgs = ('close_logs');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}

	if ($self->{TYPE} eq 'TELNET') {
		$self->{PARENT}->close if defined $self->{PARENT};
		$self->{HOST} = $self->{TCPPORT} = undef;
		close $self->{SOCKET} if defined $self->{SOCKET};
		$self->{SOCKET} = undef;
	}
	elsif ($self->{TYPE} eq 'SSH') {
		$self->{SSHCHANNEL}->close if defined $self->{SSHCHANNEL};
		$self->{SSHCHANNEL} = $self->{SSHAUTH} = undef;
		$self->{PARENT}->disconnect() if defined $self->{PARENT};
		$self->{HOST} = $self->{TCPPORT} = undef;
		close $self->{SOCKET} if defined $self->{SOCKET};
		$self->{SOCKET} = undef;
	}
	elsif ($self->{TYPE} eq 'SERIAL') {
		if (defined $self->{PARENT} && !$self->{SERIALEOF}) {
			# Needed to flush writes before closing with Device::SerialPort (do once only)
			$self->{PARENT}->write_done(1) if defined $self->{BAUDRATE};
			$self->{PARENT}->close;
		}
		$self->{HANDSHAKE} = undef;
		$self->{BAUDRATE} = undef;
		$self->{PARITY} = undef;
		$self->{DATABITS} = undef;
		$self->{STOPBITS} = undef;
		$self->{SERIALEOF} = 1;
	}
	else {
		return $self->error("$pkgsub: Invalid connection mode");
	}
	if ($args{close_logs}) {
		if (defined $self->input_log) {
			close $self->input_log;
			$self->input_log('');
		}
		if (defined $self->output_log) {
			close $self->output_log;
			$self->output_log('');
		}
		if (defined $self->dump_log) {
			close $self->dump_log;
			$self->dump_log('');
		}
		if ($self->{TYPE} eq 'TELNET' && defined $self->parent->option_log) {
			close $self->parent->option_log;
			$self->parent->option_log('');
		}
	}
	return 1;
}


sub close { # Same as disconnect
	my $self = shift;
	return $self->disconnect(@_);
}


sub error { # Handle errors according to the object's error mode
	my $self = shift;
	my $errmsg = shift || '';
	my (undef, $fileName, $lineNumber) = caller; # Needed in case of die

	$self->errmsg($errmsg);
	return _error($fileName, $lineNumber, $self->{errmode}, $errmsg, $self->{errmsg_format});
}


sub poll { # Poll objects for completion
	my $pkgsub = "${Package}::poll";
	my ($self, %args);
	my ($running, $completed, $failed);
	my (@lastCompleted, @lastFailed);
	my $objComplete = $Default{poll_obj_complete};
	my $objError = $Default{poll_obj_error};
	my $pollTimer = $PollTimer/1000; # Convert to secs
	my ($mainLoopSleep, $mainLoopTime, $pollStartTime, $pollActHost, $objLastPollTime);

	if ($_[0]->isa($Package)) { # Method invoked as object method
		$self = shift;
		my @validArgs = ('poll_code', 'poll_timer', 'errmode');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}
	elsif (ref $_[0]) { # Method invoked with single argument array or hash ref
		$args{object_list} = shift;
	}
	else {
		my @validArgs = ('object_list', 'poll_code', 'object_complete', 'object_error', 'poll_timer', 'errmode', 'errmsg_format');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}
	if (defined $args{object_complete}) {
		if ($args{object_complete} =~ /^all|next$/i) {
			$objComplete = lc $args{object_complete};
		}
		else {
			carp "$pkgsub: Invalid value for 'object_complete' argument; ignoring";
		}
	}
	if (defined $args{object_error}) {
		if ($args{object_error} =~ /^return|ignore$/i) {
			$objError = lc $args{object_error};
		}
		else {
			carp "$pkgsub: Invalid value for 'object_error' argument; ignoring";
		}
	}
	if (defined $args{poll_timer}) {
		if ($args{poll_timer} =~ /\d+/) {
			$pollTimer = $args{poll_timer}/1000; # Convert to secs
		}
		else {
			carp "$pkgsub: Invalid value for 'poll_timer' argument; ignoring";
		}
	}
	if (defined $args{poll_code}) {
		unless (validCodeRef($args{poll_code})) {
			$args{poll_code} = undef;	# Only keep the argument if valid
			carp "$pkgsub: Argument 'poll_code' is not a valid code ref; ignoring";
		}
	}
	my $errmode = defined $args{errmode} ? parse_errmode($pkgsub, $args{errmode}) : ( defined $self ? $self->{errmode} : $Default{errmode} );
	my $msgFormat = defined $args{errmsg_format} ? $args{errmsg_format} : ( defined $self ? $self->{errmsg_format} : $Default{errmsg_format} );
	return _error(__FILE__, __LINE__, $errmode, "$pkgsub: No 'object_list' provided", $msgFormat) unless defined $self || defined $args{object_list};

	$pollStartTime = time;
	while (1) {
		$mainLoopTime = time;	# Record time before going over loop below
		($running, $completed, $failed) = (0,0,0);

		if ( defined $self ) { # Called in object oriented form; single object
			unless (defined $self->{POLL}) { # No poll structure exists, throw an error
				return _error(__FILE__, __LINE__, $errmode, "$pkgsub: No polling method was ever called for object", $msgFormat) if defined $args{errmode};
				return $self->error("$pkgsub: No polling method was ever called for object");
			}
			my $ok = _call_poll_method($self, 0, defined $args{errmode} ? $errmode : undef);
			# Return if completed or failed
			return $ok if $ok || !defined $ok;
			$running = 1;	# Ensures we always loop below
		}
		elsif ( ref $args{object_list} eq 'ARRAY' ) { # Called in non-objectoriented form; list as arg
			for my $i ( 0 .. $#{$args{object_list}} ) {
				my $obj = ${$args{object_list}}[$i];
				return _error(__FILE__, __LINE__, $errmode, "$pkgsub: Array element $i is not a valid object", $msgFormat) unless $obj->isa($Package);
				unless (defined $obj->{POLL}) { # No poll structure exists, throw an error
					return _error(__FILE__, __LINE__, $errmode, "$pkgsub: No polling method was ever called for object array element $i", $msgFormat) if defined $args{errmode};
					return $obj->error("$pkgsub: No polling method was ever called for object array element $i");
				}
				my $objStartTime = time;
				my $objTimeCredit = $objStartTime - (defined $objLastPollTime->[$i] ? $objLastPollTime->[$i] : $pollStartTime) - $pollTimer;
				my $ok = _call_poll_method($obj, $objTimeCredit, defined $args{errmode} ? $errmode : undef);
				if ($ok) {
					$completed++;
					unless ($obj->{POLLREPORTED}) {
						push (@lastCompleted, $i);
						$obj->{POLLREPORTED} = 1;
					}
				}
				elsif (!defined $ok) {
					$failed++;
					unless ($obj->{POLLREPORTED}) {
						push (@lastFailed, $i);
						$obj->{POLLREPORTED} = 1;
					}
				}
				else { $running++ }
				$objLastPollTime->[$i] = time;
				if ( ($objLastPollTime->[$i] - $objStartTime) > $pollTimer && $args{poll_code}) { # On slow poll methods, call activity between every host
					callCodeRef($args{poll_code}, $running, $completed, $failed, \@lastCompleted, \@lastFailed);
					$pollActHost = 1; # Make sure we don't run activity at end of cycle then
				}
				else {
					$pollActHost = 0; # Make sure we run activity at end of cycle
				}
			}
		}
		elsif ( ref $args{object_list} eq 'HASH' ) { # Called in non-objectoriented form; hash as arg
			foreach my $key ( keys %{$args{object_list}} ) {
				my $obj = ${$args{object_list}}{$key};
				return _error(__FILE__, __LINE__, $errmode, "$pkgsub: Hash key $key is not a valid object", $msgFormat) unless $obj->isa($Package);
				unless (defined $obj->{POLL}) { # No poll structure exists, throw an error
					return _error(__FILE__, __LINE__, $errmode, "$pkgsub: No polling method was ever called for object hash key $key", $msgFormat) if defined $args{errmode};
					return $obj->error("$pkgsub: No polling method was ever called for object hash key $key");
				}
				my $objStartTime = time;
				my $objTimeCredit = $objStartTime - (defined $objLastPollTime->{$key} ? $objLastPollTime->{$key} : $pollStartTime) - $pollTimer;
				my $ok = _call_poll_method($obj, $objTimeCredit, defined $args{errmode} ? $errmode : undef);
				if ($ok) {
					$completed++;
					unless ($obj->{POLLREPORTED}) {
						push (@lastCompleted, $key);
						$obj->{POLLREPORTED} = 1;
					}
				}
				elsif (!defined $ok) {
					$failed++;
					unless ($obj->{POLLREPORTED}) {
						push (@lastFailed, $key);
						$obj->{POLLREPORTED} = 1;
					}
				}
				else { $running++ }
				$objLastPollTime->{$key} = time;
				if ( ($objLastPollTime->{$key} - $objStartTime) > $pollTimer && $args{poll_code}) { # On slow poll methods, call activity between every host
					callCodeRef($args{poll_code}, $running, $completed, $failed, \@lastCompleted, \@lastFailed);
					$pollActHost = 1; # Make sure we don't run activity at end of cycle then
				}
				else {
					$pollActHost = 0; # Make sure we run activity at end of cycle
				}
			}
		}
		else {
			return _error(__FILE__, __LINE__, $errmode, "$pkgsub: 'object_list' is not a hash or array reference", $msgFormat);
		}

		# Check if we are done, before calling pollcode or doing cycle wait
		last if ($running == 0) || ($objComplete eq 'next' && @lastCompleted) || ($objError eq 'return' && @lastFailed);

		if ($args{poll_code} && !$pollActHost) { # If a valid activity coderef was supplied and we did not just perform this on last object..
			callCodeRef($args{poll_code}, $running, $completed, $failed, \@lastCompleted, \@lastFailed);
		}
		$pollActHost = 0;					# Reset flag
		$mainLoopSleep = $pollTimer - (time - $mainLoopTime);	# Timer less time it took to run through loop
		sleep($mainLoopSleep) if $mainLoopSleep > 0;		# Only if positive
	}

	return $running unless wantarray;
	return ($running, $completed, $failed, \@lastCompleted, \@lastFailed);
}


#################################### Methods to set/read Object variables ####################################

sub timeout { # Set/read timeout
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{timeout};
	if (defined $newSetting) {
		$self->{timeout} = $newSetting;
		if ($self->{TYPE} eq 'TELNET') {
			$self->{PARENT}->timeout($newSetting);
		}
	}
	return $currentSetting;
}


sub connection_timeout { # Set/read connection timeout
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{connection_timeout};
	$self->{connection_timeout} = $newSetting;
	return $currentSetting;
}


sub read_block_size { # Set/read read_block_size for either SSH or SERIAL (not applicable to TELNET)
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{read_block_size};
	$self->{read_block_size} = $newSetting if defined $newSetting;
	return $currentSetting;
}


sub blocking { # Set/read blocking/unblocking mode for reading connection and polling methods
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{blocking};
	$self->{blocking} = $newSetting if defined $newSetting;
	return $currentSetting;
}


sub read_attempts { # Set/read number of read attempts in readwait()
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{read_attempts};
	$self->{read_attempts} = $newSetting if defined $newSetting;
	return $currentSetting;
}


sub readwait_timer { # Set/read poll timer in readwait()
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{readwait_timer};
	$self->{readwait_timer} = $newSetting if defined $newSetting;
	return $currentSetting;
}


sub data_with_error { # Set/read behaviour flag for readwait() when some data read followed by a read error
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{data_with_error};
	$self->{data_with_error} = $newSetting if defined $newSetting;
	return $currentSetting;
}


sub return_reference { # Set/read return_reference mode
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{return_reference};
	$self->{return_reference} = $newSetting if defined $newSetting;
	return $currentSetting;
}


sub output_record_separator { # Set/read the Output Record Separator automaticaly appended by print() and cmd()
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{ors};
	if (defined $newSetting) {
		$self->{ors} = $newSetting;
		$self->{TELNETMODE} = $newSetting eq "\r" ? 0 : 1;
	}
	return $currentSetting;
}


sub prompt_credentials { # Set/read prompt_credentials mode
	my $pkgsub = "${Package}::prompt_credentials";
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{prompt_credentials};
	if (defined $newSetting) {
		if (ref($newSetting) && !validCodeRef($newSetting)) {
			carp "$pkgsub: First item of array ref must be a code ref";
		}
		$self->{prompt_credentials} = $newSetting;
	}
	return $currentSetting;
}


sub flush_credentials { # Clear the stored username, password, passphrases, if any
	my $self = shift;
	$self->{USERNAME} = $self->{PASSWORD} = $self->{PASSPHRASE} = undef;
	return 1;
}


sub prompt { # Read/Set object prompt
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{prompt};
	if (defined $newSetting) {
		$self->{prompt} = $newSetting;
		$self->{prompt_qr} = qr/$newSetting/;
	}
	return $currentSetting;
}


sub username_prompt { # Read/Set object username prompt
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{username_prompt};
	if (defined $newSetting) {
		$self->{username_prompt} = $newSetting;
		$self->{username_prompt_qr} = qr/$newSetting/;
	}
	return $currentSetting;
}


sub password_prompt { # Read/Set object password prompt
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{password_prompt};
	if (defined $newSetting) {
		$self->{password_prompt} = $newSetting;
		$self->{password_prompt_qr} = qr/$newSetting/;
	}
	return $currentSetting;
}


sub terminal_type { # Read/Set object terminal type
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{terminal_type};
	if (defined $newSetting) {
		$self->{terminal_type} = length $newSetting ? $newSetting : undef;
	}
	return $currentSetting;
}


sub window_size { # Read/Set object terminal window size
	my $pkgsub = "${Package}::window_size";
	my ($self, $width, $height) = @_;
	my @currentSetting = @{$self->{window_size}};
	if ((defined $width && !$width) || (defined $height && !$height)) { # Empty value undefines it
		$self->{window_size} = [];
	}
	elsif (defined $width && defined $height) {
		if ($width =~ /^\d+$/ && $height =~ /^\d+$/) {
			$self->{window_size} = [$width, $height];
		}
		else {
			carp "$pkgsub: Invalid window size; numeric width & height required";
		}
	}
	return @currentSetting;
}


sub report_query_status { # Enable/Disable ability to Reply Device OK ESC sequence to Query Device Status ESC sequence
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{report_query_status};
	$self->{report_query_status} = $newSetting if defined $newSetting;
	return $currentSetting;
}


sub errmode { # Set/read error mode
	my $pkgsub = "${Package}::errmode";
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{errmode};
	if ((defined $newSetting) && (my $newMode = parse_errmode($pkgsub, $newSetting))) {
		$self->{errmode} = $newMode;
	}
	return $currentSetting;
}


sub errmsg { # Set/read the last generated error message for the object
	my $pkgsub = "${Package}::errmsg";
	my $self = shift;
	my %args;
	if (@_ == 1) { # Method invoked with just the command argument
		$args{set_message} = shift;
	}
	else {
		my @validArgs = ('set_message', 'errmsg_format');
		%args = parseMethodArgs($pkgsub, \@_, \@validArgs);
	}
	my $msgFormat = defined $args{errmsg_format} ? $args{errmsg_format} : $self->{errmsg_format};
	my $errmsg = $self->{errmsg};
	$self->{errmsg} = $args{set_message} if defined $args{set_message};
	return _error_format($msgFormat, $errmsg);
}


sub errmsg_format { # Set/read the error message format
	my $pkgsub = "${Package}::errmsg_format";
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{errmsg_format};

	if (defined $newSetting) {
		if ($newSetting =~ /^\s*terse\s*$/i) { $newSetting = 'terse' }
		elsif ($newSetting =~ /^\s*verbose\s*$/i) { $newSetting = 'verbose' }
		elsif ($newSetting =~ /^\s*default\s*$/i) { $newSetting = 'default' }
		else {
			carp "$pkgsub: invalid format '$newSetting'; ignoring";
			$newSetting = undef;
		}
		$self->{errmsg_format} = $newSetting if defined $newSetting;
	}
	return $currentSetting;
}


sub debug { # Set/read debug level
	my ($self, $newSetting) = @_;
	my $currentSetting = $self->{debug};
	if (defined $newSetting && $newSetting != $currentSetting) {
		$self->{debug} = $newSetting;
		if ($self->{TYPE} eq 'SSH') {
			$self->{PARENT}->debug($newSetting & 2 ? 1 : 0);
		}
		elsif ($self->{TYPE} eq 'SERIAL') {
			if ($^O eq 'MSWin32') {
				Win32::SerialPort->set_test_mode_active(!($newSetting & 1));
				Win32::SerialPort::debug($newSetting & 2 ? 'ON' : 'OFF');
			}
			else {
				Device::SerialPort->set_test_mode_active(!($newSetting & 1));
				Device::SerialPort::debug($newSetting & 2 ? 'ON' : 'OFF');
			}
		}
	}
	return $currentSetting;
}


################################# Methods to read read-only Object variables #################################

sub parent { # Return the parent object
	my $self = shift;
	return $self->{PARENT};
}


sub socket { # Return the socket object
	my $self = shift;
	return $self->{SOCKET};
}


sub ssh_channel { # Return the SSH channel object
	my $self = shift;
	return $self->{SSHCHANNEL};
}


sub ssh_authentication { # Return the SSH authentication type performed
	my $self = shift;
	return $self->{SSHAUTH};
}


sub connection_type { # Return the connection type of this object
	my $self = shift;
	return $self->{TYPE};
}


sub host { # Return the host we connect to
	my $self = shift;
	return $self->{HOST};
}


sub port { # Return the TCP port / COM port for the connection
	my $self = shift;
	if ($self->{TYPE} eq 'SERIAL') {
		return $self->{COMPORT};
	}
	else {
		return $self->{TCPPORT};
	}
}


sub connected { # Returns true if a connection is in place
	my $self = shift;
	return !$self->eof;
}


sub last_prompt { # Return the last prompt obtained
	my $self = shift;
	return $self->{LASTPROMPT};
}


sub username { # Read the username; this might have been provided or prompted for by a method in this class
	my $self = shift;
	return $self->{USERNAME};
}


sub password { # Read the password; this might have been provided or prompted for by a method in this class
	my $self = shift;
	return $self->{PASSWORD};
}


sub passphrase { # Read the passphrase; this might have been provided or prompted for by a method in this class
	my $self = shift;
	return $self->{PASSPHRASE};
}


sub handshake { # Read the serial handshake used
	my $self = shift;
	return $self->{HANDSHAKE};
}


sub baudrate { # Read the serial baudrate used
	my $self = shift;
	return $self->{BAUDRATE};
}


sub parity { # Read the serial parity used
	my $self = shift;
	return $self->{PARITY};
}


sub databits { # Read the serial databits used
	my $self = shift;
	return $self->{DATABITS};
}


sub stopbits { # Read the serial stopbits used
	my $self = shift;
	return $self->{STOPBITS};
}


#################################### Methods for modules sub-classing Control::CLI ####################################

sub poll_struct { # Initialize the poll hash structure for a new method using it
	my ($self, $methodName, $codeRef, $blocking, $timeout, $errmode, $outputType, $outputRequested, $returnReference, $returnList) = @_;
	my $pollsub = "${Package}::poll_struct";

	if (defined $self->{POLL} && defined $self->{POLL}{complete} && $self->{POLL}{complete} == 0 ) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		my $pollOwner = $self->{POLL}{method};
		carp "$pollsub (called from $fileName line $lineNumber) $methodName is trampling over existing poll structure of $pollOwner";
	}

	$self->{POLL} = { # Initialize the base POLL structure
		method			=>	$methodName,
		coderef			=>	$codeRef,
		cache			=>	[],
		blocking		=>	$blocking,
		timeout			=>	$timeout,
		endtime			=>	undef,
		waittime		=>	undef,
		errmode			=>	$errmode,
		complete		=>	0,
		return_reference	=>	$returnReference,
		return_list		=>	$returnList,
		output_requested	=>	$outputRequested,
		output_type		=>	$outputType,
		output_result		=>	undef,
		output_buffer		=>	'',
		local_buffer		=>	'',
		read_buffer		=>	undef,
		already_polled		=>	undef,
		socket			=>	undef,
	};
	$self->{POLLREPORTED} = 0;
	$self->debugMsg(1,"	--> POLL : $methodName\n");
	return;
}


sub poll_reset { # Clears the existing poll structure, if any
	my $self = shift;
	my $methodName;

	return unless defined $self->{POLL};
	$methodName = $self->{POLL}{method};
	$methodName .= '-> ' . join('-> ', @{$self->{POLL}{cache}}) if @{$self->{POLL}{cache}};
	$self->{POLL} = undef;
	$self->debugMsg(1,"	--> POLL : undef (was $methodName)\n");
	return 1;
}


sub poll_struct_cache { # Cache selected poll structure keys into a sub polling structure
	my ($self, $cacheMethod, $timeout) = @_;
	my $pollsub = "${Package}::poll_struct_cache";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	$self->{POLL}{$cacheMethod}{cache}{output_buffer} = $self->{POLL}{output_buffer};
	$self->{POLL}{output_buffer} = '';

	$self->{POLL}{$cacheMethod}{cache}{output_result} = $self->{POLL}{output_result};
	$self->{POLL}{output_result} = '';

	$self->{POLL}{$cacheMethod}{cache}{local_buffer} = $self->{POLL}{local_buffer};
	$self->{POLL}{local_buffer} = '';

	if (defined $timeout) {
		$self->{POLL}{$cacheMethod}{cache}{timeout} = $self->{POLL}{timeout};
		$self->{POLL}{timeout} = $timeout;
	}

	my $cacheChain = @{$self->{POLL}{cache}} ? '--> ' . join(' --> ', @{$self->{POLL}{cache}}) : '';
	push( @{$self->{POLL}{cache}}, $cacheMethod); # Point cache location
	$self->debugMsg(1,"	--> POLL : $self->{POLL}{method} $cacheChain --> $cacheMethod\n");
	return;
}


sub poll_struct_restore { # Restore original poll structure from cached values and return cache method output
	my $self = shift;
	my $pollsub = "${Package}::poll_struct_restore";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	my $cacheMethod = pop( @{$self->{POLL}{cache}} );
	# Save the output buffer & result
	my $output_buffer = $self->{POLL}{output_buffer};
	my $output_result = $self->{POLL}{output_result};
	# Restore the cached keys
	foreach my $key (keys %{$self->{POLL}{$cacheMethod}{cache}}) {
		$self->{POLL}{$key} = $self->{POLL}{$cacheMethod}{cache}{$key};
	}
	# Undefine the method poll structure
	$self->{POLL}{$cacheMethod} = undef;
	my $cacheChain = @{$self->{POLL}{cache}} ? '--> ' . join(' --> ', @{$self->{POLL}{cache}}) : '';
	$self->debugMsg(1,"	--> POLL : $self->{POLL}{method} $cacheChain <-- $cacheMethod\n");
	# Return the output as reference
	return (\$output_buffer, \$output_result);
}


sub poll_return { # Method to return from poll methods
	my ($self, $ok) = @_;
	my $pollsub = "${Package}::poll_return";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}
	$self->{POLL}{already_polled} = undef; # Always reset this flag on exit

	if (@{$self->{POLL}{cache}}) { # Current polled method was called by another polled method
		return 0 if defined $ok && $ok == 0;		 # Never return any output on non-blocking not ready
		# If error or poll complete then restore cached output to poll structure and recover output, if any
		my ($output_bufRef, $output_resRef) = $self->poll_struct_restore;
		return unless defined $ok;			# Never return any output on error
		return 1 unless wantarray;			# No output requested
		return (1, $output_bufRef, $output_resRef); 	# Only return output, as reference, on success & wantarray
	}

	$self->{POLL}{complete} = $ok;	# Store status for next poll
	return $ok unless $self->{POLL}{output_requested} && $self->{POLL}{output_type};
	# If we did not return above, only in this case do we have to provide output
	my @output_list;
	if ($self->{POLL}{output_type} & 1) { # Provide Output_buffer
		my $output = $self->{POLL}{output_buffer}; # 1st store the output buffer
		$self->{POLL}{output_buffer} = ''; # Then clear it in the storage structure
		if ($self->{POLL}{return_reference}) {
			push(@output_list, \$output);
		}
		else {
			push(@output_list, $output);
		}
	}
	if ($self->{POLL}{output_type} & 2) { # Provide Output_result
		if (ref $self->{POLL}{output_result} eq 'ARRAY') { # If an array
			if ($self->{POLL}{return_list}) {
				push(@output_list, @{$self->{POLL}{output_result}});
			}
			else {
				push(@output_list, $self->{POLL}{output_result});
			}
		}
		else { # Anything else (scalar or hash ref)
			push(@output_list, $self->{POLL}{output_result});
		}
	}
	return ($ok, @output_list);
}


sub poll_sleep { # Method to handle sleep for poll methods (handles both blocking and non-blocking modes)
	my ($self, $pkgsub, $secs) = @_;
	my $pollsub = "${Package}::poll_sleep";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	if ($self->{POLL}{blocking}) { # In blocking mode
			sleep $secs;
	}
	else { # In non-blocking mode
		unless(defined $self->{POLL}{endtime}) { # Set endtime for timeout
			$self->{POLL}{endtime} = time + $secs;
		}
		return 0 unless time > $self->{POLL}{endtime}; # Sleep time not expired yet
	}
	return 1;
}


sub poll_open_socket { # Internal method to open TCP socket for either Telnet or SSH
	my ($self, $pkgsub, $host, $port) = @_;
	my $pollsub = "${Package}::poll_open_socket";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	if ($UseSocketIP) { # Use IO::Socket::IP if we can (works for both IPv4 & IPv6)

		# In non-blocking mode we will come back here, so open socket only 1st time
		unless (defined $self->{POLL}{socket}) {

			# In non-blocking mode need to set the connection endtime for timeouts
			unless ($self->{POLL}{blocking}) {
				if (defined $self->{POLL}{timeout}) { # If a connection_timeout is defined, use it
					$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
				}
				else { # If no connection_timeout is defined, fall back onto module's own default value for non-blocking connections
					$self->{POLL}{endtime} = time + $Default{connection_timeout_nb};
				}
			}

			$self->{POLL}{socket} = IO::Socket::IP->new(
				PeerHost => $host,
				PeerPort => $port,
				Blocking     => 0,	# Use non-blocking mode to enforce connection timeout
							# even if blocking connect()
			) or return $self->error("$pkgsub: cannot construct socket - $@");
		}

		while ( !$self->{POLL}{socket}->connect && ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) {
			my $wvec = '';
			vec( $wvec, fileno $self->{POLL}{socket}, 1 ) = 1;
			my $evec = '';
			vec( $evec, fileno $self->{POLL}{socket}, 1 ) = 1;

			if ($self->{POLL}{blocking}) { # In blocking mode perform connection timeout
				select( undef, $wvec, $evec, $self->{POLL}{timeout} )
					or return $self->error("$pkgsub: connection timeout expired");
			}
			else { # In non-blocking mode don't wait; just come out if not ready and timeout not expired
				select( undef, $wvec, $evec, 0 ) or do {
					return (0, undef) unless time > $self->{POLL}{endtime}; # Timeout not expired
					return $self->error("$pkgsub: connection timeout expired");  # Timeout expired
				};
			}
		}
		return $self->error("$pkgsub: unable to connect - $!") if $!;
	}
	else { # Use IO::Socket::INET (only IPv4 support)
		$self->{POLL}{socket} = IO::Socket::INET->new(
			PeerHost => $host,
			PeerPort => $port,
			Timeout => $self->{POLL}{timeout},
		) or return $self->error("$pkgsub: unable to establish socket - $@");
	}
	return (1, $self->{POLL}{socket});
}


sub poll_read { # Method to handle reads for poll methods (handles both blocking and non-blocking modes)
	my ($self, $pkgsub, $errmsg) = @_;
	my $pollsub = "${Package}::poll_read";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	if ($self->{POLL}{blocking}) { # In blocking mode
		$self->{POLL}{read_buffer} = $self->read(
					blocking => 1,
					timeout => $self->{POLL}{timeout},
					return_reference => 0,
					errmode => 'return',
					);
		unless (defined $self->{POLL}{read_buffer}) { # Here we catch errors since errmode = 'return'
			return $self->error("$pkgsub: $errmsg // ".$self->errmsg) if defined $errmsg;
			return; # Otherwise
		}
		return 1; # In blocking mode we come out here indicating we have read data
	}
	else { # In non-blocking mode
		if ($self->{POLL}{already_polled}) { # In non-blocking mode and if we already went round the calling loop once
			$self->{POLL}{already_polled} = undef; # Undefine it for next time
			$self->{POLL}{read_buffer} = undef; # Undefine it for next time
			return 0;
		}

		unless(defined $self->{POLL}{endtime}) { # Set endtime for timeout
			$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
		}

		$self->{POLL}{read_buffer} = $self->read(
					blocking => 0,
					return_reference => 0,
					errmode => 'return',
					);
		unless (defined $self->{POLL}{read_buffer}) { # Here we catch errors since errmode = 'return'
			return $self->error("$pkgsub: $errmsg // ".$self->errmsg) if defined $errmsg;
			return; # Otherwise
		}
		if (length $self->{POLL}{read_buffer}) { # We read something
			$self->{POLL}{already_polled} = 1; # Set it for next cycle
			$self->{POLL}{endtime} = undef; # Clear timeout endtime
			return 1; # This is effectively when we are done and $self->{POLL}{read_buffer} can be read by calling loop
		}

		# We read nothing from device
		if (time > $self->{POLL}{endtime}) { # Timeout has expired
			$self->{POLL}{endtime} = undef; # Clear timeout endtime
			$self->errmsg("$pollsub: Poll Read Timeout");
			return $self->error("$pkgsub: $errmsg // ".$self->errmsg) if defined $errmsg;
			return; # Otherwise
		}
		else { # Still within timeout
			return 0;
		}
	}
}


sub poll_readwait { # Method to handle readwait for poll methods (handles both blocking and non-blocking modes)
	my ($self, $pkgsub, $firstReadRequired, $readAttempts, $readwaitTimer, $errmsg, $dataWithError) = @_;
	$readAttempts = $self->{read_attempts} unless defined $readAttempts;
	$readwaitTimer = $self->{readwait_timer} unless defined $readwaitTimer;
	$dataWithError = $self->{data_with_error} unless defined $dataWithError;
	my $pollsub = "${Package}::poll_readwait";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	# Different read section for blocking and non-blocking modes
	if ($self->{POLL}{blocking}) { # In blocking mode use regular readwait() method
		$self->{POLL}{read_buffer} = $self->readwait(
				read_attempts => $readAttempts,
				readwait_timer => $readwaitTimer,
				data_with_error => $dataWithError,
				blocking => $firstReadRequired,
				timeout => $self->{POLL}{timeout},
				return_reference => 0,
				errmode => 'return',
				);
		unless (defined $self->{POLL}{read_buffer}) { # Here we catch errors since errmode = 'return'
			return $self->error("$pkgsub: $errmsg // ".$self->errmsg) if defined $errmsg;
			return; # Otherwise
		}
		return 1; # In non-blocking mode we come out here
	}
	else { # In non-blocking mode
		if ($self->{POLL}{already_polled}) { # In non-blocking mode and if we already went round the calling loop once
			$self->{POLL}{already_polled} = undef; # Undefine it for next time
			$self->{POLL}{read_buffer} = undef; # Undefine it for next time
			return 0;
		}

		if ($firstReadRequired && !defined $self->{POLL}{endtime}) { # First time we need to setup endtime timer
			$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
		}
		elsif (!$firstReadRequired && !defined $self->{POLL}{waittime}) { # First time, no timeout, but we need to setup wait timer directly
			$self->{POLL}{waittime} = time + $readwaitTimer/1000 * $readAttempts;
			$self->{POLL}{read_buffer} = ''; # Make sure read buffer is defined and empty
		}

		my $outref = $self->read(
					blocking => 0,
					return_reference => 1,
					errmode => 'return',
					);
		unless (defined $outref) { # Here we catch errors since errmode = 'return'
			if ($dataWithError && length $self->{POLL}{read_buffer}) { # Data_with_error processing
				$self->{POLL}{already_polled} = 1; # Set it for next cycle
				$self->{POLL}{endtime} = undef;  # Clear timeout endtime
				$self->{POLL}{waittime} = undef; # Clear waittime
				return 1; # We are done, available data in $self->{POLL}{read_buffer} can be read by calling loop, in spite of error
			}
			return $self->error("$pkgsub: $errmsg // ".$self->errmsg) if defined $errmsg;
			return; # Otherwise
		}
		if (length $$outref) { # We read something, reset wait timer
			$self->{POLL}{read_buffer} .= $$outref;
			$self->{POLL}{waittime} = time + $readwaitTimer/1000 * $readAttempts;
			return 0;
		}

		# We read nothing from device
		if (defined $self->{POLL}{waittime}) { # Some data already read; now just doing waittimer for more
			if (time > $self->{POLL}{waittime}) { # Wait timer has expired
				$self->{POLL}{already_polled} = 1; # Set it for next cycle
				$self->{POLL}{endtime} = undef;  # Clear timeout endtime
				$self->{POLL}{waittime} = undef; # Clear waittime
				return 1; # This is effectively when we are done and $self->{POLL}{read_buffer} can be read by calling loop
			}
			else { # Wait timer has not expired yet
				return 0;
			}
		}
		else { # No data read yet, regular timeout checking
			if (time > $self->{POLL}{endtime}) { # Timeout has expired
				$self->{POLL}{endtime} = undef; # Clear timeout endtime
				$self->errmsg("$pollsub: Poll Read Timeout");
				return $self->error("$pkgsub: $errmsg // ".$self->errmsg) if defined $errmsg;
				return; # Otherwise
			}
			else { # Still within timeout
				return 0;
			}
		}
	}
}


sub poll_connect { # Internal method to connect to host (used for both blocking & non-blocking modes)
	my $self = shift;
	my $pkgsub = shift;
	my $pollsub = "${Package}::connect";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	unless (defined $self->{POLL}{$pollsub}) { # Only applicable if called from another method already in polling mode
		my @validArgs = ('host', 'port', 'username', 'password', 'publickey', 'privatekey', 'passphrase',
				 'prompt_credentials', 'baudrate', 'parity', 'databits', 'stopbits', 'handshake',
				 'errmode', 'connection_timeout', 'terminal_type', 'window_size', 'callback',
				 'forcebaud', 'atomic_connect');
		my %args = parseMethodArgs($pkgsub, \@_, \@validArgs, 1);
		if (@_ && !%args) { # Legacy syntax
			($args{host}, $args{port}, $args{username}, $args{password}, $args{publickey}, $args{privatekey}, $args{passphrase}, $args{baudrate},
			 $args{parity}, $args{databits}, $args{stopbits}, $args{handshake}, $args{prompt_credentials}, $args{timeout}, $args{errmode}) = @_;
		}
		# In which case we need to setup the poll structure here (the main poll structure remains unchanged)
		$self->{POLL}{$pollsub} = { # Populate structure with method arguments/storage
			# Set method argument keys
			host			=>	$args{host},
			port			=>	$args{port},
			username		=>	defined $args{username} ? $args{username} : $self->{USERNAME},
			password		=>	defined $args{password} ? $args{password} : $self->{PASSWORD},
			publickey		=>	$args{publickey},
			privatekey		=>	$args{privatekey},
			passphrase		=>	defined $args{passphrase} ? $args{passphrase} : $self->{PASSPHRASE},
			baudrate		=>	$args{baudrate},
			parity			=>	$args{parity},
			databits		=>	$args{databits},
			stopbits		=>	$args{stopbits},
			handshake		=>	$args{handshake},
			prompt_credentials	=>	defined $args{prompt_credentials} ? $args{prompt_credentials} : $self->{prompt_credentials},
			terminal_type		=>	$args{terminal_type},
			window_size		=>	$args{window_size},
			callback		=>	$args{callback},
			forcebaud		=>	$args{forcebaud},
			atomic_connect		=>	$args{atomic_connect},
			# Declare method storage keys which will be used
			stage			=>	0,
			authPublicKey		=>	0,
			authPassword		=>	0,
			# Declare keys to be set if method called from another polled method
			errmode			=>	$args{errmode},
		};
		# Cache poll structure keys which this method will use
		$self->poll_struct_cache($pollsub, $args{connection_timeout});
	}
	my $connect = $self->{POLL}{$pollsub};
	local $self->{errmode} = $connect->{errmode} if defined $connect->{errmode};

	my $ok;

	if ($connect->{stage} < 1) { # Initial setup - do only once
		$self->{BUFFER} = '';
		$self->{LOGINSTAGE} = '';

		# For these arguments, go change the object setting, as it will need accessing via Net:Telnet callbacks
		$self->terminal_type($connect->{terminal_type}) if defined $connect->{terminal_type};
		$self->window_size(@{$connect->{window_size}}) if defined $connect->{window_size};
	}

	if ($self->{TYPE} eq 'TELNET') {
		if ($connect->{stage} < 1) { # Initial setup - do only once
			$connect->{stage}++; # Ensure we don't come back here in non-blocking mode
			return $self->poll_return($self->error("$pkgsub: No Telnet host provided")) unless defined $connect->{host};
			$self->{PARENT}->errmode('return');
			$self->{PARENT}->timeout($self->{timeout});
			$connect->{port} = $Default{tcp_port}{TELNET} unless defined $connect->{port};
			$self->{HOST} = $connect->{host};
			$self->{TCPPORT} = $connect->{port};
			if (!$self->{POLL}{blocking} && $connect->{atomic_connect}) {
				$self->{POLL}{blocking} = 1; # Switch into blocking mode during connect phase
				return $self->poll_return(0); # Next poll will be the atomic connect
			}
			else {
				$connect->{atomic_connect} = undef; # In blocking mode undefine it
			}
		}
		# TCP Socket setup and handoff to Net::Telnet object
		# Open Socket ourselves
		($ok, $self->{SOCKET}) = $self->poll_open_socket($pkgsub, $connect->{host}, $connect->{port});
		return $self->poll_return($ok) unless $ok;	# Covers 2 cases:
					# - errmode is 'return' and $ok = undef ; so we come out due to error
					# - $ok = 0 ; non-blocking mode; connection not ready yet

		# Give Socket to Net::Telnet
		$self->{PARENT}->fhopen($self->{SOCKET}) or return $self->poll_return($self->error("$pkgsub: unable to open Telnet over socket"));
		if ($^O eq 'MSWin32') {
			# We need this hack to workaround a bug introduced in Net::Telnet 3.04
			# see Net::Telnet bug report 94913: https://rt.cpan.org/Ticket/Display.html?id=94913
			my $telobj = *{$self->{PARENT}}->{net_telnet};
			if (exists $telobj->{select_supported} && !$telobj->{select_supported}) {
				# select_supported key is new in Net::Telnet 3.04 (does not exist in 3.03)
				# If we get here, it is because it did not get set correctly by our fhopen above, which means
				# we are using Net::Telnet 3.04 or a later version of it which still has not fixed the issue
				$telobj->{select_supported} = 1; # Workaround, we set it
			}
		}

		# Handle Telnet options
		$self->_handle_telnet_options;
		$self->{POLL}{blocking} = 0 if $connect->{atomic_connect}; # Restore non-blocking mode once connect complete
	}
	elsif ($self->{TYPE} eq 'SSH') {
		if ($connect->{stage} < 1) { # Initial setup - do only once
			$connect->{stage}++; # Ensure we don't come back here in non-blocking mode
			return $self->poll_return($self->error("$pkgsub: No SSH host provided")) unless defined $connect->{host};
			$connect->{port} = $Default{tcp_port}{SSH} unless defined $connect->{port};
			$self->{HOST} = $connect->{host};
			$self->{TCPPORT} = $connect->{port};
			if (!$self->{POLL}{blocking} && $connect->{atomic_connect}) {
				$self->{POLL}{blocking} = 1; # Switch into blocking mode during connect phase
				return $self->poll_return(0); # Next poll will be the atomic connect
			}
			else {
				$connect->{atomic_connect} = undef; # In blocking mode undefine it
			}
		}
		if ($connect->{stage} < 2) { # TCP Socket setup and handoff to Net::SSH2 object
			# Open Socket ourselves
			($ok, $self->{SOCKET}) = $self->poll_open_socket($pkgsub, $connect->{host}, $connect->{port});
			return $self->poll_return($ok) unless $ok;	# Covers 2 cases:
						# - errmode is 'return' and $ok = undef ; so we come out due to error
						# - $ok = 0 ; non-blocking mode; connection not ready yet
			$connect->{stage}++; # Ensure we don't come back here in non-blocking mode

			# Set the SO_LINGER option as Net::SSH2 would do
			$self->{SOCKET}->sockopt(&Socket::SO_LINGER, pack('SS', 0, 0));

			# Give Socket to Net::SSH2
			eval { # Older versions of Net::SSH2 need to be trapped so that we get desired error mode
				$ok = $self->{PARENT}->connect($self->{SOCKET});
			};
			return $self->poll_return($self->error("$pkgsub: " . $@)) if $@;
			return $self->poll_return($self->error("$pkgsub: SSH unable to connect")) unless $ok;
			return $self->poll_return(0) unless $self->{POLL}{blocking};
		}
		if ($connect->{stage} < 3) { # Check for callback (if user wants to verify device hostkey against known hosts)
			$connect->{stage}++; # Ensure we don't come back here in non-blocking mode
			if ($connect->{callback}) {
				if ( validCodeRef($connect->{callback}) ) {
					($ok, my $errmsg) = callCodeRef($connect->{callback}, $self);
					return $self->poll_return($self->error("$pkgsub: " . (defined $errmsg ? $errmsg : "SSH callback refused connection"))) unless $ok;
					return $self->poll_return(0) unless $self->{POLL}{blocking};
				}
				else {
					carp "$pkgsub: Callback is not a valid code ref; ignoring";
				}
			}
		}
		if ($connect->{stage} < 4) { # Find out available SSH authentication options
			$connect->{stage}++; # Ensure we don't come back here in non-blocking mode
			unless ( defined $connect->{username} ) {
				return $self->poll_return($self->error("$pkgsub: Username required for SSH authentication")) unless $connect->{prompt_credentials};
				$connect->{username} = promptCredential($connect->{prompt_credentials}, 'Clear', 'Username');
				# Reset timeout endtime
				$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
			}
			if ( !$self->{POLL}{blocking} && time > $self->{POLL}{endtime} ) { # Check if over time in non-blocking mode
				return $self->poll_return($self->error("$pkgsub: connection timeout expired (before auth_list)"));
			}
			my @authList = $self->{PARENT}->auth_list($connect->{username});
			foreach my $auth (@authList) {
				$connect->{authPublicKey} = 1 if $auth eq 'publickey';
				$connect->{authPassword} |= 1 if $auth eq 'password';			# bit1 = password
				$connect->{authPassword} |= 2 if $auth eq 'keyboard-interactive';	# bit2 = KI
			}
			$self->debugMsg(1,"SSH authentications accepted: ", \join(', ', @authList), "\n");
			$self->debugMsg(1,"authPublicKey flag = $connect->{authPublicKey} ; authPassword flag = $connect->{authPassword}\n");
			$self->{USERNAME} = $connect->{username};	# If we got here, we have a connection so store the username used
			return $self->poll_return(0) unless $self->{POLL}{blocking};
		}
		if ($connect->{stage} < 5) { # Try publickey authentication
			$connect->{stage}++; # Ensure we don't come back here in non-blocking mode
			if ($connect->{authPublicKey}) { # Try Public Key authentication...
				if (defined $connect->{publickey} && defined $connect->{privatekey}) { # ... if we have keys
					return $self->poll_return($self->error("$pkgsub: Public Key '$connect->{publickey}' not found"))
						unless -e $connect->{publickey};
					return $self->poll_return($self->error("$pkgsub: Private Key '$connect->{privatekey}' not found"))
						unless -e $connect->{privatekey};
					unless ($connect->{passphrase}) { # Passphrase not provided
						my $passphReq = passphraseRequired($connect->{privatekey});
						return $self->poll_return($self->error("$pkgsub: Unable to read Private key")) unless defined $passphReq;
						if ($passphReq) { # Passphrase is required
							return $self->poll_return($self->error("$pkgsub: Passphrase required for Private Key"))	unless $connect->{prompt_credentials};
							# We are allowed to prompt for it
							$connect->{passphrase} = promptCredential($connect->{prompt_credentials}, 'Hide', 'Passphrase for Private Key');
							# Reset timeout endtime
							$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
						}
					}
					if ( !$self->{POLL}{blocking} && time > $self->{POLL}{endtime} ) { # Check if over time in non-blocking mode
						return $self->poll_return($self->error("$pkgsub: connection timeout expired (before auth_publickey"));
					}
					$ok = $self->{PARENT}->auth_publickey(
										$connect->{username},
										$connect->{publickey},
										$connect->{privatekey},
										$connect->{passphrase},
										);
					if ($ok) { # Store the passphrase used if publickey authentication succeded
						$self->{PASSPHRASE} = $connect->{passphrase} if $connect->{passphrase};
						$self->{SSHAUTH} = 'publickey';
					}
					elsif ( !($connect->{authPassword} && (defined $connect->{password} || $connect->{prompt_credentials})) ) {
						# Unless we can try password authentication next, throw an error now
						return $self->poll_return($self->error("$pkgsub: SSH unable to publickey authenticate"));
					}
					return $self->poll_return(0) unless $self->{POLL}{blocking};
				}
				elsif (!$connect->{authPassword}) { # If we don't have the keys and publickey authentication was the only one possible
					return $self->poll_return($self->error("$pkgsub: Only publickey SSH authenticatication possible and no keys provided"));
				}
			}
		}
		if ($connect->{stage} < 6) { # Try password authentication
			$connect->{stage}++; # Ensure we don't come back here in non-blocking mode
			if ($connect->{authPassword} && !$self->{PARENT}->auth_ok) { # Try password authentication if not already publickey authenticated
				unless ( defined $connect->{password} ) {
					return $self->poll_return($self->error("$pkgsub: Password required for password authentication")) unless $connect->{prompt_credentials};
					$connect->{password} = promptCredential($connect->{prompt_credentials}, 'Hide', 'Password');
					# Reset timeout endtime
					$self->{POLL}{endtime} = time + $self->{POLL}{timeout};
				}
				if ( !$self->{POLL}{blocking} && time > $self->{POLL}{endtime} ) { # Check if over time in non-blocking mode
					return $self->poll_return($self->error("$pkgsub: connection timeout expired (before auth_password)"));
				}
				if ($connect->{authPassword} & 1) { # Use password authentication
					$self->{PARENT}->auth_password($connect->{username}, $connect->{password})
						or return $self->poll_return($self->error("$pkgsub: SSH unable to password authenticate"));
					$self->{SSHAUTH} = 'password';
				}
				elsif ($connect->{authPassword} & 2) { # Use keyboard-interactive authentication
					$self->{PARENT}->auth_keyboard($connect->{username}, $connect->{password})
						or return $self->poll_return($self->error("$pkgsub: SSH unable to password authenticate (using keyboard-interactive)"));
					$self->{SSHAUTH} = 'keyboard-interactive';
				}
				else {
					return $self->poll_return($self->error("$pkgsub: Error in processing password authentication options"));
				}
				# Store password used
				$self->{PASSWORD} = $connect->{password};
				return $self->poll_return(0) unless $self->{POLL}{blocking};
			}
		}
		# Make sure we are authenticated, in case neither publicKey nor password auth was accepted
		return $self->poll_return($self->error("$pkgsub: SSH unable to authenticate")) unless $self->{PARENT}->auth_ok;

		# Setup SSH channel
		if ( !$self->{POLL}{blocking} && time > $self->{POLL}{endtime} ) { # Check if over time in non-blocking mode
			return $self->poll_return($self->error("$pkgsub: connection timeout expired (before SSH channel setup)"));
		}
		$self->{SSHCHANNEL} = $self->{PARENT}->channel();	# Open an SSH channel
		$self->{PARENT}->blocking(0);				# Make the session non blocking for reads
		$self->{SSHCHANNEL}->ext_data('merge');			# Merge stderr onto regular channel
		$self->{SSHCHANNEL}->pty($self->{terminal_type}, undef, @{$self->{window_size}}); # Start interactive terminal; also set term type & window size
		$self->{SSHCHANNEL}->shell();				# Start shell on channel
		$self->{POLL}{blocking} = 0 if $connect->{atomic_connect}; # Restore non-blocking mode once connect complete
	}
	elsif ($self->{TYPE} eq 'SERIAL') {
		$connect->{handshake} = $Default{handshake} unless defined $connect->{handshake};
		$connect->{baudrate} = $Default{baudrate} unless defined $connect->{baudrate};
		$connect->{parity} = $Default{parity} unless defined $connect->{parity};
		$connect->{databits} = $Default{databits} unless defined $connect->{databits};
		$connect->{stopbits} = $Default{stopbits} unless defined $connect->{stopbits};
		$self->{PARENT}->handshake($connect->{handshake}) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Handshake"));
		$self->{PARENT}->baudrate($connect->{baudrate}) or do {
			# If error, could be Win32::SerialPort bug https://rt.cpan.org/Ticket/Display.html?id=120068
			if ($^O eq 'MSWin32' && $connect->{forcebaud}) { # With forcebaud we can force-set the desired baudrate
				$self->{PARENT}->{"_N_BAUD"} = $connect->{baudrate};
			}
			else { # Else we come out with error
				return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Baudrate"));
			}
		};
		$self->{PARENT}->parity($connect->{parity}) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Parity"));
		unless ($connect->{parity} eq 'none') { # According to Win32::SerialPort, parity_enable needs to be set when parity is not 'none'...
			$self->{PARENT}->parity_enable(1) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Parity_Enable"));
		}
		$self->{PARENT}->databits($connect->{databits}) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort DataBits"));
		$self->{PARENT}->stopbits($connect->{stopbits}) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort StopBits"));
		$self->{PARENT}->write_settings or return $self->poll_return($self->error("$pkgsub: Can't change Device_Control_Block: $^E"));
		#Set Read & Write buffers
		$self->{PARENT}->buffers($ComPortReadBuffer, 0) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Buffers"));
		if ($^O eq 'MSWin32') {
			$self->{PARENT}->read_interval($ComReadInterval) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Read_Interval"));
		}
		# Don't wait for each character
		defined $self->{PARENT}->read_char_time(0) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Read_Char_Time"));
		$self->{HANDSHAKE} = $connect->{handshake};
		$self->{BAUDRATE} = $connect->{baudrate};
		$self->{PARITY}	= $connect->{parity};
		$self->{DATABITS} = $connect->{databits};
		$self->{STOPBITS} = $connect->{stopbits};
		$self->{SERIALEOF} = 0;
	}
	else {
		return $self->poll_return($self->error("$pkgsub: Invalid connection mode"));
	}
	return $self->poll_return(1);
}


sub poll_login { # Method to handle login for poll methods (used for both blocking & non-blocking modes)
	my $self = shift;
	my $pkgsub = shift;
	my $pollsub = "${Package}::login";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	unless (defined $self->{POLL}{$pollsub}) { # Only applicable if called from another method already in polling mode
		my @validArgs = ('username', 'password', 'prompt_credentials', 'prompt', 'username_prompt', 'password_prompt', 'timeout', 'errmode');
		my %args = parseMethodArgs($pkgsub, \@_, \@validArgs, 1);
		if (@_ && !%args) { # Legacy syntax
			($args{username}, $args{password}, $args{prompt}, $args{username_prompt}, $args{password_prompt},
			 $args{prompt_credentials}, $args{timeout}, $args{errmode}) = @_;
		}
		# In which case we need to setup the poll structure here (the main poll structure remains unchanged)
		$self->{POLL}{$pollsub} = { # Populate structure with method arguments/storage
			# Set method argument keys
			username		=>	defined $args{username} ? $args{username} : $self->{USERNAME},
			password		=>	defined $args{password} ? $args{password} : $self->{PASSWORD},
			prompt			=>	defined $args{prompt} ? $args{prompt} : $self->{prompt_qr},
			username_prompt		=>	defined $args{username_prompt} ? $args{username_prompt} : $self->{username_prompt_qr},
			password_prompt		=>	defined $args{password_prompt} ? $args{password_prompt} : $self->{password_prompt_qr},
			prompt_credentials	=>	defined $args{prompt_credentials} ? $args{prompt_credentials} : $self->{prompt_credentials},
			# Declare method storage keys which will be used
			stage			=>	0,
			login_attempted		=>	undef,
			# Declare keys to be set if method called from another polled method
			errmode			=>	$args{errmode},
		};
		# Cache poll structure keys which this method will use
		$self->poll_struct_cache($pollsub, $args{timeout});
	}
	my $login = $self->{POLL}{$pollsub};
	local $self->{errmode} = $login->{errmode} if defined $login->{errmode};
	return $self->poll_return($self->error("$pkgsub: No connection to login to")) if $self->eof;

	if ($login->{stage} < 1) { # Initial loginstage checking - do only once
		$login->{stage}++; # Ensure we don't come back here in non-blocking mode
		if ($self->{LOGINSTAGE} eq 'username') { # Resume login from where it was left
			return $self->error("$pkgsub: Username required") unless $login->{username};
			$self->print(line => $login->{username}, errmode => 'return')
				or return $self->poll_return($self->error("$pkgsub: Unable to send username // ".$self->errmsg));
			$self->{LOGINSTAGE} = '';
			$login->{login_attempted} =1;
		}
		elsif ($self->{LOGINSTAGE} eq 'password') { # Resume login from where it was left
			return $self->error("$pkgsub: Password required") unless $login->{password};
			$self->print(line => $login->{password}, errmode => 'return')
				or return $self->poll_return($self->error("$pkgsub: Unable to send password // ".$self->errmsg));
			$self->{LOGINSTAGE} = '';
		}
	}
	# Enter login loop..
	do {{
		my $ok = $self->poll_read($pkgsub, 'Failed reading login prompt');
		return $self->poll_return($ok) unless $ok;

		$self->{POLL}{local_buffer} .= $self->{POLL}{read_buffer};  # Login buffer can get flushed along the way
		$self->{POLL}{output_buffer} .= $self->{POLL}{read_buffer}; # This buffer preserves all the output, in case it is requested

		if ($self->{POLL}{local_buffer} =~ /$login->{username_prompt}/) { # Handle username prompt
			if ($login->{login_attempted}) {
				return $self->poll_return($self->error("$pkgsub: Incorrect Username or Password"));
			}
			unless ($login->{username}) {
				if ($self->{TYPE} eq 'SSH') { # If an SSH connection, we already have the username
					$login->{username} = $self->{USERNAME};
				}
				else {
					unless ($login->{prompt_credentials}) {
						$self->{LOGINSTAGE} = 'username';
						return $self->poll_return($self->error("$pkgsub: Username required"));
					}
					$login->{username} = promptCredential($login->{prompt_credentials}, 'Clear', 'Username');
				}
			}
			$self->print(line => $login->{username}, errmode => 'return')
				or return $self->poll_return($self->error("$pkgsub: Unable to send username // ".$self->errmsg));
			$self->{LOGINSTAGE} = '';
			$login->{login_attempted} =1;
			$self->{POLL}{local_buffer} = '';
			next;
		}
		if ($self->{POLL}{local_buffer} =~ /$login->{password_prompt}/) { # Handle password prompt
			unless (defined $login->{password}) {
				unless (defined $login->{prompt_credentials}) {
					$self->{LOGINSTAGE} = 'password';
					return $self->poll_return($self->error("$pkgsub: Password required"));
				}
				$login->{password} = promptCredential($login->{prompt_credentials}, 'Hide', 'Password');
			}
			$self->print(line => $login->{password}, errmode => 'return')
				or return $self->poll_return($self->error("$pkgsub: Unable to send password // ".$self->errmsg));
			$self->{LOGINSTAGE} = '';
			$self->{POLL}{local_buffer} = '';
			next;
		}
	}} until ($self->{POLL}{local_buffer} =~ /($login->{prompt})/);
	$self->{LASTPROMPT} = $1;
	($self->{USERNAME}, $self->{PASSWORD}) = ($login->{username}, $login->{password}) if $login->{login_attempted};
	return $self->poll_return(1);
}


sub poll_waitfor { # Method to handle waitfor for poll methods (used for both blocking & non-blocking modes)
	my $self = shift;
	my $pkgsub = shift;
	my $pollsub = "${Package}::waitfor";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	unless (defined $self->{POLL}{$pollsub}) { # Only applicable if called from another method already in polling mode
		my @validArgs = ('match_list', 'timeout', 'errmode');
		my %args = parseMethodArgs($pkgsub, \@_, \@validArgs, 1);
		if (@_ && !%args) { # Legacy syntax
			($args{match_list}, $args{timeout}, $args{errmode}) = @_;
		}
		$args{match_list} = [$args{match_list}] unless ref($args{match_list}) eq "ARRAY";	# We want it as an array reference
		my @matchArray = grep {defined} @{$args{match_list}};			# Weed out undefined values, if any
		# In which case we need to setup the poll structure here (the main poll structure remains unchanged)
		$self->{POLL}{$pollsub} = { # Populate structure with method arguments/storage
			# Set method argument keys
			matchpat		=>	\@matchArray,
			# Declare method storage keys which will be used
			stage			=>	0,
			matchpat_qr		=>	undef,
			# Declare keys to be set if method called from another polled method
			errmode			=>	$args{errmode},
		};
		# Cache poll structure keys which this method will use
		$self->poll_struct_cache($pollsub, $args{timeout});
	}
	my $waitfor = $self->{POLL}{$pollsub};
	local $self->{errmode} = $waitfor->{errmode} if defined $waitfor->{errmode};
	return $self->poll_return($self->error("$pkgsub: Received eof from connection")) if $self->eof;

	if ($waitfor->{stage} < 1) { # 1st stage
		$waitfor->{stage}++; # Ensure we don't come back here in non-blocking mode
		return $self->poll_return($self->error("$pkgsub: Match pattern provided is undefined")) unless @{$waitfor->{matchpat}};
		eval { # Eval the patterns as they may be invalid
			@{$waitfor->{matchpat_qr}} = map {qr/^((?:.*\n?)*?)($_)/} @{$waitfor->{matchpat}}; # Convert match patterns into regex
			# This syntax did not work:          qr/^([\n.]*?)($_)/
		};
		if ($@) { # If we trap an error..
			$@ =~ s/ at \S+ line .+$//s;	# ..remove this module's line number
			return $self->poll_return($self->error("$pkgsub: $@"));
		}
	}

	READ: while (1) {
		my $ok = $self->poll_read($pkgsub, 'Failed waiting for output');
		return $self->poll_return($ok) unless $ok;
		$self->{POLL}{local_buffer} .= $self->{POLL}{read_buffer};

		foreach my $pattern (@{$waitfor->{matchpat_qr}}) {
			if ($self->{POLL}{local_buffer} =~ s/$pattern//) {
				($self->{POLL}{output_buffer}, $self->{POLL}{output_result}) = ($1, $2);
				last READ;
			}
		}
	}
	$self->{BUFFER} = $self->{POLL}{local_buffer} if length $self->{POLL}{local_buffer};
	return $self->poll_return(1);
}


sub poll_cmd { # Method to handle cmd for poll methods (used for both blocking & non-blocking modes)
	my $self = shift;
	my $pkgsub = shift;
	my $pollsub = "${Package}::cmd";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	unless (defined $self->{POLL}{$pollsub}) { # Only applicable if called from another method already in polling mode
		my @validArgs = ('command', 'prompt', 'timeout', 'errmode');
		my %args = parseMethodArgs($pkgsub, \@_, \@validArgs, 1);
		if (@_ && !%args) { # Legacy syntax
			($args{command}, $args{prompt}, $args{timeout}, $args{errmode}) = @_;
		}
		# In which case we need to setup the poll structure here (the main poll structure remains unchanged)
		$self->{POLL}{$pollsub} = { # Populate structure with method arguments/storage
			# Set method argument keys
			command			=>	$args{command},
			prompt			=>	defined $args{prompt} ? $args{prompt} : $self->{prompt_qr},
			# Declare method storage keys which will be used
			stage			=>	0,
			cmdEchoRemoved		=>	0,
			# Declare keys to be set if method called from another polled method
			errmode			=>	$args{errmode},
		};
		# Cache poll structure keys which this method will use
		$self->poll_struct_cache($pollsub, $args{timeout});
	}
	my $cmd = $self->{POLL}{$pollsub};
	local $self->{errmode} = $cmd->{errmode} if defined $cmd->{errmode};
	return $self->poll_return($self->error("$pkgsub: No connection to send cmd to")) if $self->eof;

	if ($cmd->{stage} < 1) { # Send command - do only once
		$cmd->{stage}++; # Ensure we don't come back here in non-blocking mode

		# Flush any unread data which might be pending
		$self->read(blocking => 0);

		# Send the command
		$self->print(line => $cmd->{command}, errmode => 'return')
			or return $self->poll_return($self->error("$pkgsub: Unable to send CLI command: $cmd->{command} // ".$self->errmsg));
	}

	# Wait for next prompt
	do {
		my $ok = $self->poll_read($pkgsub, 'Failed after sending command');
		return $self->poll_return($ok) unless $ok;

		if ($cmd->{cmdEchoRemoved}) { # Initial echoed command was already removed from output
			$self->{POLL}{local_buffer} .= $self->{POLL}{read_buffer};	# Add new output
			my $lastLine = stripLastLine(\$self->{POLL}{local_buffer});	# Remove incomplete last line if any
			$self->{POLL}{output_buffer} .= $self->{POLL}{local_buffer};	# This buffer preserves all the output
			$self->{POLL}{local_buffer} = $lastLine;			# Keep incomplete lines in this buffer
		}
		else { # We have not yet received a complete line
			$self->{POLL}{local_buffer} .= $self->{POLL}{read_buffer};  # Use this buffer until we can strip the echoed command
			if ($self->{POLL}{local_buffer} =~ s/^.*\n//) { # We can remove initial echoed command from output
				my $lastLine = stripLastLine(\$self->{POLL}{local_buffer});	# Remove incomplete last line if any
				$self->{POLL}{output_buffer} = $self->{POLL}{local_buffer};	# Copy it across; it can now be retrieved
				$self->{POLL}{local_buffer} = $lastLine;			# Keep incomplete lines in this buffer
				$cmd->{cmdEchoRemoved} = 1;
			}
		}
	} until $self->{POLL}{local_buffer} =~ s/($cmd->{prompt})//;
	$self->{LASTPROMPT} = $1;
	return $self->poll_return(1);
}


sub poll_change_baudrate { # Method to handle change_baudrate for poll methods (used for both blocking & non-blocking modes)
	my $self = shift;
	my $pkgsub = shift;
	my $pollsub = "${Package}::change_baudrate";

	unless ($self->{POLLING}) { # Sanity check
		my (undef, $fileName, $lineNumber) = caller;
		croak "$pollsub (called from $fileName line $lineNumber) can only be used within polled methods";
	}

	unless (defined $self->{POLL}{$pollsub}) { # Only applicable if called from another method already in polling mode
		my @validArgs = ('baudrate', 'parity', 'databits', 'stopbits', 'handshake', 'errmode', 'forcebaud');
		my %args = parseMethodArgs($pkgsub, \@_, \@validArgs, 1);
		if (@_ && !%args) { # Legacy syntax
			($args{baudrate}, $args{parity}, $args{databits}, $args{stopbits}, $args{handshake}, $args{errmode}) = @_;
		}
		# In which case we need to setup the poll structure here (the main poll structure remains unchanged)
		$self->{POLL}{$pollsub} = { # Populate structure with method arguments/storage
			# Set method argument keys
			baudrate		=>	defined $args{baudrate} ? $args{baudrate} : $self->{BAUDRATE},
			parity			=>	defined $args{parity} ? $args{parity} : $self->{PARITY},
			databits		=>	defined $args{databits} ? $args{databits} : $self->{DATABITS},
			stopbits		=>	defined $args{stopbits} ? $args{stopbits} : $self->{STOPBITS},
			handshake		=>	defined $args{handshake} ? $args{handshake} : $self->{HANDSHAKE},
			forcebaud		=>	$args{forcebaud},
			# Declare method storage keys which will be used
			stage			=>	0,
			# Declare keys to be set if method called from another polled method
			errmode			=>	$args{errmode},
		};
		# Cache poll structure keys which this method will use
		$self->poll_struct_cache($pollsub);
	}
	my $changeBaud = $self->{POLL}{$pollsub};
	local $self->{errmode} = $changeBaud->{errmode} if defined $changeBaud->{errmode};

	return $self->poll_return($self->error("$pkgsub: Cannot change baudrate on Telnet/SSH")) unless $self->{TYPE} eq 'SERIAL';
	return $self->poll_return($self->error("$pkgsub: No serial connection established yet")) if $self->{SERIALEOF};

	if ($changeBaud->{stage} < 1) { # 1st stage
		$self->{PARENT}->write_done(1); # Needed to flush writes before closing with Device::SerialPort
		$changeBaud->{stage}++; # Move to 2nd stage
	}
	if ($changeBaud->{stage} < 2) { # 2nd stage - delay
		my $ok = $self->poll_sleep($pkgsub, $ChangeBaudDelay/1000);
		return $self->poll_return($ok) unless $ok;
		$changeBaud->{stage}++; # Move to next stage
	}
	$self->{PARENT}->close;
	$self->{SERIALEOF} = 1;	# If all goes well we'll set this back to 0 on exit
	if ($^O eq 'MSWin32') {
		$self->{PARENT} = Win32::SerialPort->new($self->{COMPORT}, !($self->{debug} & 1))
			or return $self->poll_return($self->error("$pkgsub: Cannot re-open serial port '$self->{COMPORT}'"));
	}
	else {
		$self->{PARENT} = Device::SerialPort->new($self->{COMPORT}, !($self->{debug} & 1))
			or return $self->poll_return($self->error("$pkgsub: Cannot re-open serial port '$self->{COMPORT}'"));
	}
	$self->{PARENT}->handshake($changeBaud->{handshake}) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Handshake"));
	$self->{PARENT}->baudrate($changeBaud->{baudrate}) or do {
		# If error, could be Win32::SerialPort bug https://rt.cpan.org/Ticket/Display.html?id=120068
		if ($^O eq 'MSWin32' && $changeBaud->{forcebaud}) { # With forcebaud we can force-set the desired baudrate
			$self->{PARENT}->{"_N_BAUD"} = $changeBaud->{baudrate};
		}
		else { # Else we come out with error
			return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Baudrate"));
		}
	};
	$self->{PARENT}->parity($changeBaud->{parity}) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Parity"));
	unless ($changeBaud->{parity} eq 'none') { # According to Win32::SerialPort, parity_enable needs to be set when parity is not 'none'...
		$self->{PARENT}->parity_enable(1) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Parity_Enable"));
	}
	$self->{PARENT}->databits($changeBaud->{databits}) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort DataBits"));
	$self->{PARENT}->stopbits($changeBaud->{stopbits}) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort StopBits"));
	$self->{PARENT}->write_settings or return $self->poll_return($self->error("$pkgsub: Can't change Device_Control_Block: $^E"));
	#Set Read & Write buffers
	$self->{PARENT}->buffers($ComPortReadBuffer, 0) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Buffers"));
	if ($^O eq 'MSWin32') {
		$self->{PARENT}->read_interval($ComReadInterval) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Read_Interval"));
	}
	# Don't wait for each character
	defined $self->{PARENT}->read_char_time(0) or return $self->poll_return($self->error("$pkgsub: Can't set SerialPort Read_Char_Time"));
	$self->{BAUDRATE} = $changeBaud->{baudrate};
	$self->{PARITY}	= $changeBaud->{parity};
	$self->{DATABITS} = $changeBaud->{databits};
	$self->{STOPBITS} = $changeBaud->{stopbits};
	$self->{HANDSHAKE} = $changeBaud->{handshake};
	$self->{SERIALEOF} = 0;
	return $self->poll_return(1);
}


sub debugMsg { # Print a debug message
	my $self = shift;
	if (shift() & $self->{debug}) {
		my $string1 = shift();
		my $stringRef = shift() || \"";#" Ultraedit hack!
		my $string2 = shift() || "";
		print $string1, $$stringRef, $string2;
	}
	return;
}


########################################## Internal Private Methods ##########################################

sub _check_query { # Internal method to process Query Device Status escape sequences
	my ($self, $pkgsub, $bufRef) = @_;
	if (length $self->{QUERYBUFFER}) { # If an escape sequence fragment was cashed
		$$bufRef = join('', $self->{QUERYBUFFER}, $$bufRef); # prepend it to new output
		$self->{QUERYBUFFER} = '';
	}
	if ($$bufRef =~ /(\e(?:\[.?)?)$/){ # If output stream ends with \e, or \e[ or \e[.
		# We could be looking at an escape sequence fragment; we check if it partially matches $VT100_QueryDeviceStatus
		my $escFrag = $1;
		if ($VT100_QueryDeviceStatus =~ /^\Q$escFrag\E/){	# If it does,
			$$bufRef =~ s/\Q$escFrag\E$//;			# we strip it
			$self->{QUERYBUFFER} .= $escFrag;		# and cache it
		}
	}
	return unless $$bufRef =~ s/\Q$VT100_QueryDeviceStatus\E//go;
	# A Query Device Status escape sequence was found and removed from output buffer
	$self->_put($pkgsub, \$VT100_ReportDeviceOk); # Send a Report Device OK escape sequence
	return;
}


sub _read_buffer { # Internal method to read (and clear) any data cached in object buffer
	my ($self, $returnRef) = @_;
	my $buffer = $self->{BUFFER};
	$self->{BUFFER} = '';
	# $buffer will always be defined; worst case an empty string
	return $returnRef ? \$buffer : $buffer;
}


sub _read_blocking { # Internal read method; data must be read or we timeout
	my ($self, $pkgsub, $timeout, $returnRef) = @_;
	my ($buffer, $startTime);

	until (length $buffer) {
		$startTime = time; # Record start time
		if ($self->{TYPE} eq 'TELNET') {
			$buffer = $self->{PARENT}->get(Timeout => $timeout);
			return $self->error("$pkgsub: Received eof from connection") if $self->eof;
			return $self->error("$pkgsub: Telnet ".$self->{PARENT}->errmsg) unless defined $buffer;
		}
		elsif ($self->{TYPE} eq 'SSH') {
			return $self->error("$pkgsub: No SSH channel to read from") unless defined $self->{SSHCHANNEL};
			$self->{SSHCHANNEL}->read($buffer, $self->{read_block_size});
			unless (defined $buffer && length $buffer) {
				return $self->error("$pkgsub: Received eof from connection") if $self->eof;
				my @poll = { handle => $self->{SSHCHANNEL}, events => ['in'] };
				unless ($self->{PARENT}->poll($timeout*1000, \@poll) && $poll[0]->{revents}->{in}) {
					return $self->error("$pkgsub: SSH read timeout");
				}
				my $inBytes = $self->{SSHCHANNEL}->read($buffer, $self->{read_block_size});
				return $self->error("$pkgsub: SSH channel read error") unless defined $inBytes;
			}
			_log_print($self->{INPUTLOGFH}, \$buffer) if defined $self->{INPUTLOGFH};
			_log_dump('<', $self->{DUMPLOGFH}, \$buffer) if defined $self->{DUMPLOGFH};
		}
		elsif ($self->{TYPE} eq 'SERIAL') {
			return $self->error("$pkgsub: Received eof from connection") if $self->{SERIALEOF};
			if ($^O eq 'MSWin32') { # Win32::SerialPort
				my $inBytes;
				# Set timeout in millisecs
				local $SIG{__WARN__} = sub {}; # Disable carp from Win32::SerialPort
				$self->{PARENT}->read_const_time($timeout == 0 ? 1 : $timeout * 1000) or do {
					$self->{PARENT}->close;
					$self->{SERIALEOF} = 1;
					return $self->error("$pkgsub: Unable to read serial port");
				};
				($inBytes, $buffer) = $self->{PARENT}->read($self->{read_block_size});
				return $self->error("$pkgsub: Serial Port read timeout") unless $inBytes;
			}
			else { # Device::SerialPort; we handle polling ourselves
				# Wait defined millisecs during every read
				$self->{PARENT}->read_const_time($PollTimer) or do {
					$self->{PARENT}->close;
					$self->{SERIALEOF} = 1;
					return $self->error("$pkgsub: Unable to read serial port");
				};
				my $inBytes;
				my $ticks = 0;
				my $ticksTimeout = $timeout*$PollTimer/10;
				do {
					if ($ticks++ > $ticksTimeout) {
						return $self->error("$pkgsub: Serial port read timeout");
					}
					($inBytes, $buffer) = $self->{PARENT}->read($self->{read_block_size});
				} until $inBytes > 0;
			}
			_log_print($self->{INPUTLOGFH}, \$buffer) if defined $self->{INPUTLOGFH};
			_log_dump('<', $self->{DUMPLOGFH}, \$buffer) if defined $self->{DUMPLOGFH};
		}
		else {
			return $self->error("$pkgsub: Invalid connection mode");
		}
		# Check for Query Device Status escape sequences and process a reply if necessary
		if ($self->{report_query_status}){
			$self->_check_query($pkgsub, \$buffer);
			unless (length $buffer) { # If buffer was just a Query Device Status escape sequence we now have an empty buffer
				$timeout -= (time - $startTime);	# Re-calculate a reduced timeout value, to perform next read cycle
				return $self->error("$pkgsub: Read timeout with report_query_status active") if $timeout <= 0;
			}
		}
	}
	# $buffer should always be a defined, non-empty string
	return $returnRef ? \$buffer : $buffer;
}


sub _read_nonblocking { # Internal read method; if no data available return immediately
	my ($self, $pkgsub, $returnRef) = @_;
	my $buffer;

	if ($self->{TYPE} eq 'TELNET') {
		$buffer = $self->{PARENT}->get(Timeout => 0);
		return $self->error("$pkgsub: Received eof from connection") if $self->eof;
		$buffer = '' unless defined $buffer;
	}
	elsif ($self->{TYPE} eq 'SSH') {
		return $self->error("$pkgsub: No SSH channel to read from") unless defined $self->{SSHCHANNEL};
		$self->{SSHCHANNEL}->read($buffer, $self->{read_block_size});
		# With Net::SSH2 0.58 & libssh2 1.5.0 line below was not necessary, as an emty read would leave $buffer defined and empty
		# But with Net::SSH2 0.63 & libssh2 1.7.0 this is no longer the case; now an empty read returns undef as both method return value and $buffer
		$buffer = '' unless defined $buffer;
		if (length $buffer) {
			_log_print($self->{INPUTLOGFH}, \$buffer) if defined $self->{INPUTLOGFH};
			_log_dump('<', $self->{DUMPLOGFH}, \$buffer) if defined $self->{DUMPLOGFH};
		}
	}
	elsif ($self->{TYPE} eq 'SERIAL') {
		return $self->error("$pkgsub: Received eof from connection") if $self->{SERIALEOF};
		my $inBytes;
		local $SIG{__WARN__} = sub {}; # Disable carp from Win32::SerialPort
		# Set timeout to nothing (1ms; Win32::SerialPort does not like 0)
		$self->{PARENT}->read_const_time(1) or do {
			$self->{PARENT}->close;
			$self->{SERIALEOF} = 1;
			return $self->error("$pkgsub: Unable to read serial port");
		};
		($inBytes, $buffer) = $self->{PARENT}->read($self->{read_block_size});
		return $self->error("$pkgsub: Serial port read error") unless defined $buffer;
		if (length $buffer) {
			_log_print($self->{INPUTLOGFH}, \$buffer) if defined $self->{INPUTLOGFH};
			_log_dump('<', $self->{DUMPLOGFH}, \$buffer) if defined $self->{DUMPLOGFH};
		}
	}
	else {
		return $self->error("$pkgsub: Invalid connection mode");
	}
	# Check for Query Device Status escape sequences and process a reply if necessary
	$self->_check_query($pkgsub, \$buffer) if length $buffer && $self->{report_query_status};

	# Pre-pend local buffer if not empty
	$buffer = join('', $self->_read_buffer(0), $buffer) if length $self->{BUFFER};

	# If nothing was read, $buffer should be a defined, empty string
	return $returnRef ? \$buffer : $buffer;
}


sub _put { # Internal write method
	my ($self, $pkgsub, $outref) = @_;

	return $self->error("$pkgsub: No connection to write to") if $self->eof;

	if ($self->{TYPE} eq 'TELNET') {
		$self->{PARENT}->put(
			String		=> $$outref,
			Telnetmode	=> $self->{TELNETMODE},
		) or return $self->error("$pkgsub: Telnet ".$self->{PARENT}->errmsg);
	}
	elsif ($self->{TYPE} eq 'SSH') {
		return $self->error("$pkgsub: No SSH channel to write to") unless defined $self->{SSHCHANNEL};
		print {$self->{SSHCHANNEL}} $$outref;
		_log_print($self->{OUTPUTLOGFH}, $outref) if defined $self->{OUTPUTLOGFH};
		_log_dump('>', $self->{DUMPLOGFH}, $outref) if defined $self->{DUMPLOGFH};
	}
	elsif ($self->{TYPE} eq 'SERIAL') {
		my $countOut = $self->{PARENT}->write($$outref);
		return $self->error("$pkgsub: Serial port write failed") unless $countOut;
		return $self->error("$pkgsub: Serial port write incomplete") if $countOut != length($$outref);
		_log_print($self->{OUTPUTLOGFH}, $outref) if defined $self->{OUTPUTLOGFH};
		_log_dump('>', $self->{DUMPLOGFH}, $outref) if defined $self->{DUMPLOGFH};
	}
	else {
		return $self->error("$pkgsub: Invalid connection mode");
	}
	return 1;
}


sub _log_print { # Print output to log file (input, output or dump); taken from Net::Telnet
	my ($fh, $dataRef) = @_;

	local $\ = '';
	if (ref($fh) and ref($fh) ne "GLOB") {  # fh is blessed ref
		$fh->print($$dataRef);
	}
	else {  # fh isn't blessed ref
		print $fh $$dataRef;
	}
	return 1;
}


sub _log_dump { # Dump log procedure; copied and modified directly from Net::Telnet for use with SSH/Serial access
	my ($direction, $fh, $dataRef) = @_;
	my ($hexvals, $line);
	my ($addr, $offset) = (0, 0);
	my $len = length($$dataRef);

	# Print data in dump format.
	while ($len > 0) { # Convert up to the next 16 chars to hex, padding w/ spaces.
		if ($len >= 16) {
			$line = substr($$dataRef, $offset, 16);
		}
		else {
			$line = substr($$dataRef, $offset, $len);
		}
		$hexvals = unpack("H*", $line);
		$hexvals .= ' ' x (32 - length $hexvals);

		# Place in 16 columns, each containing two hex digits.
		$hexvals = sprintf("%s %s %s %s  " x 4, unpack("a2" x 16, $hexvals));

		# For the ASCII column, change unprintable chars to a period.
		$line =~ s/[\000-\037,\177-\237]/./g;

		# Print the line in dump format.
		_log_print($fh, \sprintf("%s 0x%5.5lx: %s%s\n", $direction, $addr, $hexvals, $line));

		$addr += 16;
		$offset += 16;
		$len -= 16;
	}
	_log_print($fh, \"\n") if $$dataRef;#" Ultraedit hack!
	return 1;
}


sub _error_format { # Format the error message
	my ($msgFormat, $errmsg) = @_;

	return ucfirst $errmsg if $msgFormat =~ /^\s*verbose\s*$/i;
	$errmsg =~ s/\s+\/\/\s+.*$//;
	return ucfirst $errmsg if $msgFormat =~ /^\s*default\s*$/i || $msgFormat !~ /^\s*terse\s*$/i;
	$errmsg =~ s/^(?:[^:]+::)+[^:]+:\s+//;
	return ucfirst $errmsg; # terse
}


sub _error { # Internal method to perfom error mode action
	my ($fileName, $lineNumber, $mode, $errmsg, $msgFormat) = @_;

	$errmsg = _error_format($msgFormat, $errmsg);

	if (defined $mode) {
		if (ref($mode)) {
			callCodeRef($mode, $errmsg);
			return;
		}
		return if $mode eq 'return';
		croak "\n$errmsg" if $mode eq 'croak';
		die "\n$errmsg at $fileName line $lineNumber\n" if $mode eq 'die';
	}
	# Else (should never happen..)
	croak "\nInvalid errmode! Defaulting to croak\n$errmsg";
}


sub _call_poll_method { # Call object's poll method and optionally alter and then restore its error mode in doing so
	my ($self, $timeCredit, $errmode) = @_;
	my $errmodecache;

	unless ($self->{POLLREPORTED}) {
		if (defined $errmode) { # Store object's poll errormode and replace it with new error mode
			$errmodecache = $self->{POLL}{errmode};
			$self->{POLL}{errmode} = $errmode;
		}
		if ($timeCredit > 0 && defined $self->{POLL}{endtime}) { # We are going to increase the object's timeout by a credit amount
			$self->{POLL}{endtime} = $self->{POLL}{endtime} + $timeCredit;
			$self->debugMsg(1," - Timeout Credit of : ", \$timeCredit, " seconds\n");
		}
		$self->debugMsg(1," - Timeout Remaining : ", \($self->{POLL}{endtime} - time), " seconds\n") if defined $self->{POLL}{endtime};
	}

	# Call object's poll method
	my $ok = $self->{POLL}{coderef}->($self);

	unless ($self->{POLLREPORTED}) {
		$self->debugMsg(1," - Error: ", \$self->errmsg, "\n") unless defined $ok;
		# Restore original object poll error mode if necessary
		$self->{POLL}{errmode} = $errmodecache if defined $errmode;
	}
	return $ok;
}


sub _setup_telnet_option { # Sets up specified telnet option
	my ($self, $telobj, $option) = @_;

	$self->{PARENT}->option_accept(Do => $option);
	my $telcmd  = "\377\373" . pack("C", $option);  # will command
	$telobj->{unsent_opts} .= $telcmd;
	Net::Telnet::_log_option($telobj->{opt_log}, "SENT", "Will", $option) if defined &Net::Telnet::_log_option && $telobj->{opt_log};
	$self->debugMsg(1,"Telnet Option ", \$Net::Telnet::Telopts[$option], " Accept-Do + Send-Will\n");
	return;
}


sub _handle_telnet_options { # Sets up telnet options if we need them
	my $self = shift;
	my $telobj = *{$self->{PARENT}}->{net_telnet};

	_setup_telnet_option($self, $telobj, &TELOPT_TTYPE) if defined $self->{terminal_type}; # Only if a terminal type set for object
	_setup_telnet_option($self, $telobj, &TELOPT_NAWS) if @{$self->{window_size}}; # Only if a window size set for object

	# Send WILL for options now
	Net::Telnet::_flush_opts($self->{PARENT}) if defined &Net::Telnet::_flush_opts && length $telobj->{unsent_opts};
	return;
}

sub _telnet_opt_callback { # This is the callback setup for dealing with Telnet option negotiation
	my ($telslf, $option, $is_remote, $is_enabled, $was_enabled, $opt_bufpos) = @_;
	my $telobj = *$telslf->{net_telnet};
	my $self = $telobj->{$Package}; # Retrieve our object that we planted within the Net::Telnet one

	if ($option == &TELOPT_NAWS && @{$self->{window_size}}) {
		my $telcmd = pack("C9", &TELNET_IAC, &TELNET_SB, &TELOPT_NAWS, 0, $self->{window_size}->[0], 0, $self->{window_size}->[1], &TELNET_IAC, &TELNET_SE);
		# We activated option_accept for TELOPT_NAWS, so Net::Telnet queues a WILL response; but we already sent a Will in _setup_telnet_option
		my $telrmv = pack("C3", &TELNET_IAC, &TELNET_WILL, &TELOPT_NAWS);
		$telobj->{unsent_opts} =~ s/$telrmv/$telcmd/; # So replace WILL response queued by Net::Telnet with our SB response
		if (defined &Net::Telnet::_log_option && $telobj->{opt_log}) { # Net::Telnet already added a SENT WILL in the option log, so rectify
			Net::Telnet::_log_option($telobj->{opt_log}, "Not-SENT", "WILL", $option) ;
			Net::Telnet::_log_option($telobj->{opt_log}, "Instead-SENT(".join(' x ', @{$self->{window_size}}).")", "SB", $option);
		}
		$self->debugMsg(1,"Telnet Option Callback TELOPT_NAWS; sending sub-option negotiation ", \join(' x ', @{$self->{window_size}}), "\n");
	}
	return 1;
}


sub _telnet_subopt_callback { # This is the callback setup for dealing with Telnet sub-option negotiation
	my ($telslf, $option, $parameters) = @_;
	my $telobj = *$telslf->{net_telnet};
	my $self = $telobj->{$Package}; # Retrieve our object that we planted within the Net::Telnet one

	# Integrate with Net::Telnet's option_log
	Net::Telnet::_log_option($telobj->{opt_log}, "RCVD", "SB", $option) if defined &Net::Telnet::_log_option && $telobj->{opt_log};

	# Terminal type
	if ($option == &TELOPT_TTYPE && defined $self->{terminal_type}) {
		my $telcmd = pack("C4 A* C2", &TELNET_IAC, &TELNET_SB, &TELOPT_TTYPE, 0, $self->{terminal_type}, &TELNET_IAC, &TELNET_SE);
		$telobj->{unsent_opts} .= $telcmd;
		Net::Telnet::_log_option($telobj->{opt_log}, "SENT($self->{terminal_type})", "SB", $option) if defined &Net::Telnet::_log_option && $telobj->{opt_log};
		$self->debugMsg(1,"Telnet SubOption Callback TELOPT_TTYPE; sending ", \$self->{terminal_type}, "\n");
	}
	# Window Size
	if ($option == &TELOPT_NAWS && @{$self->{window_size}}) {
		my $telcmd = pack("C9", &TELNET_IAC, &TELNET_SB, &TELOPT_NAWS, 0, $self->{window_size}->[0], 0, $self->{window_size}->[1], &TELNET_IAC, &TELNET_SE);
		$telobj->{unsent_opts} .= $telcmd;
		Net::Telnet::_log_option($telobj->{opt_log}, "SENT(".join(' x ', @{$self->{window_size}}).")", "SB", $option) if defined &Net::Telnet::_log_option && $telobj->{opt_log};
		$self->debugMsg(1,"Telnet SubOption Callback TELOPT_NAWS; sending ", \join(' x ', @{$self->{window_size}}), "\n");
	}
	return 1;
}


1;
__END__;