File Coverage

blib/lib/Net/TCP/Server.pm

Criterion	Covered	Total	%
statement	18	46	39.1
branch	0	24	0.0
condition	0	33	0.0
subroutine	6	10	60.0
pod	2	4	50.0
total	26	117	22.2

# Copyright 1997,2002 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available.  This software
# can be copied and used under the terms of the GNU Public License,
# version 1 or (at your option) any later version, or under the
# terms of the Artistic license.  Both of these can be found with
# the Perl distribution, which this software is intended to augment.
#
# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

# rcsid: "@(#) $Id: Server.dat,v 1.16 2002/03/30 10:11:36 spider Exp $"

package Net::TCP::Server;
use 5.004_04;

use strict;
#use Carp;
sub carp { require Carp; goto &Carp::carp; }
sub croak { require Carp; goto &Carp::croak; }
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

BEGIN {
    $VERSION = '1.0';
    eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
}

#use AutoLoader;
#use Exporter ();	# we inherit what we need here from Net::Gen
#use Net::Inet;
#use Net::Gen;
use Net::TCP 1.0;


BEGIN {
    @ISA = 'Net::TCP';

# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
    @EXPORT = qw(
    );

# Other items we are prepared to export if requested
    @EXPORT_OK = qw(
    );

# Tags:
    %EXPORT_TAGS = (
    ALL		=> [@EXPORT, @EXPORT_OK],
);
#    *AUTOLOAD = \$Net::Gen::AUTOLOAD;
}

# sub AUTOLOAD inherited from Net::Gen (via Net::TCP)

# However, since 5.003_96 will make simple subroutines not inherit AUTOLOAD...
#sub AUTOLOAD
#{
#    #$Net::Gen::AUTOLOAD = $AUTOLOAD;
#    goto &Net::Gen::AUTOLOAD;
#}


# Preloaded methods go here.  Autoload methods go after __END__, and are
# processed by the autosplit program.

# Can't autoload routines which we could get without autoloading by
# inheritance, so new() and init() have to be here.

#& new(classname, [[hostspec,] service,] [\%params]) : {$self | undef}
sub new : locked
{
    $_[0]->_trace(\@_,1);
    my ($xclass, @Args) = @_;
    if (@Args == 2 && ref $Args[1] && ref($Args[1]) eq 'HASH' or
	@Args == 1 and not ref $Args[0]) {
	unshift(@Args, undef);	# thishost spec
    }
    my $self = $xclass->SUPER::new(@Args);
    return undef unless $self;
    $self->setparams({reuseaddr => 1}, -1);
    $xclass = ref $xclass if ref $xclass;
    if ($xclass eq __PACKAGE__) {
	unless ($self->init(@Args)) {
	    local $!;		# protect returned errno value
	    undef $self;	# against excess closes in perl core
	    undef $self;	# another statement needed for sequencing
	}
    }
    $self;
}

#& init($self, [@stuff]) : {$self | undef}
sub init : locked method
{
    my ($self, @Args) = @_;
    if (@Args == 2 && ref $Args[1] && ref $Args[1] eq 'HASH' or
	@Args == 1 and not ref $Args[0]) {
	unshift(@Args, undef);	# thishost spec
    }
    return undef unless $self->_hostport('this',\@Args);
    return undef unless $self->SUPER::init;
    if ($self->getparam('srcaddrlist') && !$self->isbound) {
	return undef unless $self->bind;
    }
    if ($self->isbound && !$self->didlisten) {
	return undef unless $self->isconnected or $self->listen;
    }
    $self;
}

# maybe someday add some fork+accept handling here?

1;

# autoloaded methods go after the END token (& pod) below

__END__