# 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__

=head1 NAME

Net::TCP - TCP sockets interface module

=head1 SYNOPSIS

    use Net::Gen;		# optional
    use Net::Inet;		# optional
    use Net::TCP;

=head1 DESCRIPTION

The C<Net::TCP> module provides services for TCP communications
over sockets.  It is layered atop the
L<C<Net::Inet>|Net::Inet>
and
L<C<Net::Gen>|Net::Gen>
modules, which are part of the same distribution.

=head2 Public Methods

The following methods are provided by the C<Net::TCP> module
itself, rather than just being inherited from
L<C<Net::Inet>|Net::Inet>
or
L<C<Net::Gen>|Net::Gen>.

=over 4

=item new

Usage:

    $obj = new Net::TCP;
    $obj = new Net::TCP $host, $service;
    $obj = new Net::TCP \%parameters;
    $obj = new Net::TCP $host, $service, \%parameters;
    $obj = 'Net::TCP'->new();
    $obj = 'Net::TCP'->new($host, $service);
    $obj = 'Net::TCP'->new(\%parameters);
    $obj = 'Net::TCP'->new($host, $service, \%parameters);

Returns a newly-initialised object of the given class.  If called
for a derived class, no validation of the supplied parameters
will be performed.  (This is so that the derived class can add
the parameter validation it needs to the object before allowing
the validation.)  Otherwise, it will cause the parameters to be
validated by calling its C<init> method, which C<Net::TCP>
inherits from L<C<Net::Inet>|Net::Inet>.  In particular, this means that if
both a host and a service are given, then an object will only be
returned if a connect() call was successful (or is still in progress,
if the object is non-blocking).

The examples above show the indirect object syntax which many prefer,
as well as the guaranteed-to-be-safe static method call.  There
are occasional problems with the indirect object syntax, which
tend to be rather obscure when encountered.  See
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-01/msg01674.html
for details.

=back

=head2 Protected Methods

none.

=head2 Known Socket Options

These are the socket options known to the C<Net::TCP> module itself:

=over 4

=item Z<>

C<TCP_NODELAY> C<TCP_MAXSEG> C<TCP_RPTR2RXT>

=back

=head2 Known Object Parameters

There are no object parameters registered by the C<Net::TCP> module itself.

=head2 TIESCALAR

Tieing of scalars to a TCP handle is supported by inheritance
from the C<TIESCALAR> method of
L<C<Net::Gen>|Net::Gen/TIESCALAR>.  That method only
succeeds if a call to a C<new> method results in an object for
which the C<isconnected> method returns true, which is why it is
mentioned in connection with this module.

Example:

    tie $x,Net::TCP,0,'finger' or die;
    $x = "-s\015\012";
    print $y while defined($y = $x);
    untie $x;

This is an expensive re-implementation of S<finger -s> on many
machines.

Each assignment to the tied scalar is really a call to the C<put>
method (via the C<STORE> method), and each read from the tied
scalar is really a call to the C<getline> method (via the
C<FETCH> method).

=head2 Exports

=over 4

=item default

none

=item exportable

C<TCPOPT_EOL> C<TCPOPT_MAXSEG> C<TCPOPT_NOP> C<TCPOPT_WINDOW>
C<TCP_MAXSEG> C<TCP_MAXWIN> C<TCP_MAX_WINSHIFT> C<TCP_MSS>
C<TCP_NODELAY> C<TCP_RPTR2RXT> C<TH_ACK> C<TH_FIN> C<TH_PUSH> C<TH_RST>
C<TH_SYN> C<TH_URG>

=item tags

The following I<:tags> are available for grouping related exportable
items:

=over 6

=item :sockopts

C<TCP_NODELAY> C<TCP_MAXSEG> C<TCP_RPTR2RXT>

=item :tcpoptions

C<TCPOPT_EOL> C<TCPOPT_MAXSEG> C<TCPOPT_NOP> C<TCPOPT_WINDOW>

=item :protocolvalues

C<TCP_MAXWIN> C<TCP_MAX_WINSHIFT> C<TCP_MSS> C<TH_ACK> C<TH_FIN>
C<TH_PUSH> C<TH_RST> C<TH_SYN> C<TH_URG>

=item :ALL

All of the above exportable items.

=back

Z<>

=back

=head1 THREADING STATUS

This module has been tested with threaded perls, and should be as thread-safe
as perl itself.  (As of 5.005_03 and 5.005_57, that's not all that safe
just yet.)  It also works with interpreter-based threads ('ithreads') in
more recent perl releases.

=head1 SEE ALSO

L<Net::Inet(3)|Net::Inet>,
L<Net::Gen(3)|Net::Gen>,
L<Net::TCP::Server(3)|Net::TCP::Server>

=head1 AUTHOR

Spider Boardman E<lt>spidb@cpan.orgE<gt>

=cut

#other sections should be added, sigh.

#any real autoloaded methods go after this line