File Coverage

blib/lib/Net/TCP.pm

Criterion	Covered	Total	%
statement	22	59	37.2
branch	0	22	0.0
condition	0	15	0.0
subroutine	7	13	53.8
pod	1	3	33.3
total	30	112	26.7

# Copyright 1995,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: TCP.dat,v 1.25 2002/03/30 10:11:53 spider Exp $"

package Net::TCP;
use 5.004_04;			# new minimum Perl version for this package

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 *AUTOLOAD);

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

#use AutoLoader;	# disable this until we have autoloadable subs again
#use Exporter ();	# we inherit what we need here from Net::Gen
use Net::Inet 1.0;
use Net::Gen 1.0 ':sockvals', ':families';

BEGIN {
    @ISA = 'Net::Inet';
    *AUTOLOAD = \$Net::Gen::AUTOLOAD;

# 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(
	TCPOPT_EOL
	TCPOPT_MAXSEG
	TCPOPT_NOP
	TCPOPT_WINDOW
	TCP_MAXSEG
	TCP_MAXWIN
	TCP_MAX_WINSHIFT
	TCP_MSS
	TCP_NODELAY
	TCP_RPTR2RXT
	TH_ACK
	TH_FIN
	TH_PUSH
	TH_RST
	TH_SYN
	TH_URG
    );

    %EXPORT_TAGS = (
	sockopts	=> [qw(TCP_NODELAY TCP_MAXSEG TCP_RPTR2RXT)],
	tcpoptions	=> [qw(TCPOPT_EOL TCPOPT_MAXSEG TCPOPT_NOP
			       TCPOPT_WINDOW)],
	protocolvalues	=> [qw(TCP_MAXWIN TCP_MAX_WINSHIFT TCP_MSS
			       TH_ACK TH_FIN TH_PUSH TH_RST TH_SYN TH_URG)],
	ALL		=> [@EXPORT, @EXPORT_OK],
    );
}

;# sub AUTOLOAD inherited from Net::Gen (via Net::Inet)

;# 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.


my %sockopts;

%sockopts = (
	     # known TCP socket options
	     # simple booleans first

	     'TCP_NODELAY'	=> ['i'],

	     # simple integer options

	     'TCP_MAXSEG'	=> ['i'],
	     'TCP_RPTR2RXT'	=> ['i'],

	     # structured options

	     # out of known TCP options
	     );

__PACKAGE__->initsockopts( IPPROTO_TCP, \%sockopts );

my $debug = 0;

#& _debug($this, [$newval]) : oldval
sub _debug : locked
{
    my ($this,$newval) = @_;
    return $this->debug($newval) if ref $this;
    my $prev = $debug;
    $debug = 0+$newval if defined $newval;
    $prev;
}

my %Sopts;			# do a full register_options only once

sub new : locked
{
    my $whoami = $_[0]->_trace(\@_,1);
    my($class,@args) = @_;
    my $self = $class->SUPER::new(@args);
    $class = ref $class if ref $class;
    ($self || $class)->_trace(\@_,2,", self" .
			      (defined $self ? "=$self" : " undefined") .
			      " after sub-new");
    if ($self) {
	;# no new keys for TCP?
	# register our socket options
	if (%Sopts) {
	    $ {*$self}{Sockopts} = { %Sopts } ;
	}
	else {
	    $self->register_options('IPPROTO_TCP', IPPROTO_TCP(), \%sockopts);
	    %Sopts = %{ $ {*$self}{Sockopts} } ;
	}
	# set our expected parameters
	$self->setparams({IPproto => 'tcp',
			  type => SOCK_STREAM,
			  proto => IPPROTO_TCP},-1);
	if ($class 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 || $class)->_trace(0,1," returning " .
			      (defined $self ? "self=$self" : "undef"));
    $self;
}

#& _addrinfo($this, $sockaddr, [numeric_only]) : @list
sub _addrinfo
{
    my($this,@args,@r) = @_;
    @r = $this->SUPER::_addrinfo(@args);
    unless (!@r or $args[1] or ref($this) or $r[2] ne $r[3]) {
	$this = getservbyport(htons($r[3]), 'tcp');
	$r[2] = $this if defined $this;
    }
    @r;
}


1;

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

__END__