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