1# Copyright 1997,2002 Spider Boardman. 2# All rights reserved. 3# 4# Automatic licensing for this software is available. This software 5# can be copied and used under the terms of the GNU Public License, 6# version 1 or (at your option) any later version, or under the 7# terms of the Artistic license. Both of these can be found with 8# the Perl distribution, which this software is intended to augment. 9# 10# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR 11# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED 12# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 13 14# rcsid: "@(#) $Id: Server.dat,v 1.16 2002/03/30 10:11:36 spider Exp $" 15 16package Net::TCP::Server; 17use 5.004_04; 18 19use strict; 20#use Carp; 21sub carp { require Carp; goto &Carp::carp; } 22sub croak { require Carp; goto &Carp::croak; } 23use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 24 25BEGIN { 26 $VERSION = '1.0'; 27 eval "sub Version () { __PACKAGE__ . ' v$VERSION' }"; 28} 29 30#use AutoLoader; 31#use Exporter (); # we inherit what we need here from Net::Gen 32#use Net::Inet; 33#use Net::Gen; 34use Net::TCP 1.0; 35 36 37BEGIN { 38 @ISA = 'Net::TCP'; 39 40# Items to export into callers namespace by default 41# (move infrequently used names to @EXPORT_OK below) 42 @EXPORT = qw( 43 ); 44 45# Other items we are prepared to export if requested 46 @EXPORT_OK = qw( 47 ); 48 49# Tags: 50 %EXPORT_TAGS = ( 51 ALL => [@EXPORT, @EXPORT_OK], 52); 53# *AUTOLOAD = \$Net::Gen::AUTOLOAD; 54} 55 56# sub AUTOLOAD inherited from Net::Gen (via Net::TCP) 57 58# However, since 5.003_96 will make simple subroutines not inherit AUTOLOAD... 59#sub AUTOLOAD 60#{ 61# #$Net::Gen::AUTOLOAD = $AUTOLOAD; 62# goto &Net::Gen::AUTOLOAD; 63#} 64 65 66# Preloaded methods go here. Autoload methods go after __END__, and are 67# processed by the autosplit program. 68 69# Can't autoload routines which we could get without autoloading by 70# inheritance, so new() and init() have to be here. 71 72#& new(classname, [[hostspec,] service,] [\%params]) : {$self | undef} 73sub new : locked 74{ 75 $_[0]->_trace(\@_,1); 76 my ($xclass, @Args) = @_; 77 if (@Args == 2 && ref $Args[1] && ref($Args[1]) eq 'HASH' or 78 @Args == 1 and not ref $Args[0]) { 79 unshift(@Args, undef); # thishost spec 80 } 81 my $self = $xclass->SUPER::new(@Args); 82 return undef unless $self; 83 $self->setparams({reuseaddr => 1}, -1); 84 $xclass = ref $xclass if ref $xclass; 85 if ($xclass eq __PACKAGE__) { 86 unless ($self->init(@Args)) { 87 local $!; # protect returned errno value 88 undef $self; # against excess closes in perl core 89 undef $self; # another statement needed for sequencing 90 } 91 } 92 $self; 93} 94 95#& init($self, [@stuff]) : {$self | undef} 96sub init : locked method 97{ 98 my ($self, @Args) = @_; 99 if (@Args == 2 && ref $Args[1] && ref $Args[1] eq 'HASH' or 100 @Args == 1 and not ref $Args[0]) { 101 unshift(@Args, undef); # thishost spec 102 } 103 return undef unless $self->_hostport('this',\@Args); 104 return undef unless $self->SUPER::init; 105 if ($self->getparam('srcaddrlist') && !$self->isbound) { 106 return undef unless $self->bind; 107 } 108 if ($self->isbound && !$self->didlisten) { 109 return undef unless $self->isconnected or $self->listen; 110 } 111 $self; 112} 113 114# maybe someday add some fork+accept handling here? 115 1161; 117 118# autoloaded methods go after the END token (& pod) below 119 120__END__ 121 122=head1 NAME 123 124Net::TCP::Server - TCP sockets interface module for listeners and servers 125 126=head1 SYNOPSIS 127 128 use Net::Gen; # optional 129 use Net::Inet; # optional 130 use Net::TCP; # optional 131 use Net::TCP::Server; 132 133=head1 DESCRIPTION 134 135The C<Net::TCP::Server> module provides services for TCP communications 136over sockets. It is layered atop the 137L<C<Net::TCP>|Net::TCP>, 138L<C<Net::Inet>|Net::Inet>, 139and 140L<C<Net::Gen>|Net::Gen> 141modules, which are part of the same distribution. 142 143=head2 Public Methods 144 145The following methods are provided by the C<Net::TCP::Server> module 146itself, rather than just being inherited from 147L<C<Net::TCP>|Net::TCP>, 148L<C<Net::Inet>|Net::Inet>, 149or 150L<C<Net::Gen>|Net::Gen>. 151 152=over 4 153 154=item new 155 156Usage: 157 158 $obj = new Net::TCP::Server; 159 $obj = new Net::TCP::Server $service; 160 $obj = new Net::TCP::Server $service, \%parameters; 161 $obj = new Net::TCP::Server $lcladdr, $service, \%parameters; 162 $obj = 'Net::TCP::Server'->new(); 163 $obj = 'Net::TCP::Server'->new($service); 164 $obj = 'Net::TCP::Server'->new($service, \%parameters); 165 $obj = 'Net::TCP::Server'->new($lcladdr, $service, \%parameters); 166 167Returns a newly-initialised object of the given class. This is 168much like the regular C<new> method of the other modules 169in this distribution, except that it makes it easier 170to specify just a service name or port number, and it automatically 171does a setsockopt() call to set C<SO_REUSEADDR> to make the bind() more 172likely to succeed. The C<SO_REUSEADDR> is really done in a base class, 173but it's enabled by defaulting the C<reuseaddr> object parameter to 1 in 174this constructor. 175 176The examples above show the indirect object syntax which many prefer, 177as well as the guaranteed-to-be-safe static method call. There 178are occasional problems with the indirect object syntax, which 179tend to be rather obscure when encountered. See 180http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-01/msg01674.html 181for details. 182 183Simple example for server setup: 184 185 $lh = 'Net::TCP::Server'->new(7788) or die; 186 while ($sh = $lh->accept) { 187 defined($pid=fork) or die "fork: $!\n"; 188 if ($pid) { # parent doesn't need client fh 189 $sh->stopio; 190 next; 191 } 192 # child doesn't need listener fh 193 $lh->stopio; 194 # do per-connection stuff here 195 exit; 196 } 197 198Note that signal-handling for the child processes is not included in 199this example. See L<perlipc/"Internet TCP Clients and Servers"> for 200related examples which manage subprocesses. However, on many operating 201systems, a simple C<$SIG{CHLD} = 'IGNORE';> will prevent the server 202process from collecting `zombie' subprocesses. 203 204=back 205 206=head2 Protected Methods 207 208none. 209 210=head2 Known Socket Options 211 212There are no socket options specific to the C<Net::TCP::Server> module. 213 214=head2 Known Object Parameters 215 216There are no object parameters registered by the C<Net::TCP::Server> 217module itself. 218 219=head2 Exports 220 221=over 4 222 223=item default 224 225none 226 227=item exportable 228 229none 230 231=item tags 232 233none 234 235=back 236 237=head1 THREADING STATUS 238 239This module has been tested with threaded perls, and should be as thread-safe 240as perl itself. (As of 5.005_03 and 5.005_57, that's not all that safe 241just yet.) It also works with interpreter-based threads ('ithreads') in 242more recent perl releases. 243 244=head1 SEE ALSO 245 246L<Net::TCP(3)|Net::TCP>, 247L<Net::Inet(3)|Net::Inet>, 248L<Net::Gen(3)|Net::Gen> 249 250=head1 AUTHOR 251 252Spider Boardman E<lt>spidb@cpan.orgE<gt> 253 254=cut 255 256#other sections should be added, sigh. 257 258#any real autoloaded methods go after this line 259