File Coverage

blib/lib/Net/TCP/ConnHandler.pm

Criterion	Covered	Total	%
statement	9	91	9.8
branch	0	34	0.0
condition	0	4	0.0
subroutine	3	16	18.7
pod	7	13	53.8
total	19	158	12.0

package Net::TCP::ConnHandler;

use strict;
use warnings;

our $VERSION = '0.01';

use Net::Socket::NonBlock;

sub new {
	my $class = shift;
	my %args = @_;
	my $self = {};
	bless($self, $class);
	if ($args{PacketUnpackString}) {
		$self->{unpackstr} = $args{PacketUnpackString};
		delete $args{PacketUnpackString};
	}
	elsif ($args{NoMsgType}) {
		$self->{nomsgtype} = 1;
		delete $args{NoMsgType};
	}
	else {
		$self->{unpackstr} = "n a*";
	}
	$self->{socknest} = Net::Socket::NonBlock::Nest->new(%args)
		or die "Error creating sockets nest: $@\n";
	return $self;
}

sub Connect {
	my $self = shift;
	my %args = @_;
	my $socket = $self->{socknest}->Connect(%args)
		or $self->error("Couldn't connect to '$args{PeerAddr}:$args{PeerPort}': $@\n") and return;
	$self->add_socket($socket);
	return $socket;
}

sub Listen {
	my $self = shift;
	my %args = @_;
	my $socket = $self->{socknest}->Listen(%args)
		or $self->error("Couldn't listen on port '$args{LocalPort}': $@\n") and return;
	$self->add_socket($socket);
	return $socket;
}

sub Send {
	my $self = shift;
	my $socket = shift;
	my $data = shift;
	$socket->Send(pack("N a*", length $data, $data));
}

sub IO {
	my $self = shift;
	my $aryref = @_;
	my $recvnum = $self->{socknest}->IO($aryref);
	for my $socket ($self->get_sockets()) {
		my $buf = undef;
		if ($socket->{rx} == 0) {
			$buf = $socket->{obj}->Recv(4);
			if ($buf) {
				$socket->{rxlen} = unpack('N', $buf);
				$socket->{rxbuf} = "";
				$socket->{rx} = 1;
			}
			elsif (!defined $buf) {
				$socket->Close();
				$self->del_socket($socket);
			}
		}
		if ($socket->{rx} == 1) {
			my ($ip, $port);
			($buf, $ip, $port) = $socket->{obj}->Recv($socket->{rxlen});
			if ($buf) {
				$socket->{r_addr} = $ip;
				$socket->{r_port} = $port;
				$socket->{rxlen} -= length $buf;
				$socket->{rxbuf} .= $buf;
				if ($socket->{rxlen} == 0) {
					$socket->{rx} = 0;
					my @packet;
					if ($self->{unpackstr}) {
						@packet = unpack($self->{unpackstr}, $socket->{rxbuf});
					}
					else { @packet = ("GENERIC", $socket->{rxbuf}) }
					$self->handle($socket->{obj}, @packet);
				}
			}
			elsif (!defined $buf) {
				$socket->Close();
				$self->del_socket($socket);
			}
		}
	}
	return $recvnum
}

sub add_socket {
	$_[0]->{sockets}->{$_[1]}->{obj}	= $_[1];
	$_[0]->{sockets}->{$_[1]}->{rx}		= 0;
	$_[0]->{sockets}->{$_[1]}->{rxlen}	= 0;
	$_[0]->{sockets}->{$_[1]}->{rxbuf}	= "";
}

sub del_socket { delete $_[0]->{sockets}->{$_[1]} }
sub get_sockets { values %{$_[0]->{sockets}} }

sub set_handler {
	my $self = shift;
	my $hlist = shift;
	$self->{handlers}->{$_} = $hlist->{$_} for (keys %$hlist);
}

sub set_handlers { set_handler(@_) }

sub handle {
	my $self = shift;
	my $socket = shift;
	my $msgtype = shift;
	if ($self->is_handled($msgtype)) {
		$self->{handlers}->{$msgtype}->($self, $socket, @_);
	}
	elsif ($self->is_handled('GENERIC')) {
		$self->{handlers}->{'GENERIC'}->($self, $socket, $msgtype, @_);
	}
	else {
		$self->error("Couldn't handle msgtype: $msgtype ($socket)\n");
	}
}

sub is_handled {
	my $self = shift;
	my $msgtype = shift;
	return 1 if $self->{handlers}->{$msgtype};
}


sub error {
	my $self = shift;
	if ($self->is_handled('ERROR')) { $self->handle('ERROR', @_) }
	else { die @_ }
}

1;
__END__