File Coverage

blib/lib/Net/Socket/NonBlock.pm

Criterion	Covered	Total	%
statement	158	316	50.0
branch	43	164	26.2
condition	20	149	13.4
subroutine	23	43	53.4
pod	15	15	100.0
total	259	687	37.7

package Net::Socket::NonBlock;

use strict;

#$^W++;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

require Exporter;

@ISA = qw(Exporter);

%EXPORT_TAGS = ();

foreach (keys(%EXPORT_TAGS))
        { push(@{$EXPORT_TAGS{'all'}}, @{$EXPORT_TAGS{$_}}); };

$EXPORT_TAGS{'all'}
	and @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

@EXPORT = qw(
);

$VERSION = '0.15';

use Carp;
use IO::Select;
use IO::Socket;

# Preloaded methods go here.

my $ThrowMsg = sub($$$)
	{
	my ($Nest, $CarpCond, $Msg) = @_;

	$CarpCond
		and Carp::carp $Msg;

	($Nest && $Nest->{'ErrArray'})
		and push(@{$Nest->{'ErrArray'}}, $Msg);

	return 1;
	};

sub newNest
	{ shift; return Net::Socket::NonBlock::Nest->new(@_); };
sub new
	{ shift; return Net::Socket::NonBlock::Nest->new(@_); };

my $Die = sub($)
	{ Carp::confess $_[0]; };

my $BuffSize = sub($$)
	{
	my ($SRec, $BuffName) = @_;
	($SRec->{$BuffName})
		or &{$Die}("$SRec: buffer '$BuffName' does not exists");

	my $Result = 0;
        foreach (@{$SRec->{$BuffName}})
		{ $Result += length($_->{'Data'}); };

	return $Result;
	};

my $BuffEmpty = sub($$)
	{
	my ($SRec, $BuffName) = @_;
	($SRec->{$BuffName})
		or &{$Die}("$SRec: buffer '$BuffName' does not exists");

	if ($SRec->{'TCP'})
		{ return (!length($SRec->{$BuffName}->[0]->{'Data'})); };

	return (!scalar(@{$SRec->{$BuffName}}));
	};

my $SockAvail = sub($)
	{
	my ($SRec) = @_;

	($SRec->{'Close'} || ($SRec->{'EOF'} && &{$BuffEmpty}($SRec, 'Input')))
		or return $SRec;

	$@ = $SRec->{'Error'};
	return;
	};

my $CloseSR = sub($)
	{
	my ($SRec) = @_;

	$SRec->{'Socket'}
		and $SRec->{'Socket'}->close();
	delete($SRec->{'Socket'});

	$SRec->{'Parent'}
		and $SRec->{'Parent'}{'Clients'}--;
	delete($SRec->{'Parent'});

	return 1;
	};

my $Close = sub($$)
	{
	my ($Nest, $SRec) = @_;

	$SRec->{'Socket'}
		and $Nest->{'Select'}->remove($SRec->{'Socket'});
	delete($Nest->{'S2Rec'}{$SRec->{'Socket'}});
	delete($Nest->{'Pool'}{$SRec});
	&{$CloseSR}($SRec);

	return 1;
	};

