view release on metacpan or  search on metacpan

NonBlock.pm  view on Meta::CPAN

                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'))
			{