view release on metacpan or  search on metacpan

OCV.pm  view on Meta::CPAN

	unless (defined($self->{'sel'}))
	{
		$self->{'sel'} = new IO::Select();
		$@ = "could not create IO::Select object: $!", return undef
			unless $self->{'sel'};
	}

	# may have gotten a new file number
	$self->{'sel'}->add($self->{'io'}) 
		unless $self->{'sel'}->exists($self->{'io'});

	return 1;
}

sub connect
# Open the connection to the server.
{
	my ($self) = @_;

	$self->_open;

	# IO::Socket dies (inside an eval) if the connect fails, which triggers
	# any 'external' __DIE__ handler.
	local $SIG{__DIE__} = 'IGNORE';
	if ($self->{'io'}->connect($self->{'sockaddr'}))
	{
		$self->logdebug("Connected to $self->{'server'}" . 
			"($self->{'serveraddr'}):$self->{'port'}");
		return 1;
	}
	else
	{
		$self->logdebug("Connect failed $self->{'serveraddr'}:$self->{'port'}". 
			": $!");
		$@ = "could not connect to [$self->{'serveraddr'}:$self->{'port'}]: $!";
		return undef;
	}
}

sub disconnect
# Close the connection to the server.
{
	my ($self) = @_;

	$self->logdebug('Closing connection');

	$@ = "no IO object", return undef
		unless $self->{'io'};

	$self->{'sel'}->remove($self->{'io'});	# remove handle from IO::Select

	$@ = "could not close connection: $!", return undef
		unless $self->{'io'}->close();

	$self->{'disconnected'} = 1;

	return 1;
}

sub ping
# try and confirm the server connection is alive
{
	my $self = shift;

	$@ = "not connected", return undef unless $self->{'io'}->connected;

	# there isn't an OCV 'noop' command, use a simple stats request
	# - result should be a statistics array, or error
	return ($self->statistics(SubCode => STATS_PERMANENT));
}

sub DESTROY
{
	my $self = shift;
	# sometimes the IO and other 'sub-objects' seem to have been cleaned up
	# TODO - figure out why
	#warn "$self = \n", 
	#	map {my $s = $self->{$_} || '-'; $s =~ s/[\x00-\x1f\x7f-\xff]/?/g; 
	#	"\t$_ => $s\n"} keys %{$self};
	{
	local $^W = 0;	# ignore IO::Socket warnings
	$self->disconnect(@_) if (!$self->{'disconnected'} and 
		$self->{'io'} and $self->{'io'}->connected);
	}
}

sub open  { shift->   connect(@_); }
sub close { shift->disconnect(@_); }

sub flush
# try and resynchronise the connection by dumping all pending input
# - probably better to close and (re-)open (see reset method)
{
	my $self = shift;
	my $buf;
	while ($self->{'sel'}->can_read(0) and $self->{'io'}->sysread($buf, 8192))
	{
		$self->logdebug("flush: discarding [$buf]");
	}
	"\000";	# true, but "silent" (mainly for the ocv command line util)
}

sub _send
# assumes data is not fragmented
{
	my $self = shift;

	$@ = "send: not connected", return undef unless $self->{'io'}->connected;

	$@ = "send: timeout", return undef 
		unless $self->{'sel'}->can_write($self->{'timeout'});

	# see logdebug() re. logging of sensitive data
	$self->logdebug(sprintf("send:     %3d [%s]", length($_[0]), $_[0]));

	my $r;
	eval
	{
		local $SIG{__WARN__} = 'IGNORE';
		local $SIG{ALRM} = sub { die "timeout\n" };
		alarm ($self->{'timeout'});