my $EOF = sub($$$)
	{
	my ($Nest, $SRec, $Error) = @_;
	$SRec->{'EOF'}++;
	if (length($Error))
		{
		$SRec->{'Error'} = $Error;
		$@ = $Error;
		&{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: $Error");
		};
	$Nest->{'Select'}->remove($SRec->{'Socket'});
	return;
	};

sub Gets
	{
	my ($SRec, $BufLen) = @_;

	&{$SockAvail}($SRec)
		or return;

	($BufLen && $BufLen > 0 && $BufLen < 32767 && $BufLen < $SRec->{'BuffSize'})
		or $BufLen = ($SRec->{'BuffSize'} < 32767) ? $SRec->{'BuffSize'} : 32766;

	$BufLen--;

	my @Result = ('', '', '');

	if ($SRec->{'Input'}->[0])
		{
		if (($SRec->{'Input'}->[0]->{'Data'} =~ s/\A(.{0,$BufLen}\n)//m) ||
		    ($SRec->{'Input'}->[0]->{'Data'} =~ s/\A(.{$BufLen}.)//m   ) ||
		    ($SRec->{'EOF'} && ($SRec->{'Input'}->[0]->{'Data'} =~ s/\A([.\n]+)//m)))
			{
			$SRec->{'PeerAddr'} = $SRec->{'Input'}->[0]->{'PeerAddr'};
			$SRec->{'PeerPort'} = $SRec->{'Input'}->[0]->{'PeerPort'};
			@Result = ($1, $SRec->{'PeerAddr'}, $SRec->{'PeerPort'});
			};

		if (!$SRec->{'TCP'} &&
		    !length($SRec->{'Input'}->[0]->{'Data'}))
			{
			shift(@{$SRec->{'Input'}});
			};
		};

	return wantarray ? @Result : $Result[0];
	};

sub Read
	{
	my ($SRec, $BufLen) = @_;

	&{$SockAvail}($SRec)
		or return;

	($BufLen && $BufLen > 0 && $BufLen < 32767 && $BufLen < $SRec->{'BuffSize'})
		or $BufLen = ($SRec->{'BuffSize'} < 32767) ? $SRec->{'BuffSize'} : 32766;

	$BufLen--;

	my @Result = ('', '', '');

	if ($SRec->{'Input'}->[0])
		{
		if (($SRec->{'Input'}->[0]->{'Data'} =~ s/\A(.{0,$BufLen}\n)//m) ||
		    ($SRec->{'Input'}->[0]->{'Data'} =~ s/\A(.{0,$BufLen}.)//m ))
			{
			$SRec->{'PeerAddr'} = $SRec->{'Input'}->[0]->{'PeerAddr'};
			$SRec->{'PeerPort'} = $SRec->{'Input'}->[0]->{'PeerPort'};
			@Result = ($1, $SRec->{'PeerAddr'}, $SRec->{'PeerPort'});
			};

		if (!$SRec->{'TCP'} &&
		    !length($SRec->{'Input'}->[0]->{'Data'}))
			{
			shift(@{$SRec->{'Input'}});
			};
		};

	return wantarray ? @Result : $Result[0];
	};

sub Recv
	{
	my ($SRec, $BufLen) = @_;

	&{$SockAvail}($SRec)
		or return;

	($BufLen && $BufLen > 0 && $BufLen < $SRec->{'BuffSize'})
		or $BufLen = $SRec->{'BuffSize'};

	my @Result = ('', '', '');

	if ($SRec->{'Input'}->[0])
		{
		$SRec->{'PeerAddr'} = $SRec->{'Input'}->[0]->{'PeerAddr'};
		$SRec->{'PeerPort'} = $SRec->{'Input'}->[0]->{'PeerPort'};
		@Result = (substr($SRec->{'Input'}->[0]->{'Data'}, 0, $BufLen),
		           $SRec->{'PeerAddr'}, $SRec->{'PeerPort'});
		substr($SRec->{'Input'}->[0]->{'Data'}, 0, $BufLen) = '';

		if (!$SRec->{'TCP'} &&
		    !length($SRec->{'Input'}->[0]->{'Data'}))
			{
			shift(@{$SRec->{'Input'}});
			};
		};

	return wantarray ? @Result : $Result[0];
	};

sub Puts
	{
	my ($SRec, $Data, $PeerAddr, $PeerPort) = @_;

	&{$SockAvail}($SRec)
		or return;

	if ($SRec->{'TCP'})
		{
		defined($SRec->{'Output'}->[0]->{'Data'})
			or $SRec->{'Output'}->[0]->{'Data'} = '';
		$SRec->{'Output'}->[0]->{'Data'} .= ((ref($Data) eq 'ARRAY') ? join('', @{$Data}) : $Data);
		$SRec->{'Output'}->[0]->{'Dest'}  = undef;
		}
	else
		{
		defined($PeerAddr)
			or $PeerAddr = $SRec->{'PeerAddr'};
		defined($PeerPort)
			or $PeerPort = $SRec->{'PeerPort'};

	        my $PeerIP = inet_aton($PeerAddr);
		my $Dest = pack_sockaddr_in($PeerPort, $PeerIP);
		(defined($PeerIP) && defined($Dest))
			or  $@ = "$SRec: invalid destination address '$PeerAddr:$PeerPort'"
			and return;
		push(@{$SRec->{'Output'}}, {'Data' => ((ref($Data) eq 'ARRAY') ? join('', @{$Data}) : $Data), 'Dest' => $Dest});
		};
	return 1;
	};

sub Send
	{ return Puts(@_); };

sub PeerAddr
	{
	my ($SRec) = @_;

	&{$SockAvail}($SRec)
		or return;
	return $SRec->{'PeerAddr'};
	};

sub PeerPort
	{
	my ($SRec) = @_;

	&{$SockAvail}($SRec)
		or return;

	return $SRec->{'PeerPort'};
	};

sub LocalAddr
	{
	my ($SRec) = @_;

	&{$SockAvail}($SRec)
		or return;

	return $SRec->{'LocalAddr'};
	};

sub LocalPort
	{
	my ($SRec) = @_;

	&{$SockAvail}($SRec)
		or return;

	return $SRec->{'LocalPort'};
	};

sub Handle
	{
	my ($SRec) = @_;

	&{$SockAvail}($SRec)
		or return;

	return $SRec->{'Socket'};
	};

sub Properties
	{
	my ($SRec, %Params) = @_;

	&{$SockAvail}($SRec)
		or return;

	my %Result = ();

	$Result{'Handle'} = $SRec->{'Socket'};

	my $Key = undef;
	foreach $Key ('Socket',    'SilenceT',  'BuffSize',  'MaxClients',
	              'ClientsST', 'Clients',   'Parent',
	              'BytesOut',  'CTime',     'ATime',     'Proto',
                      'BytesIn',   'Accept',    'PeerAddr',  'PeerPort',
                      'LocalAddr', 'LocalPort', 'Error',     'DiscEmpty')
                {
                defined($SRec->{$Key})
                	and $Result{$Key} = $SRec->{$Key};
                };

	foreach $Key ('Input', 'Output')
		{ $Result{$Key} = &{$BuffSize}($SRec, $Key); };

	$Result{'Broadcast'} = ($SRec->{'Socket'}->sockopt(SO_BROADCAST) ? 1 : 0);

	foreach $Key ('SilenceT', 'BuffSize', 'MaxClients', 'ClientsST', 'ATime', 'Accept', 'DiscEmpty')
		{
		(defined($Params{$Key}) && defined($SRec->{$Key}))
			and $SRec->{$Key} = $Params{$Key};
		};

	defined($Params{'Broadcast'})
		and $SRec->{'Socket'}->sockopt(SO_BROADCAST, ($Params{'Broadcast'} ? 1 : 0));

        return wantarray ? %Result : \%Result;
	};

sub Close
	{
	my ($SRec, $Flush, $Timeout) = @_;

	$SRec->{'Close'}++;
	$SRec->{'Flush'} = $Flush;
	($Flush && $Timeout)
		and $SRec->{'CloseAt'} = time() + $Timeout;
	return;
	};

sub close
	{ Net::Socket::NonBlock::Close(@_); };

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

package Net::Socket::NonBlock::Nest;

use IO::Socket;
use POSIX;

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

	my $Nest = {};

	$Nest->{'Select'}     = IO::Select->new()
		or return;
	$Nest->{'Pool'}       = {};
	$Nest->{'SelectT'}    = (defined($Params{'SelectT'})    ? $Params{'SelectT'}    : 0.05);
	$Nest->{'SilenceT'}   = (defined($Params{'SilenceT'})   ? $Params{'SilenceT'}   : 0);
        $Nest->{'BuffSize'}   = (defined($Params{'BuffSize'})   ? $Params{'BuffSize'}   : POSIX::BUFSIZ);
        $Nest->{'MaxClients'} = (defined($Params{'MaxClients'}) ? $Params{'MaxClients'} : 9999999999);
        $Nest->{'debug'}      = (defined($Params{'debug'})      ? $Params{'debug'}      : 0);
        $Nest->{'class'}      = $class;
	return bless $Nest => $class;
	};

sub newNest
	{ shift; return Net::Socket::NonBlock::Nest->new(@_); };

sub Properties
	{
	if (!(scalar(@_) & 1) &&
	    ($_[1] =~ m/\ANet\:\:Socket\:\:NonBlock\=HASH\(\w+\)\Z/ois))
		{
		my $Nest = shift;
		my $SRec = shift;
		$SRec = $Nest->{'Pool'}{$SRec}
			or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
			and return;
		return wantarray ? %{scalar($SRec->Properties(@_))} :
		                     scalar($SRec->Properties(@_));
		};

	my ($Nest, %Params) = @_;

	my %Result = ();

	my $Key = undef;
	foreach $Key ('SelectT', 'SilenceT', 'BuffSize', 'debug')
		{ $Result{$Key} = defined($Nest->{$Key}) ? $Nest->{$Key} : ''; };

	$Result{'Sockets'} = $Nest->{'Select'}->count();

	foreach $Key ('SelectT', 'SilenceT', 'BuffSize', 'debug')
		{
		defined($Params{$Key})
			and $Nest->{$Key} = $Params{$Key};
		};

	return wantarray ? %Result : \%Result;
	};

sub NestProperties
	{ return wantarray ? %{scalar(Properties(@_))} : scalar(Properties(@_)); };

my $Cleanup = sub($$)
	{
	my ($Nest, $SRec) = @_;

	($SRec->{'Socket'} && $Nest->{'Pool'}{$SRec})
		or  &{$Die}("$SRec: bad socket");

	my $CurTime = time();

	if ($SRec->{'Close'})
		{
		if    (!$SRec->{'Flush'})
			{
			&{$ThrowMsg}($Nest, $Nest->{'debug'}, $SRec->{'Proto'}." socket $SRec closed by request");
			&{$Close}($Nest, $SRec);
			return;
			}
		elsif (&{$BuffEmpty}($SRec, 'Output'))
			{
			&{$ThrowMsg}($Nest, $Nest->{'debug'}, $SRec->{'Proto'}." socket $SRec closed after flush");
			&{$Close}($Nest, $SRec);
			return;
			}
		elsif ($SRec->{'CloseAt'} && ($SRec->{'CloseAt'} < $CurTime))
			{
			&{$ThrowMsg}($Nest, $Nest->{'debug'}, $SRec->{'Proto'}." socket $SRec closed by flush timeout");
			&{$Close}($Nest, $SRec);
			return;
			};
		}
	elsif ($SRec->{'SilenceT'} &&
	       ($SRec->{'SilenceT'} < ($CurTime - $SRec->{'ATime'})) &&
	       &{$BuffEmpty}($SRec, 'Input') &&
	       &{$BuffEmpty}($SRec, 'Output'))
		{
		&{$EOF}($Nest, $SRec, "silence timeout occurred");
		return;
		};
	return sprintf("$SRec: %d in, %d out", &{$BuffSize}($SRec, 'Input'), &{$BuffSize}($SRec, 'Output'));
	};

my $NonBlock = sub($)
	{
	#if ( $^O ne 'MSWin32')
	#	{
	#	my $Flags = fcntl($_[0], F_GETFL(), 0)
	#		or &{$Die}("Can not get flags for socket: $!");
	#	fcntl($_[0], F_SETFL(), $Flags | O_NONBLOCK())
	#		or &{$Die}("Can not make socket non-blocking: $!");
	#	};
	return $_[0];
	};

my $UpdatePeer = sub($$)
	{
	my ($SRec, $Sock) = @_;
	my $PeerName = $Sock->peername;
	if (defined($PeerName))
	        {
		($SRec->{'PeerPort'}, $SRec->{'PeerAddr'}) = unpack_sockaddr_in($PeerName);
		$SRec->{'PeerAddr'} = inet_ntoa($SRec->{'PeerAddr'});
	        }
	else
		{
	        $SRec->{'PeerAddr'} = '';
	        $SRec->{'PeerPort'} = '';
		};
        return;
	};

my $NewSRec = sub($$$%)
	{
	my ($Nest, $Socket, $CTime, $Params) = @_;

	$Params->{'Proto'} =~ m/\A\s*(.*)\s*\Z/;
	$Params->{'Proto'} = "\U$1";
	my $SRec = {'Socket'     => $Socket,
		    'SilenceT'   => (defined($Params->{'SilenceT'})   ? $Params->{'SilenceT'}   : $Nest->{'SilenceT'}),
                    'BuffSize'   => (defined($Params->{'BuffSize'})   ? $Params->{'BuffSize'}   : $Nest->{'BuffSize'}),
                    'MaxClients' => (defined($Params->{'MaxClients'}) ? $Params->{'MaxClients'} : $Nest->{'MaxClients'}),
                    'ClientsST'  => (defined($Params->{'ClientsST'})  ? $Params->{'ClientsST'}  : $Nest->{'SilenceT'}),
                    'Clients'    => 0,
	            'Parent'     => '',
	            'BytesIn'    => 0,
	            'BytesOut'   => 0,
	            'CTime'      => $CTime,
	            'ATime'      => $CTime,
	            'Proto'      => $Params->{'Proto'},
	            'TCP'        => ($Params->{'Proto'} eq 'TCP'),
	            'Accept'     => $Params->{'Accept'},
	            'PeerAddr'   => '',
	            'PeerPort'   => '',
	            'LocalAddr'  => '',
	            'LocalPort'  => '',
	            'Input'      => [],
	            'Output'     => [],
	            'Close'      => 0,
	            'Flush'      => 0,
	            'CloseAt'    => 0,
	            'Error'      => '',
	            'DiscEmpty'  => $Params->{'DiscEmpty'},
	           };

	&{$UpdatePeer}($SRec, $Socket);

	my $SockName = $Socket->sockname;
	if (defined($SockName))
		{
		($SRec->{'LocalPort'}, $SRec->{'LocalAddr'}) = unpack_sockaddr_in($SockName);
		$SRec->{'LocalAddr'} = inet_ntoa($SRec->{'LocalAddr'});
		};

	if ($SRec->{'TCP'})
		{
		$SRec->{'Output'}->[0]->{'Data'} = '';
		$SRec->{'Input'}->[0]->{'Data'}  = '';
		$SRec->{'Input'}->[0]->{'PeerAddr'} = $SRec->{'PeerAddr'};
		$SRec->{'Input'}->[0]->{'PeerPort'} = $SRec->{'PeerPort'};
		};

	defined($Params->{'Broadcast'})
		and $SRec->{'Socket'}->sockopt(SO_BROADCAST, ($Params->{'Broadcast'} ? 1 : 0));

	#return wantarray ? %{$SRec} : $SRec;
	return bless $SRec => 'Net::Socket::NonBlock';
	};

my $AddSock = sub
	{
	my ($Nest, $newSock, $Params) = @_;

	$newSock or return;

	my $newSRec = &{$NewSRec}($Nest, $newSock, time(), $Params);

	($Nest->{'Pool'}{$newSRec} || $Nest->{'S2Rec'}{$newSock})
		and &{$Die}("Socket '$newSRec' already in use");

	$Nest->{'Select'}->add(&{$NonBlock}($newSock))
	        or $newSock->close()
		and $@ = "Can not add socket to select: $@"
		and return;

	$Nest->{'Pool'}{$newSRec} = $newSRec;

	$Nest->{'S2Rec'}{$newSock}  = $newSRec;

	return $newSRec;
	};

my $Accept = sub($$)
	{
	my ($Nest, $PRec) = @_;

	($PRec->{'Socket'} && $Nest->{'Pool'}{$PRec})
		or  &{$Die}("$PRec: bad socket");

	if (!($PRec->{'Clients'} < $PRec->{'MaxClients'}))
		{
		$@ = "maximum number of clients exceeded";
		return;
		};

	my $newSRec = &{$AddSock}($Nest, scalar($PRec->{'Socket'}->accept()), $PRec)
		or return;

	$PRec->{'Clients'}++;
	$Nest->{'Pool'}{$newSRec} = $newSRec;
	$Nest->{'S2Rec'}{$newSRec->{'Socket'}} = $newSRec;
	$newSRec->{'Accept'}   = undef;
	$newSRec->{'SilenceT'} = $PRec->{'ClientsST'};
	$newSRec->{'Parent'}   = $PRec;

	if(!&{$PRec->{'Accept'}}($newSRec))
		{
		$newSRec->{'Close'}++;
		$@ = "external accept function returned a FALSE value";
		return;
		};

	return $newSRec;
	};

my $RecvTCP = sub($$$)
	{
	my ($Nest, $SRec, $ATime) = @_;

	($SRec->{'Socket'} && $Nest->{'Pool'}{$SRec})
		or  &{$Die}("$SRec: bad socket");

	my $BufAvail = $SRec->{'BuffSize'} - &{$BuffSize}($SRec, 'Input');

	($BufAvail > 0)
		or return 0;

	my $Buf = '';
	my $Res = $SRec->{'Socket'}->recv($Buf, $BufAvail, 0);

	if (!defined($Res))
		{
		&{$EOF}($Nest, $SRec, 'recv() fatal error');
		return;
		};

	if (!length($Buf))
		{
		&{$EOF}($Nest, $SRec, 'EOF');
		return;
		};

	$SRec->{'Input'}->[0]->{'Data'} .= $Buf;

	$SRec->{'ATime'}    = $ATime;
	$SRec->{'BytesIn'} += length($Buf);

	return length($Buf);
	};

my $RecvUDP = sub($$$)
	{
	my ($Nest, $SRec, $ATime) = @_;

	($SRec->{'Socket'} && $Nest->{'Pool'}{$SRec})
		or  &{$Die}("$SRec: bad socket");

	my $BufAvail = $SRec->{'BuffSize'} - &{$BuffSize}($SRec, 'Input');
	my $Received = 0;

	my $Sel = IO::Select->new($SRec->{'Socket'});
	while($Sel->can_read(0) && ($BufAvail > $Received))
		{
		my $Buf = '';
		my $Res = $SRec->{'Socket'}->recv($Buf, $SRec->{'BuffSize'});

		if (!defined($Res))
			{
			&{$EOF}($Nest, $SRec, 'recv() fatal error');
			return;
			}

	        (length($Buf) || !$SRec->{'DiscEmpty'})
	        	or next;

		$Received += (length($Buf) + 20);
		my $tmpHash = {'Data' => $Buf};
		&{$UpdatePeer}($tmpHash, $SRec->{'Socket'});
		push(@{$SRec->{'Input'}}, $tmpHash);
		};

	$Received
		and $SRec->{'ATime'} = $ATime;

	$SRec->{'BytesIn'} += $Received;

	return $Received;
	};

sub IO($$)
	{
	my ($Nest, $ErrArray) = @_;

	my $Result = '0 but true';

	$ErrArray and @{$ErrArray} = ();

	$Nest->{'ErrArray'} = $ErrArray;

	my $CurTime = time();

	my $SRec = undef;

	foreach $SRec (values(%{$Nest->{'Pool'}}))
		{ &{$Cleanup}($Nest, $SRec); };

	my $Socket = undef;

	my @SockArray = $Nest->{'Select'}->can_read($Nest->{'SelectT'});
	foreach $Socket (@SockArray)
		{
		$SRec  = $Nest->{'S2Rec'}{$Socket};

		if ($SRec->{'EOF'} || $SRec->{'Close'} ||
		    (&{$BuffSize}($SRec, 'Input') >= $SRec->{'BuffSize'}))
			{ next; };

		if ($SRec->{'Accept'} && $SRec->{'TCP'})
			{
			$Result++;
			&{$Accept}($Nest, $SRec)
				and &{$ThrowMsg}(undef, $Nest->{'debug'}, "$SRec: incoming connection accepted")
				or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: Can not accept incoming connection: $@");
			$SRec->{'ATime'} = $CurTime;
			next;
			};


		my ($Res) = &{$SRec->{'TCP'} ? $RecvTCP : $RecvUDP}($Nest, $SRec, $CurTime)
			or next;

		&{$ThrowMsg}(undef, $Nest->{'debug'}, "$SRec: recv $Res bytes");

	  	$Result++;
		};

	my $Continue = 1;
	while ($Continue)
		{
		$Continue = 0;
		my $Socket = undef;

		@SockArray = $Nest->{'Select'}->can_write($Nest->{'SelectT'});
		foreach $Socket (@SockArray)
			{
			$SRec  = $Nest->{'S2Rec'}{$Socket};

			my $OutRec  = $SRec->{'Output'}->[0];

			(defined($OutRec) && !$SRec->{'EOF'})
				or next;

			my $DataLen = length($OutRec->{'Data'});

			if (!$DataLen && $SRec->{'TCP'})
				{ next; }

			$Continue++;

			my $Res = $Socket->send($OutRec->{'Data'}, 0, $OutRec->{'Dest'});

			if (!defined($Res))
				{
				&{$EOF}($Nest, $SRec, "send() fatal error");
				next;
				};

			if (!(($Res == $DataLen) || ($! == POSIX::EWOULDBLOCK)))
				{
				if ($SRec->{'TCP'})
					{
					&{$EOF}($Nest, $SRec, "send() fatal error");
					next;
					};

				my ($DP, $DA) = unpack_sockaddr_in($OutRec->{'Dest'});
				$DA = inet_ntoa($DA);
				$SRec->{'Error'} = "$SRec: send() error: ".($DataLen - $Res)." bytes were not sent to $DA:$DP";
				&{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), $SRec->{'Error'});

				shift(@{$SRec->{'Output'}});
				$SRec->{'BytesOut'} += $Res;
				next;
				};

			$SRec->{'ATime'}    =  $CurTime;
			$SRec->{'BytesOut'} += $Res;

			if ($SRec->{'TCP'})
				{
				substr($OutRec->{'Data'}, 0, $Res) = '';
				}
			else
				{
				shift(@{$SRec->{'Output'}});
				&{$UpdatePeer}($SRec, $Socket);
				};

			&{$ThrowMsg}(undef, ($Nest->{'debug'}), "$SRec: $Res bytes sent to ".$SRec->{'PeerAddr'}.':'.$SRec->{'PeerPort'});
			};
		};
	return $Result;
	};


sub SelectT
	{
	my ($Nest, $SelectT) = @_;
	my $Return = $Nest->{'SelectT'};
	$SelectT and $Nest->{'SelectT'} = $SelectT;
	return $Return;
	};

sub SilenceT
	{
	my ($Nest, $SilenceT) = @_;
	my $Return = $Nest->{'SilenceT'};
	$SilenceT and $Nest->{'SilenceT'} = $SilenceT;
	return $Return;
	};

sub Listen
	{
	my ($Nest, %Params) = @_;

	if (($Params{'Proto'} =~ m/\A\s*tcp\s*\Z/io) &&
	    (ref($Params{'Accept'}) ne 'CODE'))
		{
		$@ = "'Accept' have to be a 'CODE' reference";
		return;
		};

	my $newSRec = &{$AddSock}($Nest, IO::Socket::INET->new(%Params), \%Params)
		or return;

	return $newSRec;
	};

sub Connect
	{
	my ($Nest, %Params) = @_;

	my $newSRec = &{$AddSock}($Nest, IO::Socket::INET->new(%Params), \%Params)
		or return;

	$newSRec->{'Accept'} = undef;

	return $newSRec;
	};

sub Gets
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->Gets(@_);
	};
sub Read
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->Read(@_);
	};
sub Recv
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->Recv(@_);
	};
sub Puts
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->Puts(@_);
	};
sub Send
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->Send(@_);
	};
sub PeerAddr
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->PeerAddr(@_);
	};
sub PeerPort
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->PeerPort(@_);
	};
sub LocalAddr
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->LocalAddr(@_);
	};
sub LocalPort
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->LocalPort(@_);
	};
sub Handle
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->Handle(@_);
	};
sub Close
	{
	my $Nest = shift;
	my $SRec = shift;
	$Nest->{'Pool'}{$SRec}
		or  &{$ThrowMsg}($Nest, ($^W || $Nest->{'debug'}), "$SRec: bad socket name")
		and return;
	return $Nest->{'Pool'}{$SRec}->Close(@_);
	};

sub DESTROY
	{
	my ($Nest) = @_;
	foreach my $SRec (values(%{$Nest->{'Pool'}}))
		{ &{$Close}($Nest, $SRec); };
	delete($Nest->{'Select'});
	$Nest->{'debug'}
		and warn "Socket nest $Nest destroyed";
	};

1;
__END__