@@ -1,343 +1,3 @@
-Release as v1.011.
-
-Wed Apr 10 06:18:05 2002 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * lib/Net/Gen.dat: Re-version because of klutzed PAUSE upload.
-
-Release as v1.01.
-
-Wed Apr 10 06:18:05 2002 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * lib/Net/Gen.dat (BINMODE): Allow for PerlIO layers in binmode()
- calls.
-
- * Gen.xs: Update for 'loose' compiler I was using, exposed by
- complaints from users. I don't think xsubpp should be re-arranging
- as much as it is, which is what caused the declaration in the
- middle of the block, but that's a whole different battle.
-
-Release as v1.0.
-
-Sat Mar 30 04:25:08 2002 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * Makefile.PL: Override 'ci' rule to skip the .pm's.
-
- * MANIFEST: Add manifake for cleaner 'ci' handling.
-
- * Gen.dat, Gen.xs: Add AF_LOCAL & PF_LOCAL.
-
- * all: email address updates, copyright updates, POD tweaks.
- Re-version to 1.0.
-
-Release as v0.933.
-
-Wed Aug 2 12:42:36 2000 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * all the .dat files: Update the PODs.
-
-Release as v0.932.
-
-Wed Aug 2 12:42:36 2000 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * lib/Net/Gen.dat: Update @EXPORT_OK with the SO_* values,
- which I'd somehow missed before. Thanks to
- '"Ged the Grey's Hain" <Ged@FaerieMUD.org>' for the bug report.
-
-Release as v0.931.
-
-Sun Feb 20 18:40:17 2000 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * MANIFEST: re-add the lib/Net.../*.pm files for the PAUSE indexer.
-
- * Makefile.PL (gen_pm_files): Don't push .pm files onto the
- @delfiles array, or they won't be in the kit to be indexed
- by PAUSE.
-
-Release as v0.93.
-
-Wed Jan 19 02:45:18 2000 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * Makefile.PL (gen_pm_files): Create .pm files from .dat
- files, modifying the attribute lines appropriately depending
- on which version of perl we have.
-
- * MANIFEST: Replaced .pm files with .dat files.
-
- * lib/Net/Gen.dat: replaced .pm files with .dat files, so
- that C<sub : attrlist> vs. C<use attrs qw(attrlist)> problems
- wouldn't give multiple warnings with 5.5.640. Also made
- conversion of lib/attrs.dat to lib/attrs.pm dependent on
- whether we were going to install attrs.pm.
- lib/Net/**.dat: re-formatted attribute information and many
- subroutine headers for automated conversion from .dat to .pm
- files with the proper application of subroutine attributes.
-
-Release as v0.92.
-
-Internal snaphost as v0.9111.
-
-Tue Sep 21 12:02:11 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * lib/Net/Gen.pm: Bump version for next snapshot.
-
- * Gen.xs (BAD_TCP_MSS): Fix to undef TCP_MSS after netgen.h
- includes possible broken system .h files, and replace TCP_MSS
- with TCP_MSS_IETF.
-
- * Makefile.PL (%defdefines): Add TCP_MSS_IETF to hold the proper
- value, so that we can fix older Linux systems.
-
-Internal snapshot as v0.9110.
-
-Wed Aug 4 00:38:43 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * t/01unix.t (t_chk_hello_dgram): Don't hang in the receive if the
- client send() failed.
-
-Tue Aug 3 22:32:50 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * lib/Net/UNIX.pm: Pod tidying.
-
- * lib/Net/UNIX/Server.pm: Pod tidying.
-
- * lib/Net/TCP/Server.pm: Pod tidying.
-
- * lib/Net/TCP.pm: Pod tidying.
-
- * lib/Net/UDP.pm: Pod tidying.
-
- * lib/Net/Inet.pm: Tidied pods.
-
- * lib/Net/Gen.pm: Finish(?) implementing the netgen_fakeconnect
- object parameter by making ->connect(), ->send(), and ->sendto()
- respect it. Pod tweaks. Bump version for next snapshot.
-
- * t/00basic.t: Update method of returning error when not all tests
- succeed.
-
- * t/01unix.t: Slight tweak to return error status if not all tests
- succeeded.
-
-Internal snapshot as v0.9109.
-
-Tue Aug 3 01:58:29 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * Gen.xs: Make work with threaded 5.005_60.
-
- * lib/Net/Gen.pm: Bumped version for next snapshot.
-
-Internal snapshot as v0.9108.
-
-Wed Jul 21 18:48:15 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * t/01unix.t: Updated order of ./xlib ../xlib @INC searching.
-
- * t/00basic.t: Updated order of ./xlib ../xlib @INC searching.
-
- * Makefile.PL: Update to ensure -Ixlib for 5.004_04 "make test".
-
- * lib/Net/Gen.pm: Add new tied file handle routines for 5.005_57.
- Bumped version for next snapshot.
-
-Internal snapshot as v0.9107.
-
-Sat Jul 3 13:07:25 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * Makefile.PL: Updated CI value for my environment.
-
- * lib/Net/UDP.pm: Minor pod updates. Fixed threaded ->new.
-
- * lib/Net/TCP/Server.pm: Minor pod updates. Fixed threaded ->new.
-
- * lib/Net/TCP.pm: Minor pod updates. Fixed threaded ->new.
-
- * lib/Net/Inet.pm: Minor pod updates. Fixed threaded ->new.
-
- * lib/Net/UNIX/Server.pm: Minor pod updates. Fixed threaded ->new.
-
- * lib/Net/UNIX.pm: Minor pod updates. Fixed threaded ->new.
-
- * lib/Net/Gen.pm: Bumped version for next snapshot. Updated pods.
- Cleaned up ->_debug abuses in sockopt code. Fixed threaded ->new.
-
- * README: Updated to add thread-testing note.
-
-Internal snapshot as v0.9106.
-
-Sat Jul 3 12:22:17 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * README: Updated to claim 5.004_04 support again.
-
- * lib/Net/Gen.pm: Bump version for next snapshot.
-
- * t/00basic.t: Add xlib to @INC for 5.004_04.
-
- * t/01unix.t: Add xlib to @INC for 5.004_04.
-
- * MANIFEST: Added xlib/Test.pm and xlib/Test/Harness.pm for
- 5.004_04 sites.
-
-Internal snapshot as v0.9105.
-
-Fri Jul 2 14:05:44 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * Gen.xs: Change 5.004_0{4,5} detection of need for #defines
- of PL_dowarn, etc.
-
- * lib/Net/TCP/Server.pm: Reduce requirement back to 5.004_04.
-
- * lib/Net/UNIX/Server.pm: Reduce requirement back to 5.004_04.
-
- * lib/Net/UNIX.pm: Reduce requirement back to 5.004_04.
-
- * lib/Net/UDP.pm: Reduce requirement back to 5.004_04.
-
- * lib/Net/TCP.pm: Reduce requirement back to 5.004_04.
-
- * lib/Net/Inet.pm: Reduce requirement back to 5.004_04.
-
- * lib/Net/Gen.pm: Reduce requirement back to 5.004_04. Bump version
- for next snapshot.
-
- * Makefile.PL (MY::libscan): Add skip for attrs.pm unless it's
- not already installed. Reduce requirement back to 5.004_04.
-
- * MANIFEST: Add lib/attrs.pm .
-
-Internal snapshot as v0.9104.
-
-Tue Mar 9 13:44:26 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * t/01unix.t: Reduce clutter in the RCS string.
-
- * t/00basic.t: Reduce clutter in the RCS string.
-
- * lib/Net/UNIX/Server.pm: Reduce clutter in the RCS string. Bump
- version for next snapshot.
-
- * lib/Net/TCP/Server.pm: Reduce clutter in the RCS string. Bump
- version for next snapshot.
-
- * lib/Net/UNIX.pm: Reduce clutter in the RCS string. Bump version
- for next snapshot.
-
- * lib/Net/UDP.pm: Reduce clutter in the RCS string. Bump version
- for next snapshot.
-
- * lib/Net/TCP.pm: Reduce clutter in the RCS string. Bump version
- for next snapshot.
-
- * lib/Net/Inet.pm: Reduce clutter in the RCS string. Bump version
- for next snapshot.
-
- * lib/Net/Gen.pm: Reduce clutter in the RCS string. Bump version
- for next snapshot.
-
- * Makefile.PL: Reduce clutter in the RCS string.
-
- * Gen.xs: Reduce clutter in the RCS string.
-
-Internal snapshot as v0.9103.
-
-Tue Mar 9 12:57:11 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * t/00basic.t: Add a simple RCS string for the curious.
-
- * t/01unix.t: Clean up to avoid possible clashes with Socket and
- Net::Gen after adding the new constants to the latter. Add a
- simple RCS string for the curious.
-
- * lib/Net/UNIX/Server.pm: Make Version() a constant sub.
- Streamline AUTOLOAD a bit. Remove Socket dependencies. Add a
- simple RCS string for the curious.
-
- * lib/Net/TCP/Server.pm: Make Version() a constant sub.
- Streamline AUTOLOAD a bit. Remove Socket dependencies. Add a
- simple RCS string for the curious.
-
- * lib/Net/UNIX.pm: Clean up Socket dependencies by using new XS
- constants. Streamline AUTOLOAD a bit. Set netgen_fakeconnect for
- SOCK_DGRAM sockets. Make Version() a constant sub. Add a simple
- RCS string for the curious.
-
- * lib/Net/UDP.pm: Streamline AUTOLOAD a bit. Set
- netgen_fakeconnect for datagram sockets. Reduce dependency on
- Socket by using new XS constants. Make Version() a constant sub.
- Add a simple RCS string for the curious.
-
- * lib/Net/TCP.pm: Reduce dependency on Socket by using new XS
- constants. Streamline AUTOLOAD a bit (for future use). Make
- Version() a constant sub. Add a simple RCS string for the
- curious.
-
- * lib/Net/Inet.pm: Make Version() a constant sub. Reduce Socket
- dependencies by using new XS constants. Streamline AUTOLOAD a
- bit. Add a simple RCS string for the curious.
-
- * lib/Net/Gen.pm: Reduce bloat from Socket by adding new XS
- constants for various values. Add new export tags for the new
- constants. Add some missing sockopts. Start implementing
- netgen_fakeconnect object parameter for UDP versus Solaris 2.5.1.
- Update POD for the new constants, export tags, and socket options.
- Make Version() a constant sub. Streamline initsockopts() a bit.
- Add a simple RCS string for the curious.
-
- * Makefile.PL: Clean up PREOP and POSTOP, since the previous
- write-enabling was a bad idea with RCS. Add a simple RCS header
- for the curious.
-
- * Gen.xs: Use constants for several things we used to get from
- Socket, since the latter doesn't make them into constant subs.
- Add a simple RCS header for the curious.
-
-Sat Feb 27 02:08:01 1999 Spider Boardman <spider@Orb.Nashua.NH.US>
-
- * lib/Net/Inet.pm (_setport): Correct dependency on hash
- ordering which caused some connects not to happen because the
- port got set after the host, and the host was 0.
- (_sethost): Fixed up gotcha with binding to just a port or
- just a host.
- (_setproto): Slight improvement to use a hash-slice delete
- when clearing protocol information. Improve updating of
- the value to set at the epilogue.
-
- * All .pm files: Replace C<${*$self}> with C<*$self{HASH}>.
- It makes emacs happier with me, and it eliminates an annoying
- unoptimised block when single-stepping in the debugger.
- Rescinded upon realising that C<*$self{HASH}> has to generate
- a temporary to hold a newly-created RV. Changed them to
- C<$ {*$self}>, which looks ugly but works with emacs. I'll
- just have to live with the debugger wart.
-
- * lib/Net/UNIX/Server.pm: Get rid of `$myclass' in favour of
- __PACKAGE__. Update copyright. POD cleanup.
-
- * lib/Net/TCP/Server.pm: Get rid of `$myclass' in favour of
- __PACKAGE__. Update copyright. POD cleanup.
-
- * lib/Net/UNIX.pm: Get rid of `$myclass' in favour of
- __PACKAGE__. Update copyright. POD cleanup. Added
- unbuffered_IO options (and PODs) a la Net::UDP, except
- that they only operate on non-SOCK_STREAM sockets.
-
- * lib/Net/UDP.pm: Get rid of `$myclass' in favour of
- __PACKAGE__. Update copyright. POD cleanup.
- (_addrinfo): Always obey the $numeric_only flag.
-
- * lib/Net/TCP.pm: Finish getting rid of `$myclass' in favour
- of __PACKAGE__. POD cleanup.
- (_addrinfo): Always obey the $numeric_only flag.
-
- * lib/Net/Inet.pm: Finish getting rid of `$myclass' in favour
- of __PACKAGE__. POD cleanup.
-
- * lib/Net/Gen.pm: Fix up studly caps in EXPORT_TAGS, allowing
- non_block_vals as well as NonBlockVals. POD cleanup.
- Minor code tweaks for efficiency. Bump version.
-
- * Gen.xs: Allow for 4.4bsd-style addressing in unpack_sockaddr().
- Minor cleanup.
-
Release as v0.91. Now it should have non-blocking/timed connect logic
which works just about everywhere, as long as perl isn't built with SOCKS.
Maybe I'll move some of _valconnect into XS later, so that I have a shot
@@ -1,6 +1,6 @@
/*
-# Copyright 1995,2002 Spider Boardman.
+# Copyright 1995,1999 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -15,13 +15,6 @@
*/
-/*
- * Can't rely on #ifdef to keep some compilers from griping about a #pragma
- * which they don't recognize, so do it the old-fashioned way.
- */
-
-static char const rcsid[] = "@(#) $Id: Gen.xs,v 1.24 2002/04/10 11:05:58 spider Exp $";
-
#ifdef __cplusplus
extern "C" {
#endif
@@ -52,13 +45,12 @@ extern "C" {
#include "sockadapt.h"
#endif
-#include "netgen.h"
-
#ifdef BAD_TCP_MSS
# undef TCP_MSS
-# define TCP_MSS TCP_MSS_IETF
#endif
+#include "netgen.h"
+
#ifndef SHUT_RD
#ifdef O_RDONLY
#define SHUT_RD O_RDONLY
@@ -83,31 +75,14 @@ extern "C" {
#endif
#endif
-#if !defined(PATCHLEVEL)
+#if !defined(SUBVERSION) && !defined(PATCHLEVEL)
#include <patchlevel.h>
#endif
-#if (PATCHLEVEL < 5)
-#ifndef PL_sv_undef
+#if (PATCHLEVEL < 5) && (SUBVERSION < 5)
#define PL_dowarn dowarn
#define PL_sv_no sv_no
#define PL_sv_undef sv_undef
#endif
-#endif
-
-#ifndef dTHX
-#define dTHX dTHR
-#define pTHX_
-#define _pTHX
-#define pTHX
-#define aTHX
-#define aTHX_
-#define _aTHX
-#define NV double
-#endif
-
-#ifndef dTHR
-#define dTHR extern int Perl___notused
-#endif
#ifdef __cplusplus
}
@@ -131,16 +106,12 @@ extern "C" {
#define EWOULDBLOCK EAGAIN
#endif
+HV *missing; /* not_there cases for AUTOLOAD() */
+
static void
-#ifdef CAN_PROTOTYPE
-#define newmissing(_hv,_nm,_fl) S_newmissing(aTHX_ _hv, _nm, _fl)
-S_newmissing(pTHX_ HV *missing, char *name, char *file)
-#else
-newmissing(missing, name, file)
-HV *missing;
+newmissing(name, file)
char *name;
char *file;
-#endif
{
STRLEN klen;
CV *cv;
@@ -150,7 +121,6 @@ char *file;
sv_setsv((SV*)cv, &PL_sv_no); /* prototype it as "()" */
}
-#ifndef CVf_CONST
/*
* cv_constant() exists so that the constant XSUBs will return their
* proper values even when not inlined.
@@ -178,15 +148,10 @@ XS(cv_constant)
*/
static void
-#ifdef CAN_PROTOTYPE
-#define newXSconst(_nm,_vsv,_fl) S_newXSconst(aTHX_ _nm, _vsv, _fl)
-S_newXSconst(pTHX_ char *name, SV *valsv, char *file)
-#else
newXSconst(name, valsv, file)
char * name;
SV * valsv;
char * file;
-#endif
{
CV *cv;
OP *svop;
@@ -198,69 +163,46 @@ char * file;
svop->op_next = Nullop; /* terminate search in cv_const_sv() */
CvSTART(cv) = svop; /* voila! we're a constant! */
}
-#else /* !defined CVf_CONST, now defined */
-#define newXSconst(_nm,_vsv,_fl) Perl_newCONSTSUB(aTHX_ Nullhv, _nm, _vsv)
-#endif /* defined CVf_CONST */
/*
* Auxiliary routines to create constant XSUBs of various types.
*/
static void
-#ifdef CAN_PROTOTYPE
-#define newXSconstPV(_nm,_st,_fl) S_newXSconstPV(aTHX_ _nm, _st, _fl)
-S_newXSconstPV(pTHX_ char *name, char *string, char *file)
-#else
newXSconstPV(name, string, file)
char *name;
char *string;
char *file;
-#endif
{
SV *valsv = newSVpv(string, strlen(string));
newXSconst(name, valsv, file);
}
static void
-#ifdef CAN_PROTOTYPE
-#define newXSconstPVN(_nm,_st,_ln,_fl) S_newXSconstPVN(aTHX_ _nm, _st, _ln, _fl)
-S_newXSconstPVN(pTHX_ char *name, char *string, STRLEN len, char *file)
-#else
newXSconstPVN(name, string, len, file)
char *name;
char *string;
STRLEN len;
char *file;
-#endif
{
SV *valsv = newSVpv(string, len);
newXSconst(name, valsv, file);
}
static void
-#ifdef CAN_PROTOTYPE
-#define newXSconstIV(_nm,_iv,_fl) S_newXSconstIV(aTHX_ _nm, _iv, _fl)
-S_newXSconstIV(pTHX_ char *name, IV ival, char *file)
-#else
newXSconstIV(name, ival, file)
char *name;
IV ival;
char *file;
-#endif
{
newXSconst(name, newSViv(ival), file);
}
static void
-#ifdef CAN_PROTOTYPE
-#define newXSconstUV(_nm,_uv,_fl) S_newXSconstUV(aTHX_ _nm, _uv, _fl)
-S_newXSconstUV(pTHX_ char *name, UV uval, char *file)
-#else
newXSconstUV(name, uval, file)
char * name;
UV uval;
char * file;
-#endif
{
SV * valsv = newSVsv(&PL_sv_undef); /* missing newSVuv()! */
sv_setuv(valsv, uval);
@@ -268,15 +210,10 @@ char * file;
}
static void
-#ifdef CAN_PROTOTYPE
-#define newXSconstNV(_nm,_nv,_fl) S_newXSconstNV(aTHX_ _nm, _nv, _fl)
-S_newXSconstNV(pTHX_ char *name, NV nval, char *file)
-#else
newXSconstNV(name, nval, file)
char * name;
double nval;
char * file;
-#endif
{
newXSconst(name, newSVnv(nval), file);
}
@@ -288,13 +225,8 @@ typedef U32 sv_inaddr_t;
*/
static sv_inaddr_t
-#ifdef CAN_PROTOTYPE
-#define sv2inaddr(_sv) S_sv2inaddr(aTHX_ _sv)
-S_sv2inaddr(pTHX_ SV *sv)
-#else
sv2inaddr(sv)
SV *sv;
-#endif
{
struct in_addr ina;
char *cp;
@@ -336,8 +268,7 @@ MODULE = Net::Gen PACKAGE = Net::Gen
PROTOTYPES: ENABLE
BOOT:
- {
- HV *missing = perl_get_hv("Net::Gen::_missing", GV_ADDMULTI);
+ missing = perl_get_hv("Net::Gen::_missing", GV_ADDMULTI);
MODULE = Net::Gen PACKAGE = Net::TCP PREFIX = f_uc_
@@ -350,7 +281,7 @@ BOOT:
#ifdef TCP_MAXSEG
newXSconstUV("Net::TCP::TCP_MAXSEG", TCP_MAXSEG, file);
#else
- newmissing(missing, "Net::TCP::TCP_MAXSEG", file);
+ newmissing("Net::TCP::TCP_MAXSEG", file);
#endif
newXSconstUV("Net::TCP::TCP_MAXWIN", TCP_MAXWIN, file);
newXSconstUV("Net::TCP::TCP_MAX_WINSHIFT", TCP_MAX_WINSHIFT, file);
@@ -358,12 +289,12 @@ BOOT:
#ifdef TCP_NODELAY
newXSconstUV("Net::TCP::TCP_NODELAY", TCP_NODELAY, file);
#else
- newmissing(missing, "Net::TCP::TCP_NODELAY", file);
+ newmissing("Net::TCP::TCP_NODELAY", file);
#endif
#ifdef TCP_RPTR2RXT
newXSconstUV("Net::TCP::TCP_RPTR2RXT", TCP_RPTR2RXT, file);
#else
- newmissing(missing, "Net::TCP::TCP_RPTR2RXT", file);
+ newmissing("Net::TCP::TCP_RPTR2RXT", file);
#endif
newXSconstUV("Net::TCP::TH_ACK", TH_ACK, file);
newXSconstUV("Net::TCP::TH_FIN", TH_FIN, file);
@@ -414,17 +345,17 @@ BOOT:
#ifdef IN_CLASSA_SUBHOST
newXSconstUV("Net::Inet::IN_CLASSA_SUBHOST", IN_CLASSA_SUBHOST, file);
#else
- newmissing(missing, "Net::Inet::IN_CLASSA_SUBHOST", file);
+ newmissing("Net::Inet::IN_CLASSA_SUBHOST", file);
#endif
#ifdef IN_CLASSA_SUBNET
newXSconstUV("Net::Inet::IN_CLASSA_SUBNET", IN_CLASSA_SUBNET, file);
#else
- newmissing(missing, "Net::Inet::IN_CLASSA_SUBNET", file);
+ newmissing("Net::Inet::IN_CLASSA_SUBNET", file);
#endif
#ifdef IN_CLASSA_SUBNSHIFT
newXSconstUV("Net::Inet::IN_CLASSA_SUBNSHIFT", IN_CLASSA_SUBNSHIFT, file);
#else
- newmissing(missing, "Net::Inet::IN_CLASSA_SUBNSHIFT", file);
+ newmissing("Net::Inet::IN_CLASSA_SUBNSHIFT", file);
#endif
newXSconstUV("Net::Inet::IN_CLASSB_HOST", IN_CLASSB_HOST, file);
newXSconstUV("Net::Inet::IN_CLASSB_MAX", IN_CLASSB_MAX, file);
@@ -433,17 +364,17 @@ BOOT:
#ifdef IN_CLASSB_SUBHOST
newXSconstUV("Net::Inet::IN_CLASSB_SUBHOST", IN_CLASSB_SUBHOST, file);
#else
- newmissing(missing, "Net::Inet::IN_CLASSB_SUBHOST", file);
+ newmissing("Net::Inet::IN_CLASSB_SUBHOST", file);
#endif
#ifdef IN_CLASSB_SUBNET
newXSconstUV("Net::Inet::IN_CLASSB_SUBNET", IN_CLASSB_SUBNET, file);
#else
- newmissing(missing, "Net::Inet::IN_CLASSB_SUBNET", file);
+ newmissing("Net::Inet::IN_CLASSB_SUBNET", file);
#endif
#ifdef IN_CLASSB_SUBNSHIFT
newXSconstUV("Net::Inet::IN_CLASSB_SUBNSHIFT", IN_CLASSB_SUBNSHIFT, file);
#else
- newmissing(missing, "Net::Inet::IN_CLASSB_SUBNSHIFT", file);
+ newmissing("Net::Inet::IN_CLASSB_SUBNSHIFT", file);
#endif
newXSconstUV("Net::Inet::IN_CLASSC_HOST", IN_CLASSC_HOST, file);
newXSconstUV("Net::Inet::IN_CLASSC_MAX", IN_CLASSC_MAX, file);
@@ -456,7 +387,7 @@ BOOT:
#ifdef IPFRAGTTL
newXSconstUV("Net::Inet::IPFRAGTTL", IPFRAGTTL, file);
#else
- newmissing(missing, "Net::Inet::IPFRAGTTL", file);
+ newmissing("Net::Inet::IPFRAGTTL", file);
#endif
newXSconstUV("Net::Inet::IPOPT_CIPSO", IPOPT_CIPSO, file);
newXSconstUV("Net::Inet::IPOPT_CONTROL", IPOPT_CONTROL, file);
@@ -490,7 +421,7 @@ BOOT:
#ifdef IPPORT_TIMESERVER
newXSconstUV("Net::Inet::IPPORT_TIMESERVER", IPPORT_TIMESERVER, file);
#else
- newmissing(missing, "Net::Inet::IPPORT_TIMESERVER", file);
+ newmissing("Net::Inet::IPPORT_TIMESERVER", file);
#endif
newXSconstUV("Net::Inet::IPPORT_USERRESERVED", IPPORT_USERRESERVED, file);
newXSconstUV("Net::Inet::IPPROTO_EGP", IPPROTO_EGP, file);
@@ -525,86 +456,86 @@ BOOT:
#ifdef IP_ADD_MEMBERSHIP
newXSconstUV("Net::Inet::IP_ADD_MEMBERSHIP", IP_ADD_MEMBERSHIP, file);
#else
- newmissing(missing, "Net::Inet::IP_ADD_MEMBERSHIP", file);
+ newmissing("Net::Inet::IP_ADD_MEMBERSHIP", file);
#endif
#ifdef IP_DEFAULT_MULTICAST_LOOP
newXSconstUV("Net::Inet::IP_DEFAULT_MULTICAST_LOOP", IP_DEFAULT_MULTICAST_LOOP, file);
#else
- newmissing(missing, "Net::Inet::IP_DEFAULT_MULTICAST_LOOP", file);
+ newmissing("Net::Inet::IP_DEFAULT_MULTICAST_LOOP", file);
#endif
#ifdef IP_DEFAULT_MULTICAST_TTL
newXSconstUV("Net::Inet::IP_DEFAULT_MULTICAST_TTL", IP_DEFAULT_MULTICAST_TTL, file);
#else
- newmissing(missing, "Net::Inet::IP_DEFAULT_MULTICAST_TTL", file);
+ newmissing("Net::Inet::IP_DEFAULT_MULTICAST_TTL", file);
#endif
newXSconstUV("Net::Inet::IP_DF", IP_DF, file);
#ifdef IP_DROP_MEMBERSHIP
newXSconstUV("Net::Inet::IP_DROP_MEMBERSHIP", IP_DROP_MEMBERSHIP, file);
#else
- newmissing(missing, "Net::Inet::IP_DROP_MEMBERSHIP", file);
+ newmissing("Net::Inet::IP_DROP_MEMBERSHIP", file);
#endif
#ifdef IP_HDRINCL
newXSconstUV("Net::Inet::IP_HDRINCL", IP_HDRINCL, file);
#else
- newmissing(missing, "Net::Inet::IP_HDRINCL", file);
+ newmissing("Net::Inet::IP_HDRINCL", file);
#endif
newXSconstUV("Net::Inet::IP_MAXPACKET", IP_MAXPACKET, file);
#ifdef IP_MAX_MEMBERSHIPS
newXSconstUV("Net::Inet::IP_MAX_MEMBERSHIPS", IP_MAX_MEMBERSHIPS, file);
#else
- newmissing(missing, "Net::Inet::IP_MAX_MEMBERSHIPS", file);
+ newmissing("Net::Inet::IP_MAX_MEMBERSHIPS", file);
#endif
newXSconstUV("Net::Inet::IP_MF", IP_MF, file);
newXSconstUV("Net::Inet::IP_MSS", IP_MSS, file);
#ifdef IP_MULTICAST_IF
newXSconstUV("Net::Inet::IP_MULTICAST_IF", IP_MULTICAST_IF, file);
#else
- newmissing(missing, "Net::Inet::IP_MULTICAST_IF", file);
+ newmissing("Net::Inet::IP_MULTICAST_IF", file);
#endif
#ifdef IP_MULTICAST_LOOP
newXSconstUV("Net::Inet::IP_MULTICAST_LOOP", IP_MULTICAST_LOOP, file);
#else
- newmissing(missing, "Net::Inet::IP_MULTICAST_LOOP", file);
+ newmissing("Net::Inet::IP_MULTICAST_LOOP", file);
#endif
#ifdef IP_MULTICAST_TTL
newXSconstUV("Net::Inet::IP_MULTICAST_TTL", IP_MULTICAST_TTL, file);
#else
- newmissing(missing, "Net::Inet::IP_MULTICAST_TTL", file);
+ newmissing("Net::Inet::IP_MULTICAST_TTL", file);
#endif
#ifdef IP_OPTIONS
newXSconstUV("Net::Inet::IP_OPTIONS", IP_OPTIONS, file);
#else
- newmissing(missing, "Net::Inet::IP_OPTIONS", file);
+ newmissing("Net::Inet::IP_OPTIONS", file);
#endif
#ifdef IP_RECVDSTADDR
newXSconstUV("Net::Inet::IP_RECVDSTADDR", IP_RECVDSTADDR, file);
#else
- newmissing(missing, "Net::Inet::IP_RECVDSTADDR", file);
+ newmissing("Net::Inet::IP_RECVDSTADDR", file);
#endif
#ifdef IP_RECVOPTS
newXSconstUV("Net::Inet::IP_RECVOPTS", IP_RECVOPTS, file);
#else
- newmissing(missing, "Net::Inet::IP_RECVOPTS", file);
+ newmissing("Net::Inet::IP_RECVOPTS", file);
#endif
#ifdef IP_RECVRETOPTS
newXSconstUV("Net::Inet::IP_RECVRETOPTS", IP_RECVRETOPTS, file);
#else
- newmissing(missing, "Net::Inet::IP_RECVRETOPTS", file);
+ newmissing("Net::Inet::IP_RECVRETOPTS", file);
#endif
#ifdef IP_RETOPTS
newXSconstUV("Net::Inet::IP_RETOPTS", IP_RETOPTS, file);
#else
- newmissing(missing, "Net::Inet::IP_RETOPTS", file);
+ newmissing("Net::Inet::IP_RETOPTS", file);
#endif
#ifdef IP_TOS
newXSconstUV("Net::Inet::IP_TOS", IP_TOS, file);
#else
- newmissing(missing, "Net::Inet::IP_TOS", file);
+ newmissing("Net::Inet::IP_TOS", file);
#endif
#ifdef IP_TTL
newXSconstUV("Net::Inet::IP_TTL", IP_TTL, file);
#else
- newmissing(missing, "Net::Inet::IP_TTL", file);
+ newmissing("Net::Inet::IP_TTL", file);
#endif
newXSconstUV("Net::Inet::MAXTTL", MAXTTL, file);
newXSconstUV("Net::Inet::MAX_IPOPTLEN", MAX_IPOPTLEN, file);
@@ -612,7 +543,7 @@ BOOT:
#ifdef SUBNETSHIFT
newXSconstUV("Net::Inet::SUBNETSHIFT", SUBNETSHIFT, file);
#else
- newmissing(missing, "Net::Inet::SUBNETSHIFT", file);
+ newmissing("Net::Inet::SUBNETSHIFT", file);
#endif
{
struct in_addr ina;
@@ -677,7 +608,7 @@ bool
ICMP_INFOTYPE(icmp_code)
U8 icmp_code
-void
+SV *
_pack_sockaddr_in(family,port,address)
U8 family
U16 port
@@ -686,7 +617,7 @@ _pack_sockaddr_in(family,port,address)
struct sockaddr_in sin;
char * adata;
STRLEN adlen;
- PPCODE:
+ CODE:
Zero(&sin, sizeof sin, char);
sin.sin_family = family;
adata = SvPV(address, adlen);
@@ -702,7 +633,6 @@ _pack_sockaddr_in(family,port,address)
sv_catpvn(adsv, adata, adlen);
ST(0) = adsv;
}
- XSRETURN(1);
void
unpack_sockaddr_in(sad)
@@ -769,7 +699,7 @@ BOOT:
#ifdef RD_NODATA
newXSconstIV("Net::Gen::RD_NODATA", RD_NODATA, file);
#else
- newmissing(missing, "Net::Gen::RD_NODATA", file);
+ newmissing("Net::Gen::RD_NODATA", file);
#endif
newXSconstIV("Net::Gen::SHUT_RD", SHUT_RD, file);
newXSconstIV("Net::Gen::SHUT_WR", SHUT_WR, file);
@@ -782,447 +712,14 @@ BOOT:
#ifdef VAL_O_NONBLOCK
newXSconstUV("Net::Gen::VAL_O_NONBLOCK", VAL_O_NONBLOCK, file);
#else
- newmissing(missing, "Net::Gen::VAL_O_NONBLOCK", file);
+ newmissing("Net::Gen::VAL_O_NONBLOCK", file);
#endif
#ifdef VAL_EAGAIN
newXSconstUV("Net::Gen::VAL_EAGAIN", VAL_EAGAIN, file);
#else
- newmissing(missing, "Net::Gen::VAL_EAGAIN", file);
+ newmissing("Net::Gen::VAL_EAGAIN", file);
#endif
newXSconstUV("Net::Gen::MSG_OOB", MSG_OOB, file);
-#ifdef SO_ACCEPTCONN
- newXSconstUV("Net::Gen::SO_ACCEPTCONN", SO_ACCEPTCONN, file);
-#else
- newmissing(missing, "Net::Gen::SO_ACCEPTCONN", file);
-#endif
-#ifdef SO_BROADCAST
- newXSconstUV("Net::Gen::SO_BROADCAST", SO_BROADCAST, file);
-#else
- newmissing(missing, "Net::Gen::SO_BROADCAST", file);
-#endif
-#ifdef SO_DEBUG
- newXSconstUV("Net::Gen::SO_DEBUG", SO_DEBUG, file);
-#else
- newmissing(missing, "Net::Gen::SO_DEBUG", file);
-#endif
-#ifdef SO_DONTROUTE
- newXSconstUV("Net::Gen::SO_DONTROUTE", SO_DONTROUTE, file);
-#else
- newmissing(missing, "Net::Gen::SO_DONTROUTE", file);
-#endif
-#ifdef SO_ERROR
- newXSconstUV("Net::Gen::SO_ERROR", SO_ERROR, file);
-#else
- newmissing(missing, "Net::Gen::SO_ERROR", file);
-#endif
-#ifdef SO_EXPANDED_RIGHTS
- newXSconstUV("Net::Gen::SO_EXPANDED_RIGHTS", SO_EXPANDED_RIGHTS, file);
-#else
- newmissing(missing, "Net::Gen::SO_EXPANDED_RIGHTS", file);
-#endif
-#ifdef SO_KEEPALIVE
- newXSconstUV("Net::Gen::SO_KEEPALIVE", SO_KEEPALIVE, file);
-#else
- newmissing(missing, "Net::Gen::SO_KEEPALIVE", file);
-#endif
-#ifdef SO_OOBINLINE
- newXSconstUV("Net::Gen::SO_OOBINLINE", SO_OOBINLINE, file);
-#else
- newmissing(missing, "Net::Gen::SO_OOBINLINE", file);
-#endif
-#ifdef SO_PAIRABLE
- newXSconstUV("Net::Gen::SO_PAIRABLE", SO_PAIRABLE, file);
-#else
- newmissing(missing, "Net::Gen::SO_PAIRABLE", file);
-#endif
-#ifdef SO_REUSEADDR
- newXSconstUV("Net::Gen::SO_REUSEADDR", SO_REUSEADDR, file);
-#else
- newmissing(missing, "Net::Gen::SO_REUSEADDR", file);
-#endif
-#ifdef SO_REUSEPORT
- newXSconstUV("Net::Gen::SO_REUSEPORT", SO_REUSEPORT, file);
-#else
- newmissing(missing, "Net::Gen::SO_REUSEPORT", file);
-#endif
-#ifdef SO_USELOOPBACK
- newXSconstUV("Net::Gen::SO_USELOOPBACK", SO_USELOOPBACK, file);
-#else
- newmissing(missing, "Net::Gen::SO_USELOOPBACK", file);
-#endif
-#ifdef SO_XSE
- newXSconstUV("Net::Gen::SO_XSE", SO_XSE, file);
-#else
- newmissing(missing, "Net::Gen::SO_XSE", file);
-#endif
-#ifdef SO_RCVBUF
- newXSconstUV("Net::Gen::SO_RCVBUF", SO_RCVBUF, file);
-#else
- newmissing(missing, "Net::Gen::SO_RCVBUF", file);
-#endif
-#ifdef SO_SNDBUF
- newXSconstUV("Net::Gen::SO_SNDBUF", SO_SNDBUF, file);
-#else
- newmissing(missing, "Net::Gen::SO_SNDBUF", file);
-#endif
-#ifdef SO_RCVTIMEO
- newXSconstUV("Net::Gen::SO_RCVTIMEO", SO_RCVTIMEO, file);
-#else
- newmissing(missing, "Net::Gen::SO_RCVTIMEO", file);
-#endif
-#ifdef SO_SNDTIMEO
- newXSconstUV("Net::Gen::SO_SNDTIMEO", SO_SNDTIMEO, file);
-#else
- newmissing(missing, "Net::Gen::SO_SNDTIMEO", file);
-#endif
-#ifdef SO_RCVLOWAT
- newXSconstUV("Net::Gen::SO_RCVLOWAT", SO_RCVLOWAT, file);
-#else
- newmissing(missing, "Net::Gen::SO_RCVLOWAT", file);
-#endif
-#ifdef SO_SNDLOWAT
- newXSconstUV("Net::Gen::SO_SNDLOWAT", SO_SNDLOWAT, file);
-#else
- newmissing(missing, "Net::Gen::SO_SNDLOWAT", file);
-#endif
-#ifdef SO_TYPE
- newXSconstUV("Net::Gen::SO_TYPE", SO_TYPE, file);
-#else
- newmissing(missing, "Net::Gen::SO_TYPE", file);
-#endif
-#ifdef SO_STATE
- newXSconstUV("Net::Gen::SO_STATE", SO_STATE, file);
-#else
- newmissing(missing, "Net::Gen::SO_STATE", file);
-#endif
-#ifdef SO_FAMILY
- newXSconstUV("Net::Gen::SO_FAMILY", SO_FAMILY, file);
-#else
- newmissing(missing, "Net::Gen::SO_FAMILY", file);
-#endif
-#ifdef SO_LINGER
- newXSconstUV("Net::Gen::SO_LINGER", SO_LINGER, file);
-#else
- newmissing(missing, "Net::Gen::SO_LINGER", file);
-#endif
-#ifdef SOL_SOCKET
- newXSconstUV("Net::Gen::SOL_SOCKET", SOL_SOCKET, file);
-#else
- newmissing(missing, "Net::Gen::SOL_SOCKET", file);
-#endif
-#ifdef SOCK_STREAM
- newXSconstUV("Net::Gen::SOCK_STREAM", SOCK_STREAM, file);
-#else
- newmissing(missing, "Net::Gen::SOCK_STREAM", file);
-#endif
-#ifdef SOCK_DGRAM
- newXSconstUV("Net::Gen::SOCK_DGRAM", SOCK_DGRAM, file);
-#else
- newmissing(missing, "Net::Gen::SOCK_DGRAM", file);
-#endif
-#ifdef SOCK_RAW
- newXSconstUV("Net::Gen::SOCK_RAW", SOCK_RAW, file);
-#else
- newmissing(missing, "Net::Gen::SOCK_RAW", file);
-#endif
-#ifdef SOCK_RDM
- newXSconstUV("Net::Gen::SOCK_RDM", SOCK_RDM, file);
-#else
- newmissing(missing, "Net::Gen::SOCK_RDM", file);
-#endif
-#ifdef SOCK_SEQPACKET
- newXSconstUV("Net::Gen::SOCK_SEQPACKET", SOCK_SEQPACKET, file);
-#else
- newmissing(missing, "Net::Gen::SOCK_SEQPACKET", file);
-#endif
-#ifndef AF_UNSPEC
-#define AF_UNSPEC 0
-#endif
- newXSconstUV("Net::Gen::AF_UNSPEC", AF_UNSPEC, file);
-#ifndef PF_UNSPEC
-#define PF_UNSPEC 0
-#endif
- newXSconstUV("Net::Gen::PF_UNSPEC", PF_UNSPEC, file);
-#ifdef AF_INET
- newXSconstUV("Net::Gen::AF_INET", AF_INET, file);
-#else
- newmissing(missing, "Net::Gen::AF_INET", file);
-#endif
-#ifdef PF_INET
- newXSconstUV("Net::Gen::PF_INET", PF_INET, file);
-#else
- newmissing(missing, "Net::Gen::PF_INET", file);
-#endif
-#ifndef AF_UNIX
-#ifdef AF_LOCAL
-#define AF_UNIX AF_LOCAL
-#endif
-#endif
-#ifndef PF_UNIX
-#ifdef PF_LOCAL
-#define PF_UNIX PF_LOCAL
-#endif
-#endif
-#ifndef AF_LOCAL
-#ifdef AF_UNIX
-#define AF_LOCAL AF_UNIX
-#endif
-#endif
-#ifndef PF_LOCAL
-#ifdef PF_UNIX
-#define PF_LOCAL PF_UNIX
-#endif
-#endif
-#ifdef AF_UNIX
- newXSconstUV("Net::Gen::AF_UNIX", AF_UNIX, file);
-#else
- newmissing(missing, "Net::Gen::AF_UNIX", file);
-#endif
-#ifdef PF_UNIX
- newXSconstUV("Net::Gen::PF_UNIX", PF_UNIX, file);
-#else
- newmissing(missing, "Net::Gen::PF_UNIX", file);
-#endif
-#ifdef AF_LOCAL
- newXSconstUV("Net::Gen::AF_LOCAL", AF_LOCAL, file);
-#else
- newmissing(missing, "Net::Gen::AF_LOCAL", file);
-#endif
-#ifdef PF_LOCAL
- newXSconstUV("Net::Gen::PF_LOCAL", PF_LOCAL, file);
-#else
- newmissing(missing, "Net::Gen::PF_LOCAL", file);
-#endif
-#ifdef AF_IMPLINK
- newXSconstUV("Net::Gen::AF_IMPLINK", AF_IMPLINK, file);
-#else
- newmissing(missing, "Net::Gen::AF_IMPLINK", file);
-#endif
-#ifdef PF_IMPLINK
- newXSconstUV("Net::Gen::PF_IMPLINK", PF_IMPLINK, file);
-#else
- newmissing(missing, "Net::Gen::PF_IMPLINK", file);
-#endif
-#ifdef AF_PUP
- newXSconstUV("Net::Gen::AF_PUP", AF_PUP, file);
-#else
- newmissing(missing, "Net::Gen::AF_PUP", file);
-#endif
-#ifdef PF_PUP
- newXSconstUV("Net::Gen::PF_PUP", PF_PUP, file);
-#else
- newmissing(missing, "Net::Gen::PF_PUP", file);
-#endif
-#ifdef AF_CHAOS
- newXSconstUV("Net::Gen::AF_CHAOS", AF_CHAOS, file);
-#else
- newmissing(missing, "Net::Gen::AF_CHAOS", file);
-#endif
-#ifdef PF_CHAOS
- newXSconstUV("Net::Gen::PF_CHAOS", PF_CHAOS, file);
-#else
- newmissing(missing, "Net::Gen::PF_CHAOS", file);
-#endif
-#ifdef AF_NS
- newXSconstUV("Net::Gen::AF_NS", AF_NS, file);
-#else
- newmissing(missing, "Net::Gen::AF_NS", file);
-#endif
-#ifdef PF_NS
- newXSconstUV("Net::Gen::PF_NS", PF_NS, file);
-#else
- newmissing(missing, "Net::Gen::PF_NS", file);
-#endif
-#ifdef AF_ISO
- newXSconstUV("Net::Gen::AF_ISO", AF_ISO, file);
-#else
- newmissing(missing, "Net::Gen::AF_ISO", file);
-#endif
-#ifdef PF_ISO
- newXSconstUV("Net::Gen::PF_ISO", PF_ISO, file);
-#else
- newmissing(missing, "Net::Gen::PF_ISO", file);
-#endif
-#ifdef AF_OSI
- newXSconstUV("Net::Gen::AF_OSI", AF_OSI, file);
-#else
- newmissing(missing, "Net::Gen::AF_OSI", file);
-#endif
-#ifdef PF_OSI
- newXSconstUV("Net::Gen::PF_OSI", PF_OSI, file);
-#else
- newmissing(missing, "Net::Gen::PF_OSI", file);
-#endif
-#ifdef AF_ECMA
- newXSconstUV("Net::Gen::AF_ECMA", AF_ECMA, file);
-#else
- newmissing(missing, "Net::Gen::AF_ECMA", file);
-#endif
-#ifdef PF_ECMA
- newXSconstUV("Net::Gen::PF_ECMA", PF_ECMA, file);
-#else
- newmissing(missing, "Net::Gen::PF_ECMA", file);
-#endif
-#ifdef AF_DATAKIT
- newXSconstUV("Net::Gen::AF_DATAKIT", AF_DATAKIT, file);
-#else
- newmissing(missing, "Net::Gen::AF_DATAKIT", file);
-#endif
-#ifdef PF_DATAKIT
- newXSconstUV("Net::Gen::PF_DATAKIT", PF_DATAKIT, file);
-#else
- newmissing(missing, "Net::Gen::PF_DATAKIT", file);
-#endif
-#ifdef AF_CCITT
- newXSconstUV("Net::Gen::AF_CCITT", AF_CCITT, file);
-#else
- newmissing(missing, "Net::Gen::AF_CCITT", file);
-#endif
-#ifdef PF_CCITT
- newXSconstUV("Net::Gen::PF_CCITT", PF_CCITT, file);
-#else
- newmissing(missing, "Net::Gen::PF_CCITT", file);
-#endif
-#ifdef AF_SNA
- newXSconstUV("Net::Gen::AF_SNA", AF_SNA, file);
-#else
- newmissing(missing, "Net::Gen::AF_SNA", file);
-#endif
-#ifdef PF_SNA
- newXSconstUV("Net::Gen::PF_SNA", PF_SNA, file);
-#else
- newmissing(missing, "Net::Gen::PF_SNA", file);
-#endif
-#ifdef AF_DECnet
- newXSconstUV("Net::Gen::AF_DECnet", AF_DECnet, file);
-#else
- newmissing(missing, "Net::Gen::AF_DECnet", file);
-#endif
-#ifdef PF_DECnet
- newXSconstUV("Net::Gen::PF_DECnet", PF_DECnet, file);
-#else
- newmissing(missing, "Net::Gen::PF_DECnet", file);
-#endif
-#ifdef AF_DLI
- newXSconstUV("Net::Gen::AF_DLI", AF_DLI, file);
-#else
- newmissing(missing, "Net::Gen::AF_DLI", file);
-#endif
-#ifdef PF_DLI
- newXSconstUV("Net::Gen::PF_DLI", PF_DLI, file);
-#else
- newmissing(missing, "Net::Gen::PF_DLI", file);
-#endif
-#ifdef AF_LAT
- newXSconstUV("Net::Gen::AF_LAT", AF_LAT, file);
-#else
- newmissing(missing, "Net::Gen::AF_LAT", file);
-#endif
-#ifdef PF_LAT
- newXSconstUV("Net::Gen::PF_LAT", PF_LAT, file);
-#else
- newmissing(missing, "Net::Gen::PF_LAT", file);
-#endif
-#ifdef AF_HYLINK
- newXSconstUV("Net::Gen::AF_HYLINK", AF_HYLINK, file);
-#else
- newmissing(missing, "Net::Gen::AF_HYLINK", file);
-#endif
-#ifdef PF_HYLINK
- newXSconstUV("Net::Gen::PF_HYLINK", PF_HYLINK, file);
-#else
- newmissing(missing, "Net::Gen::PF_HYLINK", file);
-#endif
-#ifdef AF_APPLETALK
- newXSconstUV("Net::Gen::AF_APPLETALK", AF_APPLETALK, file);
-#else
- newmissing(missing, "Net::Gen::AF_APPLETALK", file);
-#endif
-#ifdef PF_APPLETALK
- newXSconstUV("Net::Gen::PF_APPLETALK", PF_APPLETALK, file);
-#else
- newmissing(missing, "Net::Gen::PF_APPLETALK", file);
-#endif
-#ifdef AF_ROUTE
- newXSconstUV("Net::Gen::AF_ROUTE", AF_ROUTE, file);
-#else
- newmissing(missing, "Net::Gen::AF_ROUTE", file);
-#endif
-#ifdef PF_ROUTE
- newXSconstUV("Net::Gen::PF_ROUTE", PF_ROUTE, file);
-#else
- newmissing(missing, "Net::Gen::PF_ROUTE", file);
-#endif
-#ifdef AF_LINK
- newXSconstUV("Net::Gen::AF_LINK", AF_LINK, file);
-#else
- newmissing(missing, "Net::Gen::AF_LINK", file);
-#endif
-#ifdef PF_LINK
- newXSconstUV("Net::Gen::PF_LINK", PF_LINK, file);
-#else
- newmissing(missing, "Net::Gen::PF_LINK", file);
-#endif
-#ifdef AF_NETMAN
- newXSconstUV("Net::Gen::AF_NETMAN", AF_NETMAN, file);
-#else
- newmissing(missing, "Net::Gen::AF_NETMAN", file);
-#endif
-#ifdef PF_NETMAN
- newXSconstUV("Net::Gen::PF_NETMAN", PF_NETMAN, file);
-#else
- newmissing(missing, "Net::Gen::PF_NETMAN", file);
-#endif
-#ifdef AF_X25
- newXSconstUV("Net::Gen::AF_X25", AF_X25, file);
-#else
- newmissing(missing, "Net::Gen::AF_X25", file);
-#endif
-#ifdef PF_X25
- newXSconstUV("Net::Gen::PF_X25", PF_X25, file);
-#else
- newmissing(missing, "Net::Gen::PF_X25", file);
-#endif
-#ifdef AF_CTF
- newXSconstUV("Net::Gen::AF_CTF", AF_CTF, file);
-#else
- newmissing(missing, "Net::Gen::AF_CTF", file);
-#endif
-#ifdef PF_CTF
- newXSconstUV("Net::Gen::PF_CTF", PF_CTF, file);
-#else
- newmissing(missing, "Net::Gen::PF_CTF", file);
-#endif
-#ifdef AF_WAN
- newXSconstUV("Net::Gen::AF_WAN", AF_WAN, file);
-#else
- newmissing(missing, "Net::Gen::AF_WAN", file);
-#endif
-#ifdef PF_WAN
- newXSconstUV("Net::Gen::PF_WAN", PF_WAN, file);
-#else
- newmissing(missing, "Net::Gen::PF_WAN", file);
-#endif
-#ifdef AF_USER
- newXSconstUV("Net::Gen::AF_USER", AF_USER, file);
-#else
- newmissing(missing, "Net::Gen::AF_USER", file);
-#endif
-#ifdef PF_USER
- newXSconstUV("Net::Gen::PF_USER", PF_USER, file);
-#else
- newmissing(missing, "Net::Gen::PF_USER", file);
-#endif
-#ifdef AF_LAST
- newXSconstUV("Net::Gen::AF_LAST", AF_LAST, file);
-#else
- newmissing(missing, "Net::Gen::AF_LAST", file);
-#endif
-#ifdef PF_LAST
- newXSconstUV("Net::Gen::PF_LAST", PF_LAST, file);
-#else
- newmissing(missing, "Net::Gen::PF_LAST", file);
-#endif
newXSconstUV("Net::Gen::ENOENT", ENOENT, file);
newXSconstUV("Net::Gen::EINVAL", EINVAL, file);
newXSconstUV("Net::Gen::EBADF", EBADF, file);
@@ -1267,10 +764,7 @@ BOOT:
MODULE = Net::Gen PACKAGE = Net::Gen
-BOOT:
- }
-
-void
+SV *
pack_sockaddr(family,address)
U8 family
SV * address
@@ -1278,7 +772,7 @@ pack_sockaddr(family,address)
struct sockaddr sad;
char * adata;
STRLEN adlen;
- PPCODE:
+ CODE:
Zero(&sad, sizeof sad, char);
sad.sa_family = family;
adata = SvPV(address, adlen);
@@ -1292,7 +786,6 @@ pack_sockaddr(family,address)
Copy(adata, &sad.sa_data, adlen, char);
ST(0) = sv_2mortal(newSVpv((char*)&sad, sizeof sad));
}
- XSRETURN(1);
void
unpack_sockaddr(sad)
@@ -1311,21 +804,10 @@ unpack_sockaddr(sad)
Zero(&sa, sizeof sa - sizeof sa.sa_data, char);
Copy(cp, &sa, len < sizeof sa ? len : sizeof sa, char);
family = sa.sa_family;
- if (family > 255) { /* 4.4bsd anyone? */
- U8 famlen1, famlen2;
- famlen1 = family & 255;
- famlen2 = family >> 8;
- if (famlen1 == famlen2)
- family = famlen1;
- else if (famlen1 == len)
- family = famlen2;
- else if (famlen2 == len)
- family = famlen1;
- }
famsv = sv_2mortal(newSViv(family));
if (len >= sizeof sa - sizeof sa.sa_data) {
len -= sizeof sa - sizeof sa.sa_data;
- datsv = sv_2mortal(newSVpv(cp + (sizeof sa - sizeof sa.sa_data),
+ datsv = sv_2mortal(newSVpv(cp + sizeof sa - sizeof sa.sa_data,
len));
}
else {
@@ -5,24 +5,13 @@ MANIFEST.SKIP
Makefile.PL
README
hints/linux.pl
-lib/Net/Gen.dat
lib/Net/Gen.pm
-lib/Net/Inet.dat
lib/Net/Inet.pm
-lib/Net/TCP.dat
lib/Net/TCP.pm
-lib/Net/UDP.dat
lib/Net/UDP.pm
-lib/Net/UNIX.dat
lib/Net/UNIX.pm
-lib/Net/TCP/Server.dat
lib/Net/TCP/Server.pm
-lib/Net/UNIX/Server.dat
lib/Net/UNIX/Server.pm
-lib/attrs.dat
-manifake
t/00basic.t
t/01unix.t
typemap
-xlib/Test.pm
-xlib/Test/Harness.pm
@@ -1,4 +1,4 @@
-(^|/)(RCS|CVS|SCCS|OLD|DL|DOC)$
+(^|/)(RCS|CVS|SCCS|OLD|DL)$
(^|/)Net-ext-
^IANA
\,v$
@@ -1,21 +1,5 @@
#!perl
-
-# 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: Makefile.PL,v 1.23 2002/03/30 11:32:09 spider Exp $"
-
-use 5.004_04;
+use 5.004_05;
use ExtUtils::MakeMaker qw(WriteMakefile $Verbose);
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
@@ -31,7 +15,6 @@ END { unlink $tempfile }
# This is wrapped in a sub so that it's here where you expected it to be
# for easy customisation, but it won't take effect until the sub is called
# after other initialisation is done.
-my @delfiles = ($tempfile, $hfile);
sub runMM {
WriteMakefile(
'NAME' => 'Net::Gen',
@@ -41,7 +24,7 @@ WriteMakefile(
('ABSTRACT' =>
'Provide OO socket manipulations, including friendly [get/set]sockopt',
'AUTHOR' =>
- 'Spider Boardman <spidb@cpan.org>'
+ 'Spider Boardman <spider@Orb.Nashua.NH.US>'
)
: ()
,
@@ -50,13 +33,14 @@ WriteMakefile(
# DEFINE is modified by hint-files.
'INC' => '', # e.g., '-I/usr/include/other'
'dist' => {
- CI => 'ci -u -M',
COMPRESS => 'gzip -9fNv',
SUFFIX => '.gz',
TARFLAGS => 'cvof',
+ PREOP => '$(CHMOD) ugo-w `cat MANIFEST`',
+ POSTOP => '$(CHMOD) u+w `cat MANIFEST`',
},
'clean' => {
- FILES => qq[@delfiles],
+ FILES => qq[$tempfile $hfile],
},
'H' => [$hfile],
'CONFIG' => [qw(usrinc locincpth)],
@@ -70,7 +54,6 @@ sub MY::post_initialize
{
my $self = shift;
$self->{NOOP} = ':' if $^O eq 'dec_osf';
- $self->{FULLPERL} .= ' -Ixlib' if $] < 5.004_05;
$self->MM::post_initialize(@_);
}
@@ -88,72 +71,18 @@ sub MY::makefile
# I got tired of having my backup files 'installed' by the default
# Makefile....
-# Also, we need a dummy version of attrs.pm for older perls.
-
-my $have_attributes = eval 'sub dummy : locked { 1;} 1;';
-my $have_attrs = $have_attributes || eval 'sub dummy { use attrs "locked"; 1} 1;';
-
sub MY::libscan
{
my $self = shift;
return ''
if $_[0] =~ /\~$/ or
$_[0] =~ /\.ORIG$/i or
- $_[0] =~ /\.dat$/ or
- $_[0] =~ m,(?:^|/)Net-ext-, or
- $_[0] =~ m,(?:^|/)(?:OLD|DL)$, or
- $_[0] =~ m,(?:^|/)attrs\.pm$, and $have_attrs
- ;
+ $_[0] =~ m,(?:^|/)Net-ext-, or
+ $_[0] =~ m,(?:^|/)(?:OLD|DL)$,
+ ;
$self->MM::libscan(@_);
}
-# Here we create .pm files from the .dat files, based on whether we
-# have C<sub : attrs> or are stuck with C<use attrs qw(attrs)>.
-
-sub gen_pm_files ()
-{
- open MANI, "<MANIFEST" or die "Cannot read MANIFEST file: $!";
- my @datfiles = grep { m/dat$/ } <MANI>;
- close MANI;
- chomp @datfiles;
- my $file;
- for $file (@datfiles) {
- my $outfile = $file;
- $outfile =~ s/dat$/pm/;
- unlink $outfile;
- next if $file eq 'lib/attrs.dat' and $have_attrs;
- open $file, "<$file" or die "Cannot read $file file: $!";
- open $outfile, ">$outfile" or die "Cannot write $outfile file: $!";
- #workaround for PAUSE indexer problem.
- #push @delfiles, $outfile;
- my $line;
- my $attrlist;
- while (defined($line = <$file>)) {
- if ($attrlist) {
- if ($have_attributes) {
- if ($line =~ m/^sub /) {
- $line =~ s/$/ : $attrlist/;
- undef $attrlist;
- }
- }
- else {
- if ($line =~ m/^[\{]/) { #'}' for vi's sake
- $line .= " use attrs qw($attrlist);\n";
- undef $attrlist;
- }
- }
- }
- unless ($line =~ m/^[\#][+]attrs (.*)$/) {
- print $outfile $line;
- next;
- }
- $attrlist = "$1"; # stringify to copy now, not later
- }
- close $outfile or die "Error writing $outfile file: $!";
- close $file or die "Error reading $file file: $!";
- print "Created $outfile from $file\n";
- }
-}
# Here are some possible include files which we'll need if the system
# has them. Add to this (and let me know!) if you find one that your
@@ -338,7 +267,6 @@ my %defdefines = (
TCP_MAX_WINSHIFT => '14',
TCP_MSS => '536',
- TCP_MSS_IETF => '536',
TH_FIN => '0x01',
TH_SYN => '0x02',
@@ -511,17 +439,5 @@ sub MY::post_constants
$self->MM::post_constants(@_); # in case it's not empty now
}
-# Override 'make ci' rule to account for the bogus .pm files.
-sub MY::dist_ci
-{
-'ci :
- $(CI) `cat manifake`
- $(RCS_LABEL) `cat manifake`
-'
-}
-
-# Generate the .pm files before we let MM scan the lib directory.
-gen_pm_files;
-
# Now that we're sure we've initialised all our tables, let MM do its thing.
runMM;
@@ -21,11 +21,6 @@ What's different from other offerings:
long as gethostbyname() returns more than one address. (See RFC
1123.)
- Has had testing on threaded perls, and works as well with threads
- as perl itself (which isn't saying much, yet, given the experimental
- status of threads in Perl, but that's the limit of resolution for
- the testing).
-
What's still missing:
Support for non-blocking sockets is under-tested at best. The
@@ -60,9 +55,7 @@ the methods.
I'm not a technical writer, nor do I usually play one on the net.
The documentation could still use a lot of work, I'm sure.
-Making it all work requires perl 5.004_04 or later. (There are features
-which are new to 5.004_05 and even 5.005 which are used, but there
-are backward compatibility hooks to keep it working with 5.004_04.)
+Making it all work requires perl 5.004_05(maint trial 8) or later.
A simple test script:
@@ -90,7 +83,7 @@ Should be the same (on most BSD-ish systems, anyway) as
to the shell.
-Anyway, bug reports & feature requests to me (spidb@cpan.org).
+Anyway, bug reports & feature requests to me (spider@Orb.Nashua.NH.US).
HOWEVER, if you have compilation difficulties, check the Makefile.PL
file again, especially near "my @hfiles". The list of required system
include files is almost entirely tester-contributed. If it doesn't
@@ -108,7 +101,7 @@ of perl5 than this code ever could have). If you were using the internals
of the implementation rather than sticking to the documented interfaces,
you will have some work to do before your derived classes will work again.
-# Copyright 1995,2002 Spider Boardman.
+# Copyright 1995,1999 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -1,3416 +0,0 @@
-# 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: Gen.dat,v 1.44 2002/04/10 11:27:18 spider Exp $"
-
-
-package Net::Gen;
-use 5.004_04; # new minimum Perl version for this package
-
-use strict;
-#use Carp; # no! just require Carp when we want to croak.
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
- %_missing $AUTOLOAD $adebug);
-
-BEGIN {
- $VERSION = '1.011';
- eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
-}
-
-#use Socket qw(!/pack_sockaddr/ !/^MSG_OOB$/ !SOMAXCONN);
-use Socket ();
-use AutoLoader;
-use Exporter ();
-use DynaLoader ();
-use Symbol qw(gensym);
-use SelectSaver ();
-use IO::Handle ();
-
-# Special wart for new_from_f{d,h}, since only the _fh flavour's already
-# known to AutoLoader.
-sub new_from_fd; *new_from_fd = \&new_from_fh;
-
-BEGIN {
- @ISA = qw(IO::Handle Exporter DynaLoader);
-
- @EXPORT = ();
-
- @EXPORT_OK = qw(pack_sockaddr
- unpack_sockaddr
- VAL_O_NONBLOCK
- VAL_EAGAIN
- RD_NODATA
- EOF_NONBLOCK
- EINPROGRESS EALREADY ENOTSOCK EDESTADDRREQ
- EMSGSIZE EPROTOTYPE ENOPROTOOPT EPROTONOSUPPORT
- ESOCKTNOSUPPORT EOPNOTSUPP EPFNOSUPPORT EAFNOSUPPORT
- EADDRINUSE EADDRNOTAVAIL ENETDOWN ENETUNREACH ENETRESET
- ECONNABORTED ECONNRESET ENOBUFS EISCONN ENOTCONN
- ESHUTDOWN ETOOMANYREFS ETIMEDOUT
- ECONNREFUSED EHOSTDOWN EHOSTUNREACH
- ENOSR ETIME EBADMSG EPROTO ENODATA ENOSTR
- EAGAIN EWOULDBLOCK
- ENOENT EINVAL EBADF
- SHUT_RD SHUT_WR SHUT_RDWR
- SOL_SOCKET
- SOMAXCONN
- SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTROUTE
- SO_ERROR SO_EXPANDED_RIGHTS SO_FAMILY SO_KEEPALIVE
- SO_LINGER SO_OOBINLINE SO_PAIRABLE SO_RCVBUF
- SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
- SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_STATE SO_TYPE
- SO_USELOOPBACK SO_XSE
- SOCK_STREAM SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET
- AF_UNSPEC AF_UNIX AF_INET AF_IMPLINK AF_PUP AF_CHAOS
- AF_NS AF_ISO AF_OSI AF_ECMA AF_DATAKIT AF_CCITT AF_SNA
- AF_DECnet AF_DLI AF_LAT AF_HYLINK AF_APPLETALK AF_ROUTE
- AF_LINK AF_NETMAN AF_X25 AF_CTF AF_WAN AF_USER AF_LAST
- PF_UNSPEC PF_UNIX PF_INET PF_IMPLINK PF_PUP PF_CHAOS
- PF_NS PF_ISO PF_OSI PF_ECMA PF_DATAKIT PF_CCITT PF_SNA
- PF_DECnet PF_DLI PF_LAT PF_HYLINK PF_APPLETALK PF_ROUTE
- PF_LINK PF_NETMAN PF_X25 PF_CTF PF_WAN PF_USER PF_LAST
- AF_LOCAL PF_LOCAL
- );
-
- %EXPORT_TAGS = (
- NonBlockVals => [qw(EOF_NONBLOCK RD_NODATA VAL_EAGAIN VAL_O_NONBLOCK)],
- routines => [qw(pack_sockaddr unpack_sockaddr)],
- errnos => [qw(EINPROGRESS EALREADY ENOTSOCK EDESTADDRREQ
- EMSGSIZE EPROTOTYPE ENOPROTOOPT EPROTONOSUPPORT
- ESOCKTNOSUPPORT EOPNOTSUPP EPFNOSUPPORT EAFNOSUPPORT
- EADDRINUSE EADDRNOTAVAIL ENETDOWN ENETUNREACH ENETRESET
- ECONNABORTED ECONNRESET ENOBUFS EISCONN ENOTCONN
- ESHUTDOWN ETOOMANYREFS ETIMEDOUT
- ECONNREFUSED EHOSTDOWN EHOSTUNREACH
- ENOSR ETIME EBADMSG EPROTO ENODATA ENOSTR
- EAGAIN EWOULDBLOCK
- ENOENT EINVAL EBADF
- )],
- shutflags => [qw(SHUT_RD SHUT_WR SHUT_RDWR)],
- sockopts => [qw(SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTROUTE
- SO_ERROR SO_EXPANDED_RIGHTS SO_FAMILY SO_KEEPALIVE
- SO_LINGER SO_OOBINLINE SO_PAIRABLE SO_RCVBUF
- SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
- SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_STATE SO_TYPE
- SO_USELOOPBACK SO_XSE
- )],
- sockvals => [qw(SOL_SOCKET
- SOCK_STREAM SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET
- )],
- af => [qw(AF_UNSPEC AF_UNIX AF_INET AF_IMPLINK AF_PUP AF_CHAOS
- AF_NS AF_ISO AF_OSI AF_ECMA AF_DATAKIT AF_CCITT AF_SNA
- AF_DECnet AF_DLI AF_LAT AF_HYLINK AF_APPLETALK AF_ROUTE
- AF_LINK AF_NETMAN AF_X25 AF_CTF AF_WAN AF_USER AF_LAST
- AF_LOCAL
- )],
- pf => [qw(PF_UNSPEC PF_UNIX PF_INET PF_IMPLINK PF_PUP PF_CHAOS
- PF_NS PF_ISO PF_OSI PF_ECMA PF_DATAKIT PF_CCITT PF_SNA
- PF_DECnet PF_DLI PF_LAT PF_HYLINK PF_APPLETALK PF_ROUTE
- PF_LINK PF_NETMAN PF_X25 PF_CTF PF_WAN PF_USER PF_LAST
- PF_LOCAL
- )],
- ALL => [@EXPORT, @EXPORT_OK],
- );
- $EXPORT_TAGS{'non_block_vals'} = $EXPORT_TAGS{'NonBlockVals'};
- $EXPORT_TAGS{'families'} = [@{$EXPORT_TAGS{'af'}}, @{$EXPORT_TAGS{'pf'}}];
-}
-
-my %loaded;
-
-
-# dummies for the Carp:: routines, which we'll re-invoke if we get called.
-
-sub croak
-{
- require Carp;
- goto &Carp::croak;
-}
-
-sub carp
-{
- require Carp;
- goto &Carp::carp;
-}
-
-
-my $nullsub = sub {}; # handy null warning handler
-# If the warning handler is this exact code ref, don't bother calling
-# croak in the AUTOLOAD constant section, since we're being called from
-# inside the eval in initsockopts().
-
-#+attrs locked
-sub AUTOLOAD
-{
- # This AUTOLOAD is used to validate possible missing constants from
- # the XS code, or to auto-create get/setattr subs.
- # The defined constants are already available as XSUBs, and the same
- # XS code which handles that also sets up the %_missing hash to note
- # which names were known but are undefined.
- # If the name is in %_missing, we'll croak as a normal AUTOLOAD with
- # a constant() XS function (except for when $nullsub is the die handler).
- # If the name isn't known to %_missing, but it is known
- # as a key for setparams/getparams, it will be simulated via _accessor().
- # Otherwise, control will be passed to the AUTOLOAD in AutoLoader.
-
-# use attrs 'locked'; # modifies the symbol table and abuses a global
-
- my ($constname,$callpkg);
- { # block to preserve $1,$2,et al.
- ($callpkg,$constname) = $AUTOLOAD =~ /^(.*)::(.*)$/;
- }
- if (exists $_missing{$AUTOLOAD}) {
- my $wh = $SIG{__WARN__};
- die "\n"
- if ($wh and (ref($wh) eq 'CODE') and $wh == $nullsub);
- croak "Your vendor has not defined $callpkg macro $constname, used";
- }
- if (@_ && ref $_[0] && @_ < 3 && exists $ {*{$_[0]}}{Keys}{$constname}) {
- no strict 'refs'; # allow us to define the sub
- my $what = $constname; # don't tie up $constname for closures
- warn "Auto-generating accessor $AUTOLOAD\n" if $adebug;
- *$AUTOLOAD = sub {
- splice @_, 1, 0, $what;
- goto &_accessor;
- };
- goto &$AUTOLOAD;
- }
- warn "Autoloading $AUTOLOAD\n" if $adebug;
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
-}
-
-BEGIN {
-# do this now so the constant XSUBs really are
- __PACKAGE__->DynaLoader::bootstrap($VERSION);
-}
-
-
-# Preloaded methods go here. Autoload methods go after __END__, and are
-# processed by the autosplit program.
-
-
-# This package has the core 'generic' routines for fiddling with
-# sockets.
-
-
-# initsockopts - Set up the socket options of a class using this module.
-# The structure of a sockopt hash is like this:
-# %sockopts = ( OPTION => ['pack_string', $option_number, $option_level,
-# $number_of_elements], ... );
-# The option level and number are for calling [gs]etsockopt, and
-# the number of elements is for some (weak) consistency checking.
-# The pack/unpack template is used by $obj->getsopt and setsopt.
-# Only the pack template is set on input to this routine. On exit,
-# it will have deleted any entries which cannot be resolved, and will
-# have filled in the ones which can. It will also have duplicated
-# the entries to be indexed by option value as well as by option name.
-
-my %evalopts; # avoid compiling an eval per sockopt
-
-#& initsockopts($class, $level+0, \%sockopts) : void
-#+attrs locked
-sub initsockopts
-{
- my ($class,$level,$opts) = @_;
- croak "Invalid arguments to " . __PACKAGE__ . "::initsockopts, called"
- if @_ != 3 or ref $opts ne 'HASH';
- $level += 0; # force numeric
- my($opt,$oval,@oval,$esub);
- my $nullwarn = $nullsub; # a handy __WARN__ handler
- # The above has to be there, since the file-scope 'my' won't be seen
- # in the generated closure.
- $class = ref $class if ref $class;
- $evalopts{$class} ||= eval "package $class; no strict 'refs';" .
- 'sub ($) {local($SIG{__WARN__})=$nullwarn;local($SIG{__DIE__});' .
- '&{$_[0]}()}';
- $esub = $evalopts{$class};
- foreach $opt (keys %$opts) {
- delete $$opts{$opt}, next if exists $_missing{"${class}::$opt"};
- $oval = eval {&$esub($opt)};
- delete $$opts{$opt}, next if $@ or !defined($oval) or $oval eq '';
- $oval += 0; # force numeric
- push(@{$$opts{$opt}}, $oval, $level);
- $$opts{$oval} = $$opts{$opt};
- $oval = $$opts{$opt}[0];
- @oval = unpack($oval, pack($oval, 0));
- $$opts{$opt}[3] = scalar @oval;
- }
-}
-
-
-my %sockopts;
-
-# The known socket options (from Socket.pm)
-
-%sockopts = (
- # First, the simple flag options
-
- 'SO_ACCEPTCONN' => [ 'I' ],
- 'SO_BROADCAST' => [ 'I' ],
- 'SO_DEBUG' => [ 'I' ],
- 'SO_DONTROUTE' => [ 'I' ],
- 'SO_ERROR' => [ 'I' ],
- 'SO_EXPANDED_RIGHTS' => [ 'I' ],
- 'SO_KEEPALIVE' => [ 'I' ],
- 'SO_OOBINLINE' => [ 'I' ],
- 'SO_PAIRABLE' => [ 'I' ],
- 'SO_REUSEADDR' => [ 'I' ],
- 'SO_REUSEPORT' => [ 'I' ],
- 'SO_USELOOPBACK' => [ 'I' ],
- 'SO_XSE' => [ 'I' ],
-
- # Simple integer options
-
- 'SO_RCVBUF' => [ 'I' ],
- 'SO_SNDBUF' => [ 'I' ],
- 'SO_RCVTIMEO' => [ 'I' ],
- 'SO_SNDTIMEO' => [ 'I' ],
- 'SO_RCVLOWAT' => [ 'I' ],
- 'SO_SNDLOWAT' => [ 'I' ],
- 'SO_TYPE' => [ 'I' ],
- 'SO_STATE' => [ 'I' ],
- 'SO_FAMILY' => [ 'I' ],
-
- # Finally, one which is a struct
-
- 'SO_LINGER' => [ 'II' ],
-
- # Out of known socket options
- );
-
-__PACKAGE__->initsockopts( SOL_SOCKET(), \%sockopts );
-
-
-#& _genfh() : returns orphan globref with HV slot.
-sub _genfh ()
-{
- my $rval = gensym;
- *{$rval} = {}; # initialise a hash slot
- $rval;
-}
-
-my $debug = 0; # module-wide debug hack -- don't use
-
-# On the other hand, per-object debugging isn't so bad....
-
-# can update $debug file variable
-#& _debug($this [, $newval]) : oldval
-#+attrs locked
-sub _debug
-{
- my ($this,$newval) = @_;
- return $this->debug($newval) if ref $this;
- # class method here
- my $oldval = $debug;
- $debug = 0+$newval if defined $newval;
- $oldval;
-}
-
-#& debug($self [, $newval]) : oldval
-#+attrs locked method
-sub debug
-{
- my ($self,$newval) = @_;
- my $oldval = $ {*$self}{Parms}{'debug'} if defined wantarray;
- $self->setparams({'debug'=>$newval}) if defined $newval;
- $oldval;
-}
-
-#& _trace($this, \@args, minlevel, [$moretext]) : void
-sub _trace
-{
- my ($this,$aref,$level,$msg) = @_;
- my $rtn = (caller(1))[3];
-# local $^W=0; # keep the arglist interpolation from carping
- $msg = '' unless defined $msg;
- print STDERR "${rtn}(@{$aref||[]})${msg}\n"
- if $level and $this->_debug >= $level;
- ${rtn};
-}
-
-#& _setdebug($self, $name, $newval) : {'' | "carp string"}
-sub _setdebug
-{
- my ($self,$what,$val) = @_;
- return '' unless defined $val;
- return "$self->{$what} parameter ($val) must be non-negative integer"
- if $val eq '' or $val =~ /\D/;
- $_[2] += 0; # force numeric
- ''; # return goodness
-}
-
-# try to work even in places where Fcntl.xs doesn't.
-
-my ($F_GETFL,$F_SETFL) =
- eval 'use Fcntl qw(F_GETFL F_SETFL);(F_GETFL,F_SETFL)';
-my $nonblock_flag = eval 'pack("I",VAL_O_NONBLOCK)';
-my $eagain = eval 'VAL_EAGAIN';
-
-#& _accessor($self, $what [, $newval]) : oldvalue
-#+attrs locked method
-sub _accessor
-{
- my ($self, $what, $newval) = @_;
- croak "Usage: \$sock->$what or \$sock->$what(\$newvalue),"
- if @_ > 3;
- my $oldval = $self->getparam($what) if defined wantarray;
- $self->setparams({$what=>$newval}) if @_ > 2;
- $oldval;
-}
-
-#& _setblocking($self, $name, $newval) : {'' | "carp string"}
-sub _setblocking
-{
- my ($self,$what,$newval) = @_;
- $newval = 1 unless defined $newval;
- # default previous value, just in case
- $ {*$self}{Parms}{$what} = 1 unless
- defined $ {*$self}{Parms}{$what};
- if ($newval) {
- $_[2] = 1; # canonicalise the new value
- if (defined $F_GETFL and defined $F_SETFL and
- defined $nonblock_flag and $self->isopen)
- {
- if ((CORE::fcntl($self, $F_GETFL, 0) & VAL_O_NONBLOCK) ==
- VAL_O_NONBLOCK)
- {
- $ {*$self}{Parms}{$what} = 0; # note previous status
- return 'Failed to clear non-blocking status'
- unless eval {CORE::fcntl($self, $F_SETFL,
- CORE::fcntl($self, $F_GETFL, 0) &
- ~VAL_O_NONBLOCK)};
- }
- }
- }
- else {
- $_[2] = 0; # canonicalise the new value
- unless (defined $F_GETFL and defined $F_SETFL and
- defined $nonblock_flag)
- {
- return 'Non-blocking sockets unavailable in this configuration';
- }
- if ($self->isopen) {
- if ((CORE::fcntl($self, $F_GETFL, 0) & VAL_O_NONBLOCK) !=
- VAL_O_NONBLOCK)
- {
- $ {*$self}{Parms}{$what} = 1; # note previous state
- return 'Failed to set non-blocking status'
- unless eval {CORE::fcntl($self, $F_SETFL,
- CORE::fcntl($self, $F_GETFL, 0) |
- VAL_O_NONBLOCK)};
- }
- }
- }
- ''; # return goodness if got this far
-}
-
-#& blocking($self [, $newval]) : canonical_oldval
-#+attrs locked method
-sub blocking
-{
- my ($self, $newval) = @_;
- croak 'Usage: $sock->blocking or $sock->blocking(0|1),'
- if @_ > 2;
- my $oldval = $self->getparam('blocking', 1, 1) if defined wantarray;
- $self->setparams({'blocking'=>$newval}) if @_ > 1;
- $oldval;
-}
-
-#& _settimeout($self, $what, $newval) : {'' | "carp string"}
-sub _settimeout
-{
- my ($self,$what,$newval) = @_;
- unless (defined $newval) {
- return ''; # It's always OK to delete a timeout.
- }
- if (!length($newval) or $newval =~ /\D/) {
- "Parameter $what must be a non-negative integer or undefined";
- }
- else {
- '';
- }
-}
-
-my @Keys = qw(PF AF type proto dstaddr dstaddrlist srcaddr srcaddrlist
- maxqueue reuseaddr netgen_fakeconnect reuseport);
-my %Codekeys = (
- 'debug' => \&_setdebug,
- 'blocking' => \&_setblocking,
- 'timeout' => \&_settimeout,
- );
-# This hash remembers the original {Keys} settings after the first time.
-my %Keys;
-
-# This hash remembers the original socket option settings after the first time.
-my %Opts;
-
-#& register_param_keys($self, \@keys)
-#+attrs locked method
-sub register_param_keys
-{
- my ($self, $names) = @_;
- my $whoami = $self->_trace(\@_,3);
- croak "Invalid arguments to ${whoami}(@_), called"
- if @_ != 2 or ref $names ne 'ARRAY';
- @{$ {*$self}{Keys}}{@$names} =
- @{$ {*$self}{Keys}}{@$names}; # remember the names
- # this form doesn't clobber pre-existing register_param_handlers values
-}
-
-sub registerParamKeys; # helps with -w
-*registerParamKeys = \®ister_param_keys; # alias form preferred by many
-
-#& register_param_handlers($self, \@keys, [\]@handlers)
-#& -or- ($self, \%key-handlers)
-#+attrs locked method
-sub register_param_handlers
-{
- my ($self, $names, @handlers, $handlers) = @_;
- my $whoami = $self->_trace(\@_,3);
- if (ref $names eq 'HASH') {
- croak "Invalid parameters to ${whoami}(@_), called"
- if @_ != 2;
- $handlers = [values %$names];
- $names = [keys %$names];
- }
- else {
- croak "Invalid parameters to ${whoami}(@_), called"
- if @_ < 3 or ref $names ne 'ARRAY';
- $handlers = \@handlers; # in case passed as a list
- $handlers = $_[2] if @_ == 3 and ref($_[2]) eq 'ARRAY';
- }
- croak "Invalid handlers in ${whoami}(@_), called"
- if @$handlers != @$names or grep(ref $_ ne 'CODE', @$handlers);
- # finally, all is validated, so set the bloody things
- @{$ {*$self}{Keys}}{@$names} = @$handlers;
-}
-
-sub registerParamHandlers; # helps with -w
-*registerParamHandlers = \®ister_param_handlers; # alias other form
-
-#& register_options($self, $levelname, $level, \%options)
-#+attrs locked method
-sub register_options
-{
- my ($self, $levname, $level, $opts) = @_;
- my $whoami = $self->_trace(\@_,3);
- croak "Invalid arguments to ${whoami}(@_), called"
- if ref $opts ne 'HASH';
- $ {*$self}{Sockopts}{$levname} = $opts;
- $ {*$self}{Sockopts}{$level+0} = $opts;
-}
-
-sub registerOptions; # helps with -w
-*registerOptions = \®ister_options; # alias form preferred by many
-
-# pseudo-subclass for saving parameters (ParamSaver, inspired by SelectSaver)
-#& param_saver($self, @params) : restoration_object
-#+attrs locked method
-sub param_saver
-{
- my ($self, @params) = @_;
- my @delparams =
- # map { exists $ {*$self}{Parms}{$_} ? () : ($_) } @params;
- grep {!exists $ {*$self}{Parms}{$_}} @params;
- my %setparams = $self->getparams(\@params);
- bless [$self, \%setparams, \@delparams], 'Net::Gen::ParamSaver';
-}
-
-sub paramSaver; # aliases
-*paramSaver = \¶m_saver;
-sub ParamSaver;
-*ParamSaver = \¶m_saver;
-
-sub Net::Gen::ParamSaver::DESTROY
-{
- local $!; # just to be sure we don't clobber it
- $_[0]->[0]->setparams($_[0]->[1]);
- $_[0]->[0]->delparams($_[0]->[2]);
-}
-
-#& new(classname [, \%params]) : {$self | undef}
-#& -or- $classname [, @ignored]
-sub new
-{
- my $whoami = $_[0]->_trace(\@_,1);
- my($pack,$parms) = @_;
- my %parms;
- %parms = ( %$parms ) if $parms and ref $parms eq 'HASH';
- $parms{'debug'} = $pack->_debug unless defined $parms{'debug'};
- $parms{'blocking'} = 1 unless defined $parms{'blocking'};
- if (@_ > 2 and $parms and ref $parms eq 'HASH') {
- croak "Invalid argument format to ${whoami}(@_), called";
- }
- my $class = ref $pack || $pack;
- my $self = _genfh;
- bless $self,$class;
- $pack->_trace(\@_,2,", self=$self after bless");
- $ {*$self}{Parms} = \%parms;
- if (%Keys) {
- $ {*$self}{Keys} = { %Keys };
- $ {*$self}{Sockopts} = { %Opts };
- }
- else {
- $self->register_param_keys(\@Keys); # register our keys
- $self->register_param_handlers(\%Codekeys);
- $self->register_options('SOL_SOCKET', SOL_SOCKET(), \%sockopts);
- %Keys = %{$ {*$self}{Keys}};
- %Opts = %{$ {*$self}{Sockopts}};
- }
- if ($class eq __PACKAGE__) {
- unless ($self->init) {
- local $!; # preserve errno
- undef $self; # against the side-effects of this
- undef $self; # another statement needed for unwinding
- }
- }
- if (($self || $pack)->_debug) {
- if (defined $self) {
- print STDERR "${whoami} returning self=$self\n";
- }
- else {
- print STDERR "${whoami} returning undef\n";
- }
- }
- $self;
-}
-
-#& setparams($this, \%newparams [, $newonly [, $check]]) : boolean
-#+attrs locked method
-sub setparams
-{
- my ($self,$newparams,$newonly,$check) = @_;
- my $errs = 0;
-
- croak "Bad arguments to " . __PACKAGE__ . "::setparams, called"
- unless @_ > 1 and ref $newparams eq 'HASH';
- carp "Excess arguments to " . __PACKAGE__ . "::setparams ignored"
- if @_ > 4;
-
- $newonly ||= 0; # undefined or zero is equiv now (-w problem)
- my ($parm,$newval,$pslot);
- while (($parm,$newval) = each %$newparams) {
- print STDERR __PACKAGE__ . "::setparams $self $parm" .
- (defined $newval ? " $newval" : "") . "\n"
- if $self->debug;
- (carp "Unknown parameter type $parm for a " . (ref $self) . " object")
- , $errs++, next
- unless exists $ {*$self}{Keys}{$parm};
- $pslot = \$ {*$self}{Parms}{$parm};
- next if $newonly < 0 && defined $$pslot;
- if (!$check)
- {
- # this ungodly construct brought to you by -w
- next if
- defined($$pslot) eq defined($newval)
- and
- !defined($newval) ||
- $$pslot eq $newval ||
- $$pslot !~ /\D/ &&
- $newval !~ /\D/ &&
- length($newval) &&
- length($$pslot) &&
- $$pslot == $newval
- ;
- }
- carp("Overwrite of $parm parameter for ".(ref $self)." object ignored")
- , $errs++, next
- if $newonly > 0 && defined $$pslot;
- if (defined($ {*$self}{Keys}{$parm}) and
- (ref($ {*$self}{Keys}{$parm}) eq 'CODE'))
- {
- my $rval = &{$ {*$self}{Keys}{$parm}}($self,$parm,$newval);
- (carp $rval), $errs++, next if $rval;
- }
- # not using $$pslot here in case {Parms} hash re-generated
- $ {*$self}{Parms}{$parm} = $newval;
- }
-
- $errs ? undef : 1;
-}
-
-
-#& delparams($self, \@paramnames) : boolean
-#+attrs locked method
-sub delparams
-{
- $_[0]->_trace(\@_,1);
- my($self,$keysref) = @_;
- my(@k,%k);
- @k = grep(exists $ {*$self}{Parms}{$_}, @$keysref);
- return 1 unless @k; # if no keys need deleting, succeed vacuously
- @k{@k} = (); # a hash of undefs for the following
- return undef unless $self->setparams(\%k); # see whether undef is allowed
- delete @{$ {*$self}{Parms}}{@k};
- 1; # return goodness
-}
-
-#& checkparams($self) : boolean
-#+attrs locked method
-sub checkparams
-{
- my $whoami = $_[0]->_trace(\@_,1);
- my $self = shift;
- carp "Excess arguments to ${whoami} ignored"
- if @_;
- my $curparms = $ {*$self}{Parms};
- $curparms = {} unless ref $curparms eq 'HASH';
- # make sure only the valid ones are set when we're done
- $ {*$self}{Parms} = {};
- my(@valkeys) = grep(exists $ {*$self}{Keys}{$_}, keys %$curparms);
- # this assignment allows for inter-key dependencies to be evaluated
- @{$ {*$self}{Parms}}{@valkeys} =
- @{$curparms}{@valkeys};
- # validate all current against the defined keys
- $self->setparams($curparms, 0, 1);
-}
-
-#& init($self) : {$self | undef}
-sub init
-{
- $_[0]->_trace(\@_,1);
- my($self) = @_;
- $self->checkparams ? $self : undef;
-}
-
-#& getparam($self, $key [, $default [, $defaultifundef]]) : param_value
-#+attrs locked method
-sub getparam
-{
- my $whoami = $_[0]->_trace(\@_,2);
- my($self,$key,$defval,$noundef) = @_;
- carp "Excess arguments to ${whoami}($self) ignored"
- if @_ > 4;
- if ($noundef) {
- return $defval unless defined($ {*$self}{Parms}{$key});
- }
- else {
- return $defval unless exists($ {*$self}{Parms}{$key});
- }
- $ {*$self}{Parms}{$key};
-}
-
-#& getparams($self, \@keys [, $noundef]) : (%hash)
-#+attrs locked method
-sub getparams
-{
- my $whoami = $_[0]->_trace(\@_,2);
- my ($self,$aref,$noundef) = @_;
- croak "Insufficient arguments to ${whoami}($self), called"
- if @_ < 2 || !ref $self || ref $aref ne 'ARRAY';
- carp "Excess arguments to ${whoami}($self) ignored"
- if @_ > 3;
- return unless defined wantarray;
- if (wantarray) {
- # the actual list is wanted -- see which way to do it
- if ($noundef) {
- map {defined $ {*$self}{Parms}{$_} ?
- ($_, $ {*$self}{Parms}{$_}) :
- ()
- } @$aref;
- }
- else {
- map {exists $ {*$self}{Parms}{$_} ?
- ($_, $ {*$self}{Parms}{$_}) :
- ()
- } @$aref;
- }
- }
- else {
- # the list count is wanted -- see which way to do it
- if ($noundef) {
- 2 * grep {defined $ {*$self}{Parms}{$_}} @$aref;
- }
- else {
- 2 * grep {exists $ {*$self}{Parms}{$_}} @$aref;
- }
- }
-# my @ret;
-# foreach (@$aref) {
-# push(@ret, $_, $ {*$self}{Parms}{$_})
-# if exists($ {*$self}{Parms}{$_}) and
-# !$noundef || defined($ {*$self}{Parms}{$_});
-# }
-# wantarray ? @ret : 0+@ret;
-}
-
-
-#& condition($self)
-#+attrs locked method
-sub condition
-{
- my $self = $_[0];
- my $sel = SelectSaver->new;
- CORE::select($self);
- $| = 1;
- # $\ = "\015\012";
- binmode($self);
- vec($ {*$self}{FHVec} = '', CORE::fileno($self), 1) = 1;
- $self->setparams({'blocking'=>$self->getparam('blocking',1,1)},0,1);
-}
-
-#& open($self [, @ignore]) : boolean
-#+attrs locked method
-sub open
-{
- $_[0]->_trace(\@_,2);
- my $self = shift;
- $self->stopio if $self->isopen;
- my($pf,$af,$type,$proto) = \@{$ {*$self}{Parms}}{qw(PF AF type proto)};
- $$pf = PF_UNSPEC unless defined $$pf;
- $$af = AF_UNSPEC unless defined $$af;
- $$type = 0 unless defined $$type;
- $$proto = 0 unless defined $$proto;
- if (($$pf == PF_UNSPEC) && ($$af != AF_UNSPEC)) {
- $$pf = $$af;
- }
- elsif (($$af == AF_UNSPEC) && ($$pf != PF_UNSPEC)) {
- $$af = $$pf;
- }
- if ($ {*$self}{'isopen'} = socket($self,$$pf,$$type,$$proto)) {
- # keep stdio output buffers out of my way
- $self->condition;
- }
- $self->isopen;
-}
-
-# sub listen - autoloaded
-
-# hashes for async. connect error values
-my %connok = ( EISCONN,1 );
-my %connip = ( EWOULDBLOCK,1 , EINPROGRESS,1 , EAGAIN,1 , EALREADY,1 );
-
-#& _valconnect($self, $addr, $timeout) : boolean
-sub _valconnect
-{
- my ($self,$addr,$timeout) = @_;
- my ($fhvec,$rdvec,$wrvec,$nfound) = $ {*$self}{FHVec};
- # don't block if socket is non-blocking
- $timeout = 0 if
- !defined $timeout && !$ {*$self}{Parms}{'blocking'};
- # assume caller checked for ->isconnecting
- $rdvec = $wrvec = $fhvec;
- $nfound = CORE::select($rdvec, $wrvec, undef, $timeout);
- # If socket is 'ready', then the connect is complete (possibly failed).
- $ {*$self}{'isconnecting'} = 0 if $nfound;
- # If we don't think the connect has finished, just try to invent a
- # reasonable error and bug out.
- if (!$nfound) {
- $! = EINPROGRESS || EWOULDBLOCK || EALREADY || EAGAIN;
- return;
- }
- my $rval;
- # If we can try to find out with SO_ERROR, give it a shot.
- # This won't give valid results with SOCKS. Tough.
- if ($ {*$self}{Sockopts}{'SOL_SOCKET'}{'SO_ERROR'}) {
- # Don't try the getsockopt if the connect is still pending!
- # Solaris 2.5.1 (at least) hangs the getsockopt in that case.
- # The connect is complete -- figure out whether we believe
- # the status.
- $rval = getsockopt($self,SOL_SOCKET,SO_ERROR);
- return unless defined $rval;
- $rval = unpack("I", $rval);
- if ($rval) {
- $! = $rval;
- return;
- }
- return unless defined getpeername($self);
- return 1;
- }
- # Here, we can't use SO_ERROR (it's not available).
- # The canonical test for success here involves a read() attempt, but
- # we can't use that unless we have a stream socket. SOCK_SEQPACKET and
- # real datagram services would lose their initial transmission to a
- # read check. So, we try it here only if we think we are SOCK_STREAM.
- my $type = $ {*$self}{Parms}{'type'};
- if ($type && $type==SOCK_STREAM) {
- my $buf = "";
- $rval = sysread($self,$buf,0);
- return unless defined $rval;
- # It succeeded. Should it have? If getpeername says so,
- # we still can't be sure, and we'll have to use a second connect().
- }
- return unless defined getpeername($self);
- $rval = CORE::connect($self,$addr);
- return $rval if $rval;
- return 1 if $connok{0+$!};
- $rval;
-}
-
-#& _tryconnect($self, $addr, $timeout) : boolean
-sub _tryconnect
-{
- my ($self,$addr,$timeout) = @_;
- if ($ {*$self}{'isconnecting'}) {
- if ($ {*$self}{Parms}{'dstaddr'} and
- ($ {*$self}{Parms}{'dstaddr'} ne $addr))
- {
- carp "$self->_tryconnect: different destination address while ->isconnecting!"
- if $ {*$self}{Parms}{'debug'} > 2;
- $self->stopio;
- return undef unless $self->open;
- if ($self->getparam('srcaddr') || $self->getparam('srcaddrlist')
- and !$self->isbound)
- {
- return undef unless $self->bind;
- }
- }
- }
- # Apparently, some versions of Solaris don't like a second connect.
- # So, if we're retrying a non-blocking connect, check by other means
- # before trying to use a second connect to get the status.
- # Warning: This will not work with SOCKS.
- unless ($ {*$self}{'isconnecting'}) {
- # For Solaris, if datagram socket, don't connect if not bound.
- if ($ {*$self}{Parms}{netgen_fakeconnect}) {
- if (!$self->isbound) {
- $ {*$self}{Parms}{'dstaddr'} = $addr;
- return 1;
- }
- else {
- $self->delparams(['netgen_fakeconnect']);
- }
- }
- my $rval = CORE::connect($self,$addr);
- return $rval if $rval;
- return 1 if $connok{0+$!};
- return $rval unless $connip{0+$!};
- $ {*$self}{'isconnecting'} = 1;
- $ {*$self}{Parms}{'dstaddr'} = $addr;
- return $rval unless defined $timeout;
- }
- &_valconnect;
-}
-
-#& connect($self, [@ignored]) : boolean
-#+attrs locked method
-sub connect
-{
- $_[0]->_trace(\@_,2);
- my $self = shift;
- my $hval = *$self{HASH};
- my $parms = $hval->{Parms};
- $self->close if
- $hval->{'isconnected'} ||
- (!$hval->{'isconnecting'} && $hval->{'wasconnected'});
- return undef unless $self->isopen or $self->open;
- if ($parms->{'srcaddr'} || $parms->{'srcaddrlist'}
- and !$hval->{'isconnecting'} and !$self->isbound)
- {
- return undef unless $self->bind;
- }
- my $rval;
- my $error = 0; # errno to propagate if failing
- {
- my ($saveblocking,$timeout);
- if (defined ($timeout = $parms->{'timeout'}) && $self->blocking) {
- $saveblocking = $self->param_saver('blocking');
- $self->setparams({'blocking'=>0}) or undef $timeout;
- }
- my $dlist = $parms->{dstaddrlist};
- if (defined($dlist) and
- ref($dlist) eq 'ARRAY' and
- !$hval->{'isconnecting'})
- {
- my $tryaddr;
- foreach $tryaddr (@{$dlist}) {
- $rval = _tryconnect($self, $tryaddr, $timeout);
- $parms->{dstaddr} = $tryaddr if $rval;
- last if $rval or
- defined $timeout && !$timeout
- and $connip{0+$!};
- }
- }
- else {
- $rval = _tryconnect($self, $parms->{dstaddr}, $timeout);
- }
- $error = $!+0 unless $rval;
- }
- $hval->{'isconnected'} = $rval;
- $hval->{'wasconnected'} = '0 but true';
- if (!$rval) {
- $! = $error;
- return $rval;
- }
- $self->getsockinfo;
- $self->isconnected;
-}
-
-#& getsockinfo($self, [@ignored]) : ?dest sockaddr?
-#+attrs locked method
-sub getsockinfo
-{
- $_[0]->_trace(\@_,4);
- my $self = shift;
- my ($sad,$dad);
-
- $self->setparams({dstaddr => $dad}) if defined($dad = getpeername($self));
- $self->setparams({srcaddr => $sad}) if defined($sad = getsockname($self));
- wantarray ?
- ((defined($sad) || defined($dad)) ? ($sad, $dad) : ()) :
- $sad && $dad;
-}
-
-# 'static' hashes for translating between SHUT_* values and the traditional
-# (but off-by-one) 1-3. Used for marking shutdown progress. The connect
-# code helps in the conspiracy by setting '0 but true' rather than '0'.
-
-my %to_shut_flags = (SHUT_RD,1, SHUT_WR,2, SHUT_RDWR,3);
-
-#& shutdown($self [, $how=SHUT_RDWR]) : boolean
-#+attrs locked method
-sub shutdown
-{
- $_[0]->_trace(\@_,3);
- my $self = shift;
- return 1 unless $self->isconnected or $self->isconnecting;
- my $how = shift;
- $how = SHUT_RDWR unless defined $how and $how !~ m/\D/ and length $how;
- $how += 0;
- my $xhow = $to_shut_flags{$how};
- ($how = SHUT_RDWR), ($xhow = 3)
- unless $xhow;
- my $was = ($ {*$self}{'wasconnected'} |= $xhow);
- my $rval = CORE::shutdown($self, $how);
- local $!; # preserve shutdown()'s errno
- $ {*$self}{'isconnecting'} = $ {*$self}{'isconnected'} = 0 if
- $was == 3 or
- (!defined(getpeername($self)) && ($ {*$self}{'wasconnected'} = 3));
- $rval;
-}
-
-
-my @CloseVars = qw(FHVec isopen isbound didlisten wasconnected isconnected
- isconnecting);
-my @CloseKeys = qw(srcaddr dstaddr);
-
-#& close($self [, @ignored]) : boolean
-#+attrs locked method
-sub close
-{
- $_[0]->_trace(\@_,3);
- my $self = shift;
- $self->shutdown if $self->isopen;
- $self->stopio;
-}
-
-sub CLOSE;
-*CLOSE = \&close;
-
-#& stopio($self [, @ignored]) : boolean
-#+attrs locked method
-sub stopio
-{
- $_[0]->_trace(\@_,4);
- my $self = shift;
- my $wasopen = $self->isopen;
- @{*$self}{@CloseVars} = (); # these flags no longer true
- $self->delparams(\@CloseKeys); # connection values now invalid
- return 1 unless $wasopen;
- CORE::close($self);
-}
-
-# I/O enries
-
-# Warning! No intercepting of SIGPIPE is done, so the output routines
-# can abort the program.
-
-# Note that (at least) Solaris 2.5.1 doesn't like connect() on datagram
-# sockets, at least not if they're not bound. So, we fake it here.
-
-#& send($self, $buf, [$flags, [$where]]) : boolean
-sub send
-{
- my $whoami = $_[0]->_trace(\@_,3);
- my($self,$buf,$flags,$whither) = @_;
- croak "Invalid args to ${whoami}, called"
- if @_ < 2 or !ref $self;
- $flags = 0 unless defined $flags;
- carp "Excess arguments to ${whoami} ignored" if @_ > 4;
- # send(2) requires connect(2)
- if (!(defined $whither or $self->isconnected)) {
- if ($self->getparams([qw(dstaddrlist dstaddr)],1) > 0) {
- return undef unless $self->connect;
- if ($ {*$self}{Parms}{netgen_fakeconnect}) {
- $whither = $ {*$self}{Parms}{'dstaddr'};
- }
- }
- else {
- if ($flags & MSG_OOB) {
- $whither = $ {*$self}{lastOOBFrom};
- }
- else {
- $whither = $ {*$self}{lastRegFrom};
- }
-# Can't short-circuit this--need to get the right errno value.
-# return undef unless defined $whither or $self->connect;
- }
- }
- elsif ($self->isconnected && $ {*$self}{Parms}{netgen_fakeconnect}) {
- if (defined $whither) {
- # *sigh* -- what errno should I return?
- $! = EISCONN || EINVAL;
- return undef;
- }
- $whither = $ {*$self}{Parms}{'dstaddr'};
- }
- return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
- $self->isopen; # generate EBADF return if not open
- defined $whither
- ? CORE::send($self, $buf, $flags, $whither)
- : CORE::send($self, $buf, $flags);
-}
-
-sub SEND;
-*SEND = \&send;
-
-#& put($self, @stuff) : boolean
-sub put
-{
- $_[0]->_trace(\@_,3);
- my($self,@args) = @_;
- print {$self} @args;
-}
-
-sub PRINT; # avoid -w error
-*PRINT = \&put; # alias that may someday be used for tied FH
-sub print; # avoid -w error
-*print = \&put; # maybe-useful alias
-
-#& ckeof($self) : boolean
-#+attrs locked method
-sub ckeof
-{
- my $saverr = $!+0;
- local $!; # preserve this over fcntl() and such
- my $whoami = $_[0]->_trace(\@_,3);
- my($self) = @_;
- croak "Invalid args to ${whoami}, called"
- if !@_ or !ref $self;
- # Bug out if we shouldn't have been called.
- return 1 if EOF_NONBLOCK or $saverr != $eagain;
- # Bug out early if not a socket where EOF is possible.
- return 0
- unless unpack('I',getsockopt($self,SOL_SOCKET,SO_TYPE)) == SOCK_STREAM;
- # See whether need to test for non-blocking status.
- my $flags = ($F_GETFL ? CORE::fcntl($self,$F_GETFL,0+0) : undef);
- if ((defined($flags) && defined($nonblock_flag))
- ? ($flags & VAL_O_NONBLOCK)
- : 1)
- {
- # *sigh* -- no way to tell, here
- return 0;
- }
- 1; # wrong errno or blocking
-}
-
-#& recv($self, [$maxlen, [$flags, [$from]]]) : {$buf | undef}
-#+attrs locked method
-sub recv
-{
- my $whoami = $_[0]->_trace(\@_,3);
- my($self,$maxlen,$flags) = @_;
- my($buf,$from,$xfrom) = '';
- croak "Invalid args to ${whoami}, called"
- if !@_ or !ref $self;
- carp "Excess arguments to ${whoami} ignored"
- if @_ > 4;
- return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
- $self->isopen or $self->open; # generate EBADF return if not open
- $maxlen = unpack('I',getsockopt($self,SOL_SOCKET,SO_RCVBUF)) ||
- (stat $self)[11] || 8192
- unless $maxlen;
- $flags = 0 unless defined $flags;
- if (defined($ {*$self}{sockLineBuf}) && !$flags) {
- $buf = $ {*$self}{sockLineBuf};
- if (length($buf) > $maxlen) {
- $ {*$self}{sockLineBuf} = substr($buf, $maxlen);
- substr($buf, $maxlen) = '';
- }
- else {
- undef $ {*$self}{sockLineBuf};
- }
- $_[3] = $ {*$self}{lastRegFrom} if @_ > 3;
- return $buf;
- }
- $! = 0; # ease EOF checking
- $xfrom = $from = CORE::recv($self,$buf,$maxlen,$flags);
- my $errnum = $!+0; # preserve possible recv failure
- $xfrom = getpeername($self) if defined($from) and $from eq '';
- $from = $xfrom if defined($xfrom) and $from eq '' and $xfrom ne '';
- $ {*$self}{lastFrom} = $from;
- $_[3] = $from if @_ > 3;
- if ($flags & MSG_OOB) {
- $ {*$self}{lastOOBFrom} = $from;
- }
- else {
- $ {*$self}{lastRegFrom} = $from;
- }
- $! = $errnum; # restore possible failure in case we return
- return undef if !defined $from and (EOF_NONBLOCK or $errnum != $eagain);
- return $buf if length $buf;
- # At this point, we had a 0-length read with no error (or EAGAIN).
- # Especially for a SOCK_STREAM connection, this may mean EOF.
- $! = $errnum; # restore possible failure just in case
- unless ($self->ckeof) {
- return defined($from) ? $buf : undef;
- }
- $self->shutdown(SHUT_RD); # make sure I know about this EOF
- $! = 0; # no error for EOF
- undef; # no buffer, either, though
-}
-
-sub get; # (helps with -w)
-*get = \&recv; # a name that works for indirect references
-
-#& getline($self) : like scalar(<$fhandle>)
-#+attrs locked method
-sub getline
-{
- my $whoami = $_[0]->_trace(\@_,4);
- carp "Excess arguments to ${whoami} ignored"
- if @_ > 1;
- my ($self) = @_;
- croak "Invalid arguments to ${whoami}, called"
- if !@_ or !ref($self);
- my ($rval, $buf, $tbuf);
- $buf = $ {*$self}{sockLineBuf};
- undef $ {*$self}{sockLineBuf}; # keep get from returning this again
- if (!defined($/)) {
- $rval = <$self>; # return all of the input
- # what about non-blocking sockets here?!?
- # $self->shutdown(SHUT_RD); # keep track of EOF
- # Above removed because ->recv does it on real EOF already.
- if (defined($buf) and defined($rval)) {
- return $buf . $rval
- }
- if (defined($buf)) {
- return $buf
- }
- return $rval
- }
- my $sep = $/; # get the current separator
- $sep = "\n\n" if $sep eq ''; # account for paragraph mode
- while (!defined($buf) or $buf !~ /\Q$sep/) {
- $rval = $self->get;
- last unless defined $rval;
- if (defined $buf) {
- $buf .= $rval;
- }
- else {
- $buf = $rval;
- }
- }
- if (defined($buf) and ($tbuf = index($buf, $sep)) >= 0) {
- $rval = substr($buf, 0, $tbuf + length($sep));
- $tbuf = substr($buf, length($rval));
- # duplicate annoyance of paragraph mode
- $tbuf =~ s/^\n+//s if $/ eq '';
- $ {*$self}{sockLineBuf} = $tbuf if length($tbuf);
- return $rval;
- }
- else {
- return $buf;
- }
-}
-
-sub gets; # an alias for FileHandle:: or POSIX:: compat.
-*gets = \&getline;
-
-sub DESTROY
-{
- $_[0]->_trace(\@_,1);
-}
-
-#& isopen($self [, @ignored]) : boolean
-sub isopen
-{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'isopen'} ? "yes" : "no"));
- $ {*{$_[0]}}{'isopen'};
-}
-
-#& isconnected($self [, @ignored]) : boolean
-sub isconnected
-{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'isconnected'} ? "yes" : "no"));
- $ {*{$_[0]}}{'isconnected'};
-}
-
-#& isconnecting($self [, @ignored]) : boolean
-sub isconnecting
-{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'isconnecting'} ? "yes" : "no"));
- $ {*{$_[0]}}{'isconnecting'};
-}
-
-#& wasconnected($self [, @ignored]) : boolean
-sub wasconnected
-{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'wasconnected'} ? "yes" : "no"));
- $ {*{$_[0]}}{'wasconnected'};
-}
-
-#& isbound($self [, @ignored]) : boolean
-sub isbound
-{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'isbound'} ? "yes" : "no"));
- $ {*{$_[0]}}{'isbound'};
-}
-
-1;
-
-# autoloaded methods go after the END clause (& pod) below
-
-__END__
-
-=head1 NAME
-
-Net::Gen - generic sockets interface handling
-
-=head1 SYNOPSIS
-
- use Net::Gen;
-
-=head1 DESCRIPTION
-
-The C<Net::Gen> module provides basic services for handling
-socket-based communications. It supports no particular protocol
-family directly, however, so it is of direct use primarily to
-implementors of other modules. To this end, several housekeeping
-functions are provided for the use of derived classes, as well as
-several inheritable methods. The C<Net::Gen> class does inherit
-from C<IO::Handle>, thus making its methods available. See
-L<C<IO::Handle::METHODS>|IO::Handle/METHODS>
-for details on those methods. However, some
-of those methods are overridden, so be sure to check the methods
-described below to be sure. (In particular, the C<fcntl> and C<ioctl>
-methods are overridden.)
-
-Also provided in this distribution are
-L<C<Net::Inet>|Net::Inet>,
-L<C<Net::TCP>|Net::TCP>,
-L<C<Net::TCP::Server>|Net::TCP::Server>,
-L<C<Net::UDP>|Net::UDP>,
-L<C<Net::UNIX>|Net::UNIX>,
-and
-L<C<Net::UNIX::Server>|Net::UNIX::Server>,
-which are layered atop C<Net::Gen>.
-
-=head2 Public Methods
-
-The public methods are listed alphabetically below. Here is an
-indication of their functional groupings:
-
-=over 4
-
-=item Creation and setup
-
-C<new>, C<new_from_fd>, C<new_from_fh>, C<init>, C<checkparams>,
-C<open>, C<connect>, C<bind>, C<listen>
-
-=item Parameter manipulation
-
-C<setparams>, C<setparam>, C<delparams>, C<delparam>, C<getparams>,
-C<getparam>, C<param_saver>
-
-=item Low-level control
-
-C<unbind>, C<condition>, C<getsopt>, C<getropt>, C<setsopt>, C<setropt>,
-C<fcntl>, C<ioctl>
-
-=item Medium-level control
-
-C<getsockinfo>, C<shutdown>, C<stopio>, C<close>
-
-=item Informational
-
-C<isopen>, C<isconnected>, C<isbound>, C<didlisten>, C<fhvec>, C<getfh>,
-C<fileno>
-
-=item I/O
-
-C<send>, C<sendto>, C<put>, C<recv>, C<get>, C<getline>, C<gets>, C<select>,
-C<accept>
-
-=item Utility routines
-
-C<format_addr>, C<format_local_addr>, C<format_remote_addr>
-
-=item Tied filehandle support
-
-C<SEND>, C<PRINT>, C<PRINTF>, C<RECV>, C<READLINE>, C<READ>, C<GETC>,
-C<WRITE>, C<CLOSE>, C<EOF>, C<BINMODE>, C<FILENO>,
-C<TIEHANDLE>
-
-=item Tied scalar support
-
-C<FETCH>, C<STORE>, C<TIESCALAR>
-
-=item Accessors
-
-Any of the I<keys> known to the C<getparam> and C<setparams> methods
-may be used as an I<accessor> function. See L<"Known Object Parameters">
-below, and the related sections in the derived classes. For an example,
-see C<blocking>, below.
-
-=back
-
-The descriptions, listed alphabetically:
-
-=over 4
-
-=item accept
-
-Usage:
-
- $newobj = $obj->accept;
-
-Returns a new object in the same class as the given object if an
-accept() call succeeds, and C<undef> otherwise. If the accept()
-call succeeds, the new object is marked as being open, connected,
-and bound. This can fail unexpectedly if the listening socket is
-non-blocking or if the object has a C<timeout> parameter. See the
-discussion of non-blocking sockets and timeouts in L</connect> below.
-
-=item bind
-
-Usage:
-
- $ok = $obj->bind;
-
-Makes a call to the bind() builtin on the filehandle associated
-with the object. The arguments to bind() are determined from the
-current parameters of the object. First, if the filehandle has
-previously been bound or connected, it is closed. Then, if it is
-not currently open, a call to the C<open> method is made. If all
-that works (which may be a no-op), then the following list of
-possible values is tried for the bind() builtin: First, the
-C<srcaddrlist> object parameter, if its value is an array
-reference. The elements of the array are tried in order until a
-bind() succeeds or the list is exhausted. Second, if the
-C<srcaddrlist> parameter is not set to an array reference, if the
-C<srcaddr> parameter is a non-null string, it will be used.
-Finally, if neither C<srcaddrlist> nor C<srcaddr> is suitably
-set, the C<AF> parameter will be used to construct a C<sockaddr>
-structure which will be mostly zeroed, and the bind() will be
-attempted with that. If the bind() fails, C<undef> will be
-returned at this point. Otherwise, a call to the C<getsockinfo>
-method will be made, and then the value from a call to the
-C<isbound> method will be returned.
-
-If all that seems too confusing, don't worry. Most clients will
-never need to do an explicit C<bind> call, anyway. If you're
-writing a server or a privileged client which does need to bind
-to a particular local port or address, and you didn't understand
-the foregoing discussion, you may be in trouble. Don't panic
-until you've checked the discussion of binding in the derived
-class you're using, however.
-
-=item BINMODE
-
-Usage:
-
- binmode(TIEDFH);
-
-A no-op provided for the tied file handle support of perl 5.005_57.
-The sockets managed by this module are always set binmode() anyway.
-
-=item blocking
-
-Usage:
-
- $isblocking = $obj->blocking;
- $oldblocking = $obj->blocking($newvalue);
-
-The C<blocking> method is an example of an I<accessor> method. The
-above usage examples are (effectively) equivalent to the following code
-snippets, respectively:
-
- $isblocking = $obj->getparam('blocking');
-
- $oldblocking = $obj->getparam('blocking');
- $obj->setparams({blocking=>$newvalue});
-
-The C<getparam> method call is skipped if the accessor method was
-called in void context.
-
-=item checkparams
-
-Usage:
-
- $ok = $obj->checkparams;
-
-Verifies that all previous parameter assignments are valid.
-(Normally called only via the C<init> method, rather than
-directly.)
-
-=item close
-
-=item CLOSE
-
-Usage:
-
- $ok = $obj->close;
- $ok = close(TIEDFH);
-
-The C<close> method is like a call to the C<shutdown> method
-followed by a call to the C<stopio> method. It is the standard
-way to close down an object.
-
-=item condition
-
-Usage:
-
- $obj->condition;
-
-(Re-)establishes the condition of the associated filehandle after
-an open() or accept(). (In other words, the C<open> and C<accept>
-methods call the C<condition> method.)
-Sets the socket to be autoflushed and marks it binmode().
-This method attempts to set the socket blocking or non-blocking, depending on
-the state of the object's C<blocking> parameter. (It may update that parameter
-if the socket's state cannot be made to match.)
-No useful value is returned.
-
-=item connect
-
-Usage:
-
- $ok = $obj->connect;
-
-Attempts to establish a connection for the object.
-[Note the special information for re-trying connects on non-blocking sockets,
-later in this section.]
-
-First, if the
-object is currently connected or has been connected since the
-last time it was opened, its C<close> method is called. Then, if
-the object is not currently open, its C<open> method is called.
-If it's not open after that, C<undef> is returned. If it is
-open, and if either of its C<srcaddrlist> or C<srcaddr>
-parameters are set to indicate that a bind() is desired, and it
-is not currently bound, its C<bind> method is called. If the
-C<bind> method is called and fails, C<undef> is returned. (Most
-of the foregoing is a no-op for simple clients, so don't panic.)
-
-Next, if the C<dstaddrlist> object parameter is set to an array
-reference, a call to connect() is made for each element of the
-list until it succeeds or the list is exhausted. If the
-C<dstaddrlist> parameter is not an array reference, a single
-attempt is made to call connect() with the C<dstaddr> object
-parameter. If no connect() call succeeded, C<undef> is returned.
-Finally, a call is made to the object's C<getsockinfo> method,
-and then the value from a call to its C<isconnected> method is
-returned.
-
-Each of the attempts with the connect() builtin is timed out separately.
-If there is no C<timeout> parameter for the object, and the socket is
-blocking (which is the default), the timeout period is strictly at the
-mercy of your operating system. If there is no C<timeout> parameter and the
-socket is non-blocking, that's effectively the same as having a C<timeout>
-parameter value of C<0>. If there is a C<timeout> parameter, the socket
-is made non-blocking temporarily (see L<"param_saver"> below), and the
-indicated timeout value will be used to limit the connection attempt. An
-attempt is made to preserve any meaningful $! values when all connection
-attempts have failed. In particular, if the C<timeout> parameter is 0,
-then each failed connect returns without completing the processing of
-the C<dstaddrlist> object parameter. This is so that the re-try logic
-for connections in progress will be more useful.
-
-If, on entry to the C<connect> method, the object is already marked as
-having a connection in progress (C<$obj-E<gt>isconnecting> returns true),
-then the connection will be re-tried with a timeout of 0 to see whether it
-has succeeded in the meanwhile. The appropriate success/fail condition
-for that check will be returned, with no further processing of the
-C<dstaddrlist> object parameter.
-
-Note that the derived classes tend to provide additional
-capabilities which make the C<connect> method easier to use than
-the above description would indicate.
-
-=item delparam
-
-Usage:
-
- $ok = $obj->delparam($keyname);
-
-Sugar-coated call to the C<delparams> method.
-
-=item delparams
-
-Usage:
-
- $ok = $obj->delparams(\@keynames);
-
-Removes the settings for the specified parameters. Uses the
-C<setparams> method (with C<undef> for the values) to validate
-that the removal is allowed by the owning object. If the
-invocation of C<setparams> is successful, then the parameters in
-question are removed. Returns 1 if all the removals were
-successful, and C<undef> otherwise.
-
-=item didlisten
-
-Usage:
-
- $ok = $obj->didlisten;
-
-Returns true if the object's C<listen> method has been used
-successfully, and the object is still bound. If this method has
-not been overridden by a derived class, the value is C<undef> on
-failure and the C<$maxqueue> value used for the listen() builtin
-on success.
-
-=item EOF
-
-Usage:
-
- $iseof = $obj->EOF();
- $iseof = eof(TIEDFH);
-
-Provided for tied filehandle support. Determines whether select()
-says that a read would work immediately, and tries it if so.
-If the read was tried and returned an eof condition, 1 is returned.
-The return is 0 on read errors or when select() said that a read
-would block. Note that this interferes with use of the select()
-built-in, since it has to buffer the read data if the read was
-successful.
-
-=item fcntl
-
-Usage:
-
- $rval = $obj->fcntl($func, $value);
-
-Returns the result of an fcntl() call on the associated I/O stream.
-
-=item FETCH
-
-Usage:
-
- $data = $TIED_SCALAR;
-
-This is for the support of the C<TIESCALAR> interface. It returns
-the result of a call to the C<READLINE> method on the underlying object.
-
-=item fhvec
-
-Usage:
-
- $vecstring = $obj->fhvec;
-
-Returns a vector suitable as an argument to the 4-argument select()
-call. This is for use in doing selects with multiple I/O streams.
-See also L<"select">.
-
-=item fileno
-
-=item FILENO
-
-Usage:
-
- $fnum = $obj->fileno;
- $fnum = fileno(TIEDFH);
-
-Returns the actual file descriptor number for the underlying socket.
-See L<"getfh"> for some restrictions as to the safety of using this.
-
-=item format_addr
-
-Usage:
-
- $string = $obj->format_addr($sockaddr);
- $string = format_addr Module $sockaddr;
-
-Returns a formatted representation of the address. This is a
-method so that it can be overridden by derived classes. It is
-used to implement ``pretty-printing'' methods for source and
-destination addresses.
-
-=item format_local_addr
-
-Usage:
-
- $string = $obj->format_local_addr;
-
-Returns a formatted representation of the local socket address
-associated with the object.
-
-=item format_remote_addr
-
-Usage:
-
- $string = $obj->format_remote_addr;
-
-Returns a formatted representation of the remote socket address
-associated with the object.
-
-=item get
-
-This is just a sugar-coated way to call the C<recv> method which will
-work with indirect-object syntax. See L<"recv"> for details.
-
-=item GETC
-
-Usage:
-
- $char = $obj->GETC;
- $char = getc(TIEDFH);
-
-This method uses the C<recv> method with a $flags argument of 0 and
-a $maxlen argument of 1 to emulate the getc() builtin. Like that builtin,
-it returns a string representing the character read when successful,
-and undef on eof or errors. This method exists for the support of tied
-filehandles. It's unreliable for non-blocking sockets.
-
-=item getfh
-
-Usage:
-
- $fhandle = $obj->getfh;
-
-I've strongly resisted giving people direct access to the filehandle
-embedded in the object because of the problems of mixing C<stdio> input
-calls and traditional socket-level I/O. However, if you're sure you can
-keep things straight, here are the rules under which it's safe to use the
-embedded filehandle:
-
-=over 6
-
-=item *
-
-Don't use perl's own C<stdio> calls. Stick to sysread() and recv().
-
-=item *
-
-Don't use the object's C<getline> method, since that stores a read-ahead
-buffer in the object which only the object's own C<get>/C<recv> and
-C<getline> methods know to return to you. (The object's C<select> method
-knows about the buffer enough to tell you that a read will succeed if
-there's saved data, though.) Similarly, avoid the object's C<EOF> method.
-
-=item *
-
-Please don't change the state of the socket behind my back. That
-means no close(), shutdown(), connect(), bind(), or listen()
-built-ins. Use the corresponding methods instead, or all bets
-are off. Of course, if you're only using this module to get the
-connect() or bind() processing, and you're going to discard the object
-after you've done your I/O, then it's OK to use the built-ins for I/O.
-Just don't expect my code to know what you did behind my back.
-
-=back
-
-That C<$fh> is a glob ref, by the way, but that doesn't matter for calling
-the built-in I/O primitives.
-
-=item getline
-
-Usage:
-
- $line = $obj->getline;
-
-This is a simulation of C<scalar(E<lt>$filehandleE<gt>)> that doesn't let
-stdio confuse the C<get>/C<recv> method. As such, its return value is
-not necessarily a complete line when the socket is non-blocking.
-
-=item getlines
-
-Usage:
-
- @lines = $obj->getlines;
-
-This is a lot like C<@lines = E<lt>$filehandleE<gt>>, except that it doesn't
-let stdio confuse the C<get>/C<recv> method. It's unreliable on non-blocking
-sockets. It will produce a fatal (but trappable) error if not called in
-list context. (In other words, it uses the die() builtin when not called in
-list context.)
-
-=item getparam
-
-Usage:
-
- $value = $obj->getparam($key, $defval, $def_if_undef);
- $value = $obj->getparam($key, $defval);
- $value = $obj->getparam($key);
-
-Returns the current setting for the named parameter (in the
-current object), or the specified default value if the parameter
-is not in the object's current parameter list. If the optional
-C<$def_if_undef> parameter is true, then undefined values will be
-treated the same as non-existent keys, and thus will return the
-supplied default value (C<$defval>).
-
-=item getparams
-
-Usage:
-
- %hash = $obj->getparams(\@keynames, $noundefs);
- %hash = $obj->getparams(\@keynames);
- $llen = $obj->getparams(\@keynames, $noundefs);
- $llen = $obj->getparams(\@keynames);
-
-Returns a hash as a list (I<not> a reference) consisting of the key-value
-pairs corresponding to the specified keyname list. Only those
-keys which exist in the current parameter list of the object will
-be returned. If the C<$noundefs> parameter is present and true,
-then existing keys with undefined values will be suppressed as with
-non-existent keys. If called in scalar context, returns the
-number of values which would have been returned in list context.
-(This is twice the number of key-value pairs, in case that wasn't clear.)
-
-=item getropt
-
-Usage:
-
- $optsetting = $obj->getropt($level, $option);
- $optsetting = $obj->getropt($optname);
-
-Returns the raw value from a call to the getsockopt() builtin.
-If both the C<$level> and C<$option> arguments are given as
-numbers, the getsockopt() call will be made even if the given
-socket option is not registered with the object. Otherwise, the
-return value for unregistered options will be undef with the
-value of $! set as described below for the C<getsopt> method.
-
-=item gets
-
-Usage:
-
- $line = $obj->gets;
-
-This is a simulation of C<scalar(E<lt>$filehandleE<gt>)> that doesn't let
-stdio confuse the C<get>/C<recv> method. (The C<gets> method is just
-an alias for the C<getline> method, for partial compatibility with
-the POSIX module.) This method is deprecated. Use the C<getline> method
-by that name, instead. The C<gets> method may disappear in a future release.
-
-=item getsockinfo
-
-Usage:
-
- ($localsockaddr, $peersockaddr) = $obj->getsockinfo;
- $peersockaddr = $obj->getsockinfo;
-
-Attempts to determine connection parameters associated with the
-object. If a getsockname() call on the associated filehandle
-succeeds, the C<srcaddr> object parameter is set to that returned
-sockaddr. If a getpeername() call on the associated filehandle
-succeeds, the C<dstaddr> parameter is set to that returned
-sockaddr. In scalar context, if both socket addresses were
-found, the getpeername() value is returned, otherwise C<undef> is
-returned. In list context, the getsockname() and getpeername()
-values are returned, unless both are undefined.
-
-Derived classes normally override this method with one which
-provides friendlier return information appropriate to the derived
-class, and which establishes more of the object parameters.
-
-=item getsopt
-
-Usage:
-
- @optvals = $obj->getsopt($level, $option);
- @optvals = $obj->getsopt($optname);
-
-Returns the unpacked values from a call to the getsockopt()
-builtin. In order to do the unpacking, the socket option must
-have been registered with the object. See the additional discussion of
-socket options in L</initsockopts> below.
-
-Since registered socket options are known by name as well as by
-their level and option values, it is possible to make calls using
-only the option name. If the name is not registered with the object,
-the return value is the same as that for C<getsopt $obj -1,-1>,
-which is an empty return array and $! set appropriately (should
-be C<EINVAL>).
-
-Examples:
-
- ($sotype) = $obj->getsopt('SO_TYPE');
- @malinger = $obj->getsopt(SOL_SOCKET, SO_LINGER);
- ($sodebug) = $obj->getsopt('SOL_SOCKET', 'SO_DEBUG');
-
-=item init
-
-Usage:
-
- return undef unless $self->init;
-
-Verifies that all previous parameter assignments are valid (via
-C<checkparams>). Returns the incoming object on success, and
-C<undef> on failure. This method is normally called from the C<new>
-method appropriate to the class of the created object.
-
-=item ioctl
-
-Usage:
-
- $rval = $obj->ioctl($func, $value);
-
-Returns the result of an ioctl() call on the associated I/O stream.
-
-=item isbound
-
-Usage:
-
- $ok = $obj->isbound;
-
-Returns true if the object's C<bind> method has been used
-successfully, and the binding is still in effect. If this method
-has not been overridden by a derived class, the value is the
-saved return value of the call to the bind() builtin (if it was
-called).
-
-=item isconnected
-
-Usage:
-
- $ok = $obj->isconnected;
-
-Returns true if the object's C<connect> method has been used
-successfully to establish a "session", and that session is still
-connected. If this method has not been overridden by a derived
-class, the value is the saved return value of the call to the
-connect() builtin (if it was called).
-
-=item isconnecting
-
-Usage:
-
- $ok = $obj->isconnecting;
-
-Returns true if the object's C<connect> method has been used
-with a timeout or on a non-blocking socket, and the connect() did
-not complete. In other words, the failure from the connect() builtin
-indicated that the operation was still in progress. (A rejected
-connection or a connection which exceeded the operating system's timeout
-is said to have completed unsuccessfully, rather than not to have completed.)
-
-=item isopen
-
-Usage:
-
- $ok = $obj->isopen;
-
-Returns true if the object currently has a socket attached to its
-associated filehandle, and false otherwise. If this method has
-not been overridden by a derived class, the value is the saved
-return value of the call to the socket() builtin (if it was
-called).
-
-=item listen
-
-Usage:
-
- $ok = $obj->listen($maxqueue);
- $ok = $obj->listen;
-
-Makes a call to the listen() builtin on the filehandle associated
-with the object. Propagates the return value from listen(). If
-the C<$maxqueue> parameter is missing, it defaults to the value
-of the object's I<maxqueue> parameter, or the value of C<SOMAXCONN>.
-If the C<SOMAXCONN> constant is not available in your
-configuration, the default value used for the C<listen> method is
-5. This method will fail if the object is not bound and cannot
-be made bound by a simple call to its C<bind> method.
-
-=item new
-
-Usage:
-
- $obj = $classname->new();
- $obj = $classname->new(\%parameters);
-
-Returns a newly-initialised object of the given class. If called
-for a class other than C<Net::Gen>, 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 validation.)
-
-=item new_from_fd
-
-=item new_from_fh
-
-Usage:
-
- $obj = $classname->new_from_fh(*FH);
- $obj = $classname->new_from_fh(\*FH);
- $obj = $classname->new_from_fd(fileno($fh));
-
-Returns a newly-initialised object of the given class, open on a
-newly-dup()ed copy of the given filehandle or file descriptor.
-As many of the standard object parameters as possible will be
-determined from the passed filehandle. This is determined (in
-part) by calling the corresponding C<new>, C<init>, and
-C<getsockinfo> methods for the new object.
-
-Only real filehandles or file descriptor numbers are allowed as
-arguments. This method makes no attempt to resolve filehandle
-names. Yes, despite having two names, there's really just one method.
-
-=item open
-
-Usage:
-
- $ok = $obj->open;
-
-Makes a call to the socket() builtin, using the current object
-parameters to determine the desired protocol family, socket type,
-and protocol number. If the object was already open, its
-C<stopio> method will be called before socket() is called again.
-The object parameters consulted (and possibly updated) are C<PF>,
-C<AF>, C<proto>, C<type>, and C<blocking>. Returns true if the socket() call
-results in an open filehandle, C<undef> otherwise.
-
-=item param_saver
-
-=item paramSaver
-
-Usage:
-
- my $savedstuff = $obj->param_saver(@param_names);
- my $savedstuff = $obj->paramSaver(@param_names);
-
-Saves the values (or lack thereof) for the indicated parameter names
-by wrapping them (and the original object)
-in an object blessed into an alternate package. When this `saver' object
-is destroyed (typically because the `my' variable went out of scope),
-the previous values of the parameters for the original object will be
-restored. This allows for temporary changes to an object's parameter
-settings without the worry of whether an inopportune die() will prevent
-the restoration of the original settings.
-
-An example (from the C<connect> method):
-
- my $saveblocking = $self->param_saver('blocking');
-
-(This is used when there is a C<timeout> parameter for the object.)
-
-=item print
-
-=item PRINT
-
-See L</put> for details, as this method is just an alias for the C<put> method.
-The C<PRINT> alias is for the support of tied filehandles.
-
-=item PRINTF
-
-Usage:
-
- $ok = $obj->PRINTF($format, @args);
- $ok = printf TIEDFH $format, @args;
-
-This method uses the sprintf() builtin and the C<PRINT> method
-to send the @args values to the
-filehandle associated with the object, using the $format format string.
-It exists for the support of tied filehandles.
-
-=item put
-
-Usage:
-
- $ok = $obj->put(@whatever);
- $ok = put $obj @whatever;
-
-This method uses the print() builtin to send the @whatever
-arguments to the filehandle associated with the object. That
-filehandle is always marked for autoflushing by the C<open>
-method, so the method is in effect equivalent to this:
-
- $ok = $obj->send(join($, , @whatever) . $\ , 0);
-
-However, since multiple fwrite() calls are sometimes involved in
-the actual use of print(), this method can be more efficient than
-the above code sample for large strings in the argument list.
-It's a bad idea except on stream sockets (C<SOCK_STREAM>)
-though, since the record boundaries are unpredictable through
-C<stdio>. It's also a bad idea on non-blocking sockets, since the amount
-of data actually written to the socket is unknown.
-This method makes no attempt to trap C<SIGPIPE>.
-
-=item READ
-
-Usage:
-
- $numread = $obj->READ($buffer, $maxlen);
- $numread = $obj->READ($buffer, $maxlen, $offset);
- $numread = read(TIEDFH, $buffer, $maxlen);
- $numread = read(TIEDFH, $buffer, $maxlen, $offset);
-
-This method uses the C<recv> method (with a flags argument of 0) to
-emulate the read() and sysread() builtins. This is specifically for the
-support of tied filehandles. Like the emulated builtins, this method
-returns the number of bytes successfully read, or undef on error.
-
-=item READLINE
-
-Usage:
-
- $line = $obj->READLINE;
- @lines = $obj->READLINE;
- $line = readline(TIEDFH); # or $line = <TIEDFH>;
- @lines = readline(TIEDFH); # or @lines = <TIEDFH>;
-
-This method supports the use of the E<lt>E<gt> (or readline()) operator
-on tied filehandles. In scalar context, it uses the C<getline> method.
-In list context, it reads all remaining input on the socket (until eof, which
-makes this unsuitable for connectionless socket types such as UDP), and
-splits it into lines based on the current value of the $/ variable.
-The return value is unreliable for non-blocking sockets.
-
-=item RECV
-
-Usage:
-
- $from = $obj->RECV($buffer, $maxlen, $flags);
- $from = $obj->RECV($buffer, $maxlen);
- $from = $obj->RECV($buffer);
-
-This method calls the recv() method with the arguments and return
-rearranged to match the recv() builtin. This is for the support of
-tied filehandles.
-
-=item recv
-
-Usage:
-
- $record = $obj->recv($maxlen, $flags, $whence);
- $record = $obj->recv($maxlen, $flags);
- $record = $obj->recv($maxlen);
- $record = $obj->recv;
-
-This method calls the recv() builtin, and returns a buffer (if
-one is received) or C<undef> on eof or error. If an eof is seen
-on the socket (as checked with its C<ckeof> method), then $!
-will be 0 on return. If the C<$whence> argument is supplied, it
-will be filled in with the sending socket address if possible.
-If the C<$flags> argument is not supplied, it defaults to 0. If
-the C<$maxlen> argument is not supplied, it is defaulted to the
-receive buffer size of the associated filehandle (if known), or
-the preferred blocksize of the associated filehandle (if known,
-which it usually won't be), or 8192.
-
-=item select
-
-Usage:
-
- ($nfound, $timeleft, $rbool, $wbool, $xbool) =
- $obj->select($doread, $dowrite, $doxcept, $timeout);
- $nfound = $obj->select($doread, $dowrite, $doxcept, $timeout);
-
-Issues a 4-argument select() call for the associated I/O stream. All
-arguments are optional. The $timeout argument is the same as the fourth
-argument to the select() builtin.
-The first three are booleans, used to determine
-whether the method should include the object's I/O stream in the
-corresponding parameter to the select() call. The return in list context is
-the standard two values from select(), follwed by booleans indicating
-whether the actual select() call found reading, writing, or exception to be
-true. In scalar context, the routine returns only the count of the number
-of matching conditions. This is probably only useful when you're checking
-just one of the three possible conditions.
-
-=item SEND
-
-=item send
-
-Usage:
-
- $ok = $obj->send($buffer, $flags, $destsockaddr);
- $ok = $obj->send($buffer, $flags);
- $ok = $obj->send($buffer);
-
-This method calls the send() builtin (three- or four-argument
-form). The C<$flags> parameter is defaulted to 0 if not
-supplied. If the C<$destsockaddr> value is missing or undefined,
-and the socket is connected (C<$obj-E<gt>isconnected> returns true), then
-the three-argument form of the send() builtin will be used. Otherwise, the
-C<$destsockaddr> parameter will be defaulted from the last recv()
-peer address for the same kind of message (depending on whether
-C<MSG_OOB> is set in the C<$flags> parameter). A defined
-C<$destsockaddr> will result in a four-argument send() call. The
-return value from the send() builtin is returned. This method
-makes no attempt to trap C<SIGPIPE>.
-
-=item sendto
-
-Usage:
-
- $ok = $obj->sendto($buffer, $destsockaddr, $flags);
- $ok = $obj->sendto($buffer, $destsockaddr);
-
-This method calls the send() builtin (four-argument form). The
-C<$flags> parameter is defaulted to 0 if not supplied. The
-return value from the send() builtin is returned. This method
-makes no attempt to trap C<SIGPIPE>.
-
-=item setparam
-
-Usage:
-
- $ok = $obj->setparam($key, $value, $newonly, $checkup);
- $ok = $obj->setparam($key, $value, $newonly);
- $ok = $obj->setparam($key, $value);
-
-Sets a single new parameter. Uses the C<setparams> method, and
-has the same rules for the handling of the C<$newonly> and
-C<$checkup> parameters. Returns 1 if the set was successful, and
-C<undef> otherwise.
-
-=item setparams
-
-Usage:
-
- $ok = $obj->setparams(\%newparams, $newonly, $checkup);
- $ok = $obj->setparams(\%newparams, $newonly);
- $ok = $obj->setparams(\%newparams);
-
-Sets new parameters from the given hashref, with validation.
-This is done in a loop over the I<key, value> pairs from the
-C<newparams> parameter. The precise nature of the validation
-depends on the C<$newonly> and C<$checkup> parameters (which are
-optional), but in all cases the keys to be set are checked
-against those registered with the object. If the C<$newonly>
-parameter is negative, the value from the hashref will only be
-set if there is not already a defined value associated with that
-key, but the skipping of the setting of the value is silent. If the
-C<$newonly> parameter is not negative or if there is no existing
-defined value, if the C<$checkup> parameter is false then the
-setting of the new value is skipped if the new value is identical
-to the old value. If those checks don't cause the setting of a
-new value to be skipped, then if the C<$newonly> parameter is
-positive and there is already a defined value for the specified
-key, a warning will be issued and the new value will not be set.
-
-If none of the above checks cause the setting of a new value to
-be skipped, but if the specified key has a validation routine,
-that routine will be called with the given object, the current
-key, and the proposed new value as parameters. It is allowed for
-the validation routine to alter the new-value argument to change
-what will be set. (This is useful when changing a hostname to be
-in canonical form, for example.) If the validation routine
-returns a non-null string, that will be used to issue a warning,
-and the new value will not be set. If the validation routine
-returns a null string (or if there is no validation routine), the
-new value will (finally) get set for the given key.
-
-The C<setparams> method returns 1 if all parameters were
-successfully set, and C<undef> otherwise.
-
-=item setropt
-
-Usage:
-
- $ok = $obj->setropt($level, $option, $rawvalue);
- $ok = $obj->setropt($optname, $rawvalue);
-
-Returns the result from a call to the setsockopt() builtin. If
-the $level and $option arguments are both given as numbers, the
-setsockopt() call will be made even if the option is not
-registered with the object. Otherwise, unregistered options will
-fail as for the C<setsopt> method, below.
-
-=item setsopt
-
-Usage:
-
- $ok = $obj->setsopt($level, $option, @optvalues);
- $ok = $obj->setsopt($optname, @optvalues);
-
-Returns the result from a call to the setsockopt() builtin. In
-order to be able to pack the C<@optvalues>, the option must be
-registered with the object, just as described in L</getsopt>
-above.
-
-=item shutdown
-
-Usage:
-
- $ok = $obj->shutdown($how);
- $ok = $obj->shutdown;
-
-Calls the shutdown() builtin on the filehandle associated with
-the object. This method is a no-op, returning 1, if the
-filehandle is not connected. The C<$how> parameter is as per the
-shutdown() builtin, which in turn should be as described in the
-shutdown(2) manpage. If the C<$how> parameter is not present,
-it is assumed to be C<SHUT_RDWR> (which is 2 on most UNIX systems).
-
-Returns 1 if it has nothing to do, otherwise propagates the return from
-the shutdown() builtin.
-
-=item stopio
-
-Usage:
-
- $ok = $obj->stopio;
-
-Calls the close() builtin on the filehandle associated with the
-object, unless that filehandle is already closed. Returns 1 or
-the return value from the close() builtin. This method is
-primarily for the use of server modules which need to avoid
-C<shutdown> calls at inappropriate times. This method calls the
-C<delparams> method for the keys of C<srcaddr> and C<dstaddr>.
-
-=item STORE
-
-Usage:
-
- $TIED_SCALAR = $data;
-
-Provided for the support of tied scalars. Results in a call to the
-C<put> method, unless there's exactly one arg and it's C<undef>.
-In that case, since this normally results from C<undef $TIED_SCALAR>,
-it's ignored.
-
-=item TIEHANDLE
-
-Usage:
-
- tie *FH, $package, @options or die;
- print FH $out_data;
- print $in_data while defined($in_data = <FH>);
- untie *FH;
-
-Tieing of a filehandle to a network handle is supported by this base
-However, this method only succeeds if the related call to the C<new>
-method returns an object for which the C<isconnected> method returns
-true. Thus, the most useful example is in
-L<C<Net::UDP>|Net::UDP/"TIEHANDLE support">.
-
-=item TIESCALAR
-
-Usage:
-
- tie $x, $package, @options or die;
- $x = $out_data;
- print $in_data while defined($in_data = $x);
- untie $x;
-
-Tieing of scalars to a network handle is supported by this base class.
-However, this method only succeeds if the related call to the C<new>
-method returns an object for which the C<isconnected> method returns
-true. Thus, the useful examples are in
-L<C<Net::TCP>|Net::TCP/TIESCALAR>
-and
-L<C<Net::UDP>|Net::UDP/"TIESCALAR support">.
-
-=item unbind
-
-Usage:
-
- $obj->unbind;
-
-Removes any saved binding for the object. Unless the object is
-currently connected, this will result in a call to its C<close>
-method, in order to ensure that any previous binding is removed.
-Even if the object is connected, the C<srcaddrlist> object
-parameter is removed (via the object's C<delparams> method). The
-return value from this method is indeterminate.
-
-=item wasconnected
-
-Usage:
-
- $was = $obj->wasconnected;
-
-Returns true if the object has had a successful connect() completion
-since it was last opened. Returns false after a close() or on a new
-object. Also returns true if C<$obj-E<gt>isconnecting> is true.
-
-=item WRITE
-
-Usage:
-
- $nwritten = $obj->WRITE($buf, $len);
- $nwritten = $obj->WRITE($buf, $len, $offset);
- $nwritten = syswrite(TIEDFH, $buf, $len);
- $nwritten = syswrite(TIEDFH, $buf, $len, $offset);
-
-This method exists for support of syswrite() on tied filehandles.
-It calls the syswrite() builtin on the underlying filehandle with the
-same parameters.
-
-=back
-
-=head2 Protected Methods
-
-Yes, I know that Perl doesn't really have protected methods as
-such. However, these are the methods which are only useful for
-implementing derived classes, and not for the general user.
-
-=over 4
-
-=item ckeof
-
-Usage:
-
- $wasiteof = $obj->ckeof;
-
-After a 0-length read in the get() routine, it calls this method to
-determine whether such a 0-length read meant EOF. The default method
-supplied here checks for non-blocking sockets (if necessary), and
-for a C<SOCK_STREAM> socket. If EOF_NONBLOCK is true, or if the
-C<VAL_O_NONBLOCK> flag was not set in the fcntl() flags for the
-socket, or if the error code was not VAL_EAGAIN, I<and> the socket
-is of type C<SOCK_STREAM>, then this method returns true. It
-returns a false value otherwise. This method is overridable for
-classes like C<Net::Dnet>, which support C<SOCK_SEQPACKET> and
-need to make a protocol-family-specific check to tell a 0-length
-packet from EOF.
-
-=item initsockopts
-
-Usage:
-
- $classname->initsockopts($level, \%optiondesc);
-
-Given a prototype optiondesc hash ref, updates it to include all
-the data needed for the values it can find, and deletes the ones
-it can't. For example, here's a single entry from such a
-prototype optiondesc:
-
- 'SO_LINGER' => ['II'],
-
-Given that, and the $level of C<SOL_SOCKET>, and the incoming
-class name of C<Net::Gen>, C<initsockopts> will attempt to
-evaluate C<SO_LINGER> in package C<Net::Gen>, and if it succeeds
-it will fill out the rest of the information in the associated
-array ref, and add another key to the hash ref for the value of
-C<SO_LINGER> (which is 128 on my system). If it can't evaluate
-that psuedo-constant, it will simply delete that entry from the
-referenced hash. Assuming a successful evaluation of this entry,
-the resulting entries would look like this:
-
- 'SO_LINGER' => ['II', SO_LINGER+0, SOL_SOCKET+0, 2],
- SO_LINGER+0 => ['II', SO_LINGER+0, SOL_SOCKET+0, 2],
-
-(All right, so the expressions would be known values, but maybe
-you get the idea.)
-
-A completed optiondesc hash is a set of key-value pairs where the
-value is an array ref with the following elements:
-
- [pack template, option value, option level, pack array len]
-
-Such a completed optiondesc is one of the required arguments to
-the C<register_options> method (see below).
-
-=item register_options
-
-=item registerOptions
-
-Usage:
-
- $obj->register_options($levelname, $level, \%optiondesc);
-
-This method attaches the socket options specified by the given
-option descriptions hash ref and the given level (as text and as
-a number) to the object. The registered set of socket options is
-in fact a hashref of hashrefs, where the keys are the level names
-and level numbers, and the values are the optiondesc hash refs
-which get registered.
-
-Example:
-
- $self->register_options('SOL_SOCKET', SOL_SOCKET+0, \%sockopts);
-
-=item register_param_handlers
-
-=item registerParamHandlers
-
-Usage:
-
- $obj->register_param_handlers(\@keynames, \@keyhandlers);
- $obj->register_param_handlers(\%key_handler_pairs);
-
-This method registers the referenced keynames (if they haven't
-already been registered), and establishes the referenced
-keyhandlers as validation routines for those keynames. Each
-element of the keyhandlers array must be a code reference. When
-the C<setparams> method invokes the handler, it will be called
-with three arguments: the target object, the keyname in question,
-and the proposed new value (which may be C<undef>, especially if
-being called from the C<delparams> method). See the other
-discussion of validation routines in the C<setparams> method
-description, above.
-
-=item register_param_keys
-
-=item registerParamKeys
-
-Usage:
-
- $obj->register_param_keys(\@keynames);
-
-This method registers the referenced keynames as valid parameters
-for C<setparams> and the like for this object. The C<new>
-methods can store arbitrary parameter values, but the C<init>
-method will later ensure that all those keys eventually got
-registered. This out-of-order setup is allowed because of
-possible cross-dependencies between the various parameters, so
-they have to be set before they can be validated (in some cases).
-
-=item _accessor
-
-Usage:
-
- $value = $obj->_accessor($what);
- $oldvalue = $obj->_accessor($what, $newvalue);
-
-This method implements the use of the known parameter keys as get/set
-methods. It's used by the customised AUTOLOAD to generate such accessor
-functions as they're referenced. See L<"blocking"> above for an example.
-
-=back
-
-=head2 Known Socket Options
-
-These are the socket options known to the C<Net::Gen> module
-itself:
-
-=over 4
-
-=item Z<>
-
-C<SO_ACCEPTCONN>,
-C<SO_BROADCAST>,
-C<SO_DEBUG>,
-C<SO_DONTROUTE>,
-C<SO_ERROR>,
-C<SO_EXPANDED_RIGHTS>,
-C<SO_FAMILY>,
-C<SO_KEEPALIVE>,
-C<SO_LINGER>,
-C<SO_OOBINLINE>,
-C<SO_PAIRABLE>,
-C<SO_RCVBUF>,
-C<SO_RCVLOWAT>,
-C<SO_RCVTIMEO>,
-C<SO_REUSEADDR>,
-C<SO_REUSEPORT>,
-C<SO_SNDBUF>,
-C<SO_SNDLOWAT>,
-C<SO_SNDTIMEO>,
-C<SO_STATE>,
-C<SO_TYPE>,
-C<SO_USELOOPBACK>,
-C<SO_XSE>
-
-=back
-
-=head2 Known Object Parameters
-
-These are the object parameters registered by the C<Net::Gen>
-module itself:
-
-=over 4
-
-=item AF
-
-Address family (will default from PF, and vice versa).
-
-=item blocking
-
-Set to 0 when a socket has been marked as non-blocking, and to 1
-otherwise. If it's C<undef>, it'll be treated as though it were
-set to 1. The use of anything which even looks like C<stdio>
-calls on non-blocking sockets as at your own risk. If you don't know
-how to work with non-blocking sockets already, the results of trying
-them may surprise you.
-
-=item dstaddr
-
-The result of getpeername(), or an ephemeral proposed connect() address.
-
-=item dstaddrlist
-
-A reference to an array of socket addresses to try for connect().
-
-=item maxqueue
-
-An override of the default maximum queue depth parameter for
-listen(). This will be used if the $maxqueue argument to
-listen() is not supplied.
-
-=item netgen_fakeconnect
-
-This parameter is set true to keep the C<connect> method from
-really calling the connect() built-in if the socket has not
-had an source address specified and it is not bound. This
-is used by the
-L<Net::UNIX|Net::UNIX>
-and
-L<Net::UDP|Net::UDP>
-modules to keep
-from exercising a bug in some socket implementations with respect
-to how datagram sockets are handled. (This was specifically done
-in response to quirks of Solaris 2.5.1.) Instead, the C<connect>
-method simply sets the C<dstaddr> object parameter, which the C<send>
-method will respect.
-
-=item PF
-
-Protocol family for this object. Will default from AF, and vice versa.
-
-=item proto
-
-The protocol to pass to the socket() call (often defaulted to 0).
-
-=item reuseaddr
-
-A boolean, indicating whether the C<bind> method should do a
-setsockopt() call to set C<SO_REUSEADDR> to 1.
-
-=item reuseport
-
-A boolean, indicating whether the C<bind> method should do a
-setsockopt() call to set C<SO_REUSEPORT> to 1.
-
-=item srcaddr
-
-The result of getsockname(), or an ephemeral proposed bind() address.
-
-=item srcaddrlist
-
-A reference to an array of socket addresses to try for bind().
-
-=item timeout
-
-The maximum time to wait for connect() or accept() attempts to succeed.
-See the discussion of timeouts and non-blocking sockets
-in L</connect> above.
-
-=item type
-
-The socket type to create (C<SOCK_STREAM>, C<SOCK_DGRAM>, etc.)
-
-=back
-
-=head2 Non-Method Subroutines
-
-=over 4
-
-=item pack_sockaddr
-
-Usage:
-
- $connect_address = pack_sockaddr($family, $fam_addr);
-
-Returns a packed C<struct sockaddr> corresponding to the provided
-$family (which must be a number) and the address-family-specific
-$fam_addr (pre-packed).
-
-=item unpack_sockaddr
-
-Usage:
-
- ($family, $fam_addr) = unpack_sockaddr($packed_address);
-
-The inverse of pack_sockaddr().
-
-=item E*
-
-Various socket-related C<errno> values. See L<":errnos"> for the list.
-These routines will always be defined, but they will return 0 if the
-corresponding error symbol was not found on your system.
-
-=item EOF_NONBLOCK
-
-Returns a boolean value depending on whether a read from a
-non-blocking socket can distinguish an end-of-file condition from
-a no-data-available condition. This corresponds to the value
-available from the C<Config> module as
-C<$Config::Config{'d_eofnblk'}>), except that C<EOF_NONBLOCK> is
-always defined.
-
-=item RD_NODATA
-
-Gives the integer return value found by the F<Configure> script
-for a read() system call on a non-blocking socket which has no
-data available. This is similar to the string representation of
-the value available from the C<Config> module as
-C<$Config::Config{'rd_nodata'}>.
-
-=item VAL_EAGAIN
-
-Gives the value of the error symbol found by the F<Configure>
-script which is set by a non-blocking filehandle when no data is
-available. This differs from the value available from the
-C<Config> module (C<$Config::Config{'eagain'}>) in that the
-latter is a string, typically C<"EAGAIN">.
-
-=item VAL_O_NONBLOCK
-
-Gives the value found by the F<Configure> script for setting a
-filehandle non-blocking. The value available from the C<Config>
-module is a string representing the value found
-(C<$Config::Config{'o_nonblock'}>), whereas the value from
-C<VAL_O_NONBLOCK> is an integer, suitable for passing to
-sysopen() or for eventual use in fcntl().
-
-=back
-
-=head2 Exports
-
-=over 4
-
-=item default
-
-None.
-
-=item exportable
-
-C<AF_APPLETALK> C<AF_CCITT> C<AF_CHAOS> C<AF_CTF> C<AF_DATAKIT>
-C<AF_DECnet> C<AF_DLI> C<AF_ECMA> C<AF_HYLINK> C<AF_IMPLINK>
-C<AF_INET> C<AF_ISO> C<AF_LAST> C<AF_LAT> C<AF_LINK> C<AF_LOCAL> C<AF_NETMAN>
-C<AF_NS> C<AF_OSI> C<AF_PUP> C<AF_ROUTE> C<AF_SNA> C<AF_UNIX>
-C<AF_UNSPEC> C<AF_USER> C<AF_WAN> C<AF_X25> C<EADDRINUSE>
-C<EADDRNOTAVAIL> C<EAFNOSUPPORT> C<EAGAIN> C<EALREADY> C<EBADF>
-C<EBADMSG> C<ECONNABORTED> C<ECONNREFUSED> C<ECONNRESET>
-C<EDESTADDRREQ> C<EHOSTDOWN> C<EHOSTUNREACH> C<EINPROGRESS>
-C<EINVAL> C<EISCONN> C<EMSGSIZE> C<ENETDOWN> C<ENETRESET>
-C<ENETUNREACH> C<ENOBUFS> C<ENODATA> C<ENOENT> C<ENOPROTOOPT>
-C<ENOSR> C<ENOSTR> C<ENOTCONN> C<ENOTSOCK> C<EOF_NONBLOCK>
-C<EOPNOTSUPP> C<EPFNOSUPPORT> C<EPROTO> C<EPROTONOSUPPORT>
-C<EPROTOTYPE> C<ESHUTDOWN> C<ESOCKTNOSUPPORT> C<ETIME>
-C<ETIMEDOUT> C<ETOOMANYREFS> C<EWOULDBLOCK> C<pack_sockaddr>
-C<PF_APPLETALK> C<PF_CCITT> C<PF_CHAOS> C<PF_CTF> C<PF_DATAKIT>
-C<PF_DECnet> C<PF_DLI> C<PF_ECMA> C<PF_HYLINK> C<PF_IMPLINK>
-C<PF_INET> C<PF_ISO> C<PF_LAST> C<PF_LAT> C<PF_LINK> C<PF_LOCAL> C<PF_NETMAN>
-C<PF_NS> C<PF_OSI> C<PF_PUP> C<PF_ROUTE> C<PF_SNA> C<PF_UNIX>
-C<PF_UNSPEC> C<PF_USER> C<PF_WAN> C<PF_X25> C<RD_NODATA>
-C<SHUT_RD> C<SHUT_RDWR> C<SHUT_WR> C<SOCK_DGRAM> C<SOCK_RAW>
-C<SOCK_RDM> C<SOCK_SEQPACKET> C<SOCK_STREAM> C<SOL_SOCKET>
-C<SOMAXCONN> C<SO_ACCEPTCONN> C<SO_BROADCAST> C<SO_DEBUG>
-C<SO_DONTROUTE> C<SO_ERROR> C<SO_EXPANDED_RIGHTS> C<SO_FAMILY>
-C<SO_KEEPALIVE> C<SO_LINGER> C<SO_OOBINLINE> C<SO_PAIRABLE>
-C<SO_RCVBUF> C<SO_RCVLOWAT> C<SO_RCVTIMEO> C<SO_REUSEADDR>
-C<SO_REUSEPORT> C<SO_SNDBUF> C<SO_SNDLOWAT> C<SO_SNDTIMEO>
-C<SO_STATE> C<SO_TYPE> C<SO_USELOOPBACK> C<SO_XSE>
-C<unpack_sockaddr> C<VAL_EAGAIN> C<VAL_O_NONBLOCK>
-
-=item tags
-
-The following I<:tags> are available for grouping exported items
-together:
-
-=over 6
-
-=item :af
-
-C<AF_APPLETALK> C<AF_CCITT> C<AF_CHAOS> C<AF_CTF> C<AF_DATAKIT>
-C<AF_DECnet> C<AF_DLI> C<AF_ECMA> C<AF_HYLINK> C<AF_IMPLINK>
-C<AF_INET> C<AF_ISO> C<AF_LAST> C<AF_LAT> C<AF_LINK> C<AF_LOCAL> C<AF_NETMAN>
-C<AF_NS> C<AF_OSI> C<AF_PUP> C<AF_ROUTE> C<AF_SNA> C<AF_UNIX>
-C<AF_UNSPEC> C<AF_USER> C<AF_WAN> C<AF_X25>
-
-=item :errnos
-
-C<EADDRINUSE> C<EADDRNOTAVAIL> C<EAFNOSUPPORT> C<EAGAIN>
-C<EALREADY> C<EBADF> C<EBADMSG> C<ECONNABORTED> C<ECONNREFUSED>
-C<ECONNRESET> C<EDESTADDRREQ> C<EHOSTDOWN> C<EHOSTUNREACH>
-C<EINPROGRESS> C<EINVAL> C<EISCONN> C<EMSGSIZE> C<ENETDOWN> C<ENETRESET>
-C<ENETUNREACH> C<ENOBUFS> C<ENODATA> C<ENOENT> C<ENOPROTOOPT> C<ENOSR>
-C<ENOSTR> C<ENOTCONN> C<ENOTSOCK> C<EOPNOTSUPP> C<EPFNOSUPPORT>
-C<EPROTO> C<EPROTONOSUPPORT> C<EPROTOTYPE> C<ESHUTDOWN>
-C<ESOCKTNOSUPPORT> C<ETIME> C<ETIMEDOUT> C<ETOOMANYREFS> C<EWOULDBLOCK>
-
-=item :families
-
-The union of the C<:af> and C<:pf> tags.
-
-=item :NonBlockVals
-
-=item :non_block_vals
-
-C<EOF_NONBLOCK> C<RD_NODATA> C<VAL_EAGAIN> C<VAL_O_NONBLOCK>
-
-=item :pf
-
-C<PF_APPLETALK> C<PF_CCITT> C<PF_CHAOS> C<PF_CTF> C<PF_DATAKIT>
-C<PF_DECnet> C<PF_DLI> C<PF_ECMA> C<PF_HYLINK> C<PF_IMPLINK>
-C<PF_INET> C<PF_ISO> C<PF_LAST> C<PF_LAT> C<PF_LINK> C<PF_LOCAL> C<PF_NETMAN>
-C<PF_NS> C<PF_OSI> C<PF_PUP> C<PF_ROUTE> C<PF_SNA> C<PF_UNIX>
-C<PF_UNSPEC> C<PF_USER> C<PF_WAN> C<PF_X25>
-
-=item :routines
-
-C<pack_sockaddr> C<unpack_sockaddr>
-
-=item :shutflags
-
-C<SHUT_RD> C<SHUT_WR> C<SHUT_RDWR>
-
-=item :sockopts
-
-C<SO_ACCEPTCONN> C<SO_BROADCAST> C<SO_DEBUG> C<SO_DONTROUTE>
-C<SO_ERROR> C<SO_EXPANDED_RIGHTS> C<SO_FAMILY> C<SO_KEEPALIVE>
-C<SO_LINGER> C<SO_OOBINLINE> C<SO_PAIRABLE> C<SO_RCVBUF>
-C<SO_RCVLOWAT> C<SO_RCVTIMEO> C<SO_REUSEADDR> C<SO_REUSEPORT>
-C<SO_SNDBUF> C<SO_SNDLOWAT> C<SO_SNDTIMEO> C<SO_STATE> C<SO_TYPE>
-C<SO_USELOOPBACK> C<SO_XSE>
-
-=item :sockvals
-
-C<SOL_SOCKET> C<SOCK_STREAM> C<SOCK_DGRAM> C<SOCK_RAW>
-C<SOCK_RDM> C<SOCK_SEQPACKET>
-
-=item :ALL
-
-All of the above.
-
-=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::UNIX(3)|Net::UNIX>,
-Net::Dnet(3)
-
-=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
-
-#& setdebug($this, [bool, [norecurse]]) : previous
-sub setdebug
-{
- $_[0]->_debug($_[1]);
-}
-
-# fluff routine to make things easy
-#& setparam($self, $name, $value, [newonly, [docheck]]) : boolean
-sub setparam
-{
- my $whoami = $_[0]->_trace(\@_,1);
- my($self,$key,$val,$newonly,$docheck) = @_;
- carp "Excess arguments to ${whoami} ignored"
- if @_ > 5;
- croak "Invalid arguments to ${whoami}, called"
- if @_ < 3 or not ref $self or not exists $ {*$self}{Keys}{$key};
- $self->setparams({$key => $val}, $newonly, $docheck);
-}
-
-#& bind($self [, @ignored]) : boolean
-#+attrs locked method
-sub bind
-{
- $_[0]->_trace(\@_,2);
- my $self = shift;
- $self->close if
- $self->wasconnected || $self->isconnected || $self->isconnecting ||
- $self->isbound;
- return $ {*$self}{'isbound'} = undef unless
- $self->isopen or $self->open;
- $self->setsopt('SO_REUSEADDR', 1) if $ {*$self}{Parms}{reuseaddr};
- $self->setsopt('SO_REUSEPORT', 1) if $ {*$self}{Parms}{reuseport};
- my $rval;
- if ($ {*$self}{Parms}{srcaddrlist}) {
- my $tryaddr;
- foreach $tryaddr (@{$ {*$self}{Parms}{srcaddrlist}}) {
- next unless $rval = CORE::bind($self, $tryaddr);
- $ {*$self}{Parms}{srcaddr} = $tryaddr;
- last;
- }
- }
- elsif (defined($ {*$self}{Parms}{srcaddr}) and
- length $ {*$self}{Parms}{srcaddr})
- {
- $rval = CORE::bind($self, $ {*$self}{Parms}{srcaddr});
- }
- else {
- $rval = CORE::bind($self, pack_sockaddr($ {*$self}{Parms}{AF},''));
- }
- $ {*$self}{'isbound'} = $rval;
- return $rval unless $rval;
- $self->getsockinfo;
- $self->isbound;
-}
-
-#& unbind($self [, @ignored])
-#+attrs locked method
-sub unbind
-{
- $_[0]->_trace(\@_,2);
- my($self) = @_;
- $self->close unless $self->isconnected || $self->isconnecting;
- $self->delparams([qw(srcaddrlist)]);
-}
-
-#& delparam($self, @paramnames) : boolean
-sub delparam
-{
- my ($self,@keys) = @_;
- $self->delparams(\@keys);
-}
-
-#& listen($self [, $maxq=SOMAXCONN]) : boolean
-#+attrs locked method
-sub listen
-{
- my $whoami = $_[0]->_trace(\@_,2);
- my ($self,$maxq) = @_;
- $maxq = $self->getparam('maxqueue',SOMAXCONN,1) unless defined $maxq;
- croak "Invalid args for ${whoami}(@_), called" if
- $maxq =~ /\D/ or !ref $self;
- carp "Excess args for ${whoami}(@_) ignored" if @_ > 2;
- return undef unless $self->isbound or $self->bind;
- $ {*$self}{'didlisten'} = $maxq;
- CORE::listen($self,$maxq) or undef $ {*$self}{'didlisten'};
-}
-
-#& didlisten($self [, @ignored]) : boolean
-sub didlisten
-{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'didlisten'} ? "yes" : "no"));
- $ {*{$_[0]}}{'didlisten'};
-}
-
-sub TIESCALAR
-{
- $_[0]->_trace(\@_,2);
- my $class = shift;
- my $self = $class->new(@_);
- $self && $self->isconnected && $self;
-}
-
-#+attrs locked method
-sub FETCH
-{
- $_[0]->_trace(\@_,2);
- scalar $_[0]->READLINE;
-}
-
-#+attrs locked method
-sub STORE
-{
- $_[0]->_trace(\@_,2);
- my $self = shift;
- return if @_ == 1 and !defined $_[0]; # "undef $x"
- $self->put(@_);
-}
-
-# socket-option routines
-
-#& _findxopt($self, $realp, @args) : ($aref,@subargs)
-sub _findxopt
-{
- my($self,$realp,@args) = @_;
- my($aref,$level,$what);
- $level = shift @args; # try input arg as level first
- if ($level =~ /^(0x[\da-f]+|0[0-7]*|[1-9]\d*)$/si) {
- # if numeric, it had better be the level
- $level = ((substr($level, 0, 1) eq '0') ? oct($level) : $level+0);
- }
- $aref = $ {*$self}{Sockopts}{$level};
- if (!$aref) {
- # here, we have to search for the ruddy thing by keyword
- # if level was numeric, punt by trying to force EINVAL
- until ($level =~ /\D/) {
- # numeric level, check for realp and numeric what
- last unless $realp;
- $what = shift @args;
- last unless $what =~ /^(0x[\da-f]+|0[0-7]*|[1-9]\d*)$/si;
- $what = ((substr($what, 0, 1) eq '0') ? oct($what) : $what+0);
- $aref = ['h*', $what, $level, 0+@args];
- return ($aref,@args);
- }
- return getsockopt($self,-1,-1) unless $level =~ /\D/;
- $what = $level;
- foreach $level (keys %{$ {*$self}{Sockopts}}) {
- next unless ref($ {*$self}{Sockopts}{$level}) eq 'HASH';
- last if $aref = $ {*$self}{Sockopts}{$level}{$what};
- }
- $ {*$self}{Sockopts}{$what} = $aref if ref $aref eq 'ARRAY';
- }
- elsif (ref $aref eq 'HASH') {
- $what = shift @args;
- if ($what =~ /^(0x[\da-f]+|0[0-7]*|[1-9]\d*)$/si) {
- $what = ((substr($what, 0, 1) eq '0') ? oct($what) : $what+0);
- }
- $aref = $$aref{$what};
- }
- # force EINVAL (I hope) if unrecognized value
- return getsockopt($self,-1,-1) unless ref $aref eq 'ARRAY';
- ($aref,@args);
-}
-
-#& _getxopt($this, $realp, [$level,] $what) : @values
-#+attrs locked method
-sub _getxopt
-{
- my($self,$realp,@args) = @_;
- my($aref,$level,$what,$rval,$format);
- @args = $self->_findxopt($realp, @args); # get the array ref
- return unless $aref = shift @args;
- carp "Excess args to getsockopt ignored" if @args;
- $what = $$aref[1];
- $level = $$aref[2];
- $format = $$aref[0];
- $rval = getsockopt($self,$level+0,$what+0);
- if ($self->debug > 3) {
- @args = unpack($format,$rval) if defined $rval;
- print STDERR " - getsockopt $self,$level,$what => ";
- print STDERR (defined $rval ? "@args\n" : "(undef)\n");
- }
- return $rval if $realp;
- return () unless defined $rval;
- unpack($format,$rval);
-}
-
-#& getsopt($this, [$level,] $what) : @values
-sub getsopt
-{
- my($self,@args) = @_;
- $self->_getxopt(0,@args);
-}
-
-#& getropt($this, [$level,] $what) : $value
-sub getropt
-{
- my($self,@args) = @_;
- $self->_getxopt(1,@args);
-}
-
-#& _setxopt($this, $realp, [$level,] $what, @vals) : boolean
-#+attrs locked method
-sub _setxopt
-{
- my($self,$realp,@args) = @_;
- my($aref,$level,$what,$rval,$format);
- @args = $self->_findxopt($realp, @args); # get the array ref and real args
- return undef unless $aref = shift @args;
- $what = $$aref[1];
- $level = $$aref[2];
- $format = $$aref[0];
- if ($realp) {
- $rval = shift @args;
- }
- else {
- $rval = pack($format, @args);
- carp "Excess args to " . join('::',(caller(0))[0,3]) . " ignored"
- if @args > $$aref[3];
- $rval = undef if !length($rval) and !$$aref[3];
- }
- print STDERR " - setsockopt $self,$level,$what,",
- join($",unpack($format,$rval)),"\n"
- if $self->debug > 3;
- setsockopt($self,$level+0,$what+0,$rval);
-}
-
-#& setsopt($this, [$level,] $what, @vals) : boolean
-sub setsopt
-{
- $_[0]->_trace(\@_,2);
- my($self,@args) = @_;
- $self->_setxopt(0,@args);
-}
-
-#& setropt($this, [$level,] $what, $realvalue) : boolean
-sub setropt
-{
- $_[0]->_trace(\@_,2);
- my($self,@args) = @_;
- $self->_setxopt(1,@args);
-}
-
-#& BINMODE($this)
-#+attrs locked method
-sub BINMODE
-{
- # Need to allow for PerlIO layers here
- @_ > 1 ? binmode($_[0], $_[1]) : 1;
-}
-
-#& FILENO($this) : {$int | undef}
-sub FILENO
-{
-# $_[0]->_trace(\@_,4);
- CORE::fileno($_[0]);
-}
-
-#& fileno($this) : {$int | undef}
-sub fileno
-{
-# $_[0]->_trace(\@_,4);
- CORE::fileno($_[0]);
-}
-
-#& getfh($this) : {$gvref | undef}
-sub getfh
-{
-# $_[0]->_trace(\@_,4);
- $_[0];
-}
-
-#& fhvec($this) : {$fhvec | undef}
-sub fhvec
-{
- $_[0]->_trace(\@_,4);
- my($self) = @_;
- return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
- $self->isopen and
- defined(CORE::fileno($self)); # return EBADF unless open
- $ {*$self}{FHVec}; # already setup by condition()
-}
-
-#& select($this [[, $read, $write, $xcept, $timeout]]) : $nready | @list
-#+attrs locked method
-sub select
-{
- $_[0]->_trace(\@_,4);
- my($self,$doread,$dowrite,$doxcept,$timer) = @_;
- my($fhvec,$rvec,$wvec,$xvec,$nfound,$timeleft) = $self->fhvec;
- return unless $fhvec;
- $rvec = $doread ? $fhvec : undef;
- $wvec = $dowrite ? $fhvec : undef;
- $xvec = $doxcept ? $fhvec : undef;
- $timer = 0 if $doread and defined($ {*$self}{sockLineBuf});
- ($nfound, $timeleft) = CORE::select($rvec, $wvec, $xvec, $timer)
- or return ();
- if (defined($ {*$self}{sockLineBuf}) && $doread && ($rvec ne $fhvec)) {
- $nfound++;
- $rvec |= $fhvec;
- }
- wantarray ?
- ($nfound, $timeleft,
- $doread && $rvec eq $fhvec,
- $dowrite && $wvec eq $fhvec,
- $doxcept && $xvec eq $fhvec)
- : $nfound;
-}
-
-#& ioctl($this, @args) : $scalar
-#+attrs locked method
-sub ioctl
-{
- my $whoami = $_[0]->_trace(\@_,4);
- croak "Insufficient arguments to ${whoami}(@_), found"
- if @_ < 3;
- carp "Excess arguments to ${whoami} ignored"
- if @_ > 3;
- CORE::ioctl($_[0], $_[1], $_[2]);
-}
-
-#& fcntl($this, @args) : $scalar
-#+attrs locked method
-sub fcntl
-{
- my $whoami = $_[0]->_trace(\@_,4);
- croak "Insufficient arguments to ${whoami}(@_), found"
- if @_ < 3;
- carp "Excess arguments to ${whoami} ignored"
- if @_ > 3;
- CORE::fcntl($_[0], $_[1], $_[2]);
-}
-
-#& format_addr($thunk, $sockaddr) : {$string | undef}
-sub format_addr
-{
- return undef unless defined $_[1];
- my($rval,$fam,$addr);
- ($fam,$addr) = unpack_sockaddr($_[1]) or return undef;
- $rval = "[${fam}]:";
- if (defined($addr) and length($addr)) {
- $rval .= "0x" . unpack('h*', $addr);
- }
- else {
- $rval .= "(null)";
- }
- $rval;
-}
-
-#& format_local_addr($this, [@args]) : {$string | undef}
-sub format_local_addr
-{
- my($self,@args) = @_;
- $self->format_addr($self->getparam('srcaddr'),@args);
-}
-
-#& format_remote_addr($this, [@args]) : {$string | undef}
-sub format_remote_addr
-{
- my($self,@args) = @_;
- $self->format_addr($self->getparam('dstaddr'),@args);
-}
-
-#& new_from_fh(classname, $filehandle) : {$obj | undef}
-sub new_from_fh
-{
- my $whoami = $_[0]->_trace(\@_,2);
- my($pack) = @_;
- if (@_ != 2) {
- croak "Invalid number of arguments to ${whoami}, called";
- }
- my ($fh,$rfh);
- eval {local $SIG{__DIE__}; local $SIG{__WARN__}; $fh=CORE::fileno($_[1])};
- unless(defined $fh) {
- if ($_[1] =~ /\D/ or !length($_[1])) {
- croak "Invalid filehandle '$_[1]' in ${whoami}, called";
- }
- $fh = 0 + $_[1];
- }
- my $self = $pack->new();
- return undef unless $self;
- unless (CORE::open($self, "+<&$fh")) {
- {
- local $!;
- undef $self;
- undef $self;
- }
- return $self;
- }
- $ {*$self}{'isopen'} = 1;
- $ {*$self}{'isconnected'} = 1 if getpeername($self);
- $rfh = getsockname($self);
- if (defined $rfh and length $rfh) {
- ($fh, $rfh) = unpack_sockaddr($rfh);
- $ {*$self}{AF} = $fh if defined $fh and length $fh and $fh ne '0';
- $ {*$self}{'isbound'} = defined $rfh and $rfh =~ /[^\0]/;
- }
- ($rfh) = $self->getsopt('SO_TYPE');
- $ {*$self}{type} = $rfh if defined $rfh;
- $self->getsockinfo;
- $self->isopen && $self;
-}
-
-#& accept($self) : {$new_obj | undef}
-sub accept
-{
- my $whoami = $_[0]->_trace(\@_,2);
- my($self) = @_;
- carp "Excess args to ${whoami}(@_) ignored" if @_ > 1;
- return undef unless $self->didlisten or $self->listen;
- my $ns = $self->new;
- return undef unless $ns;
- $ns->stopio; # make sure we can use the filehandle
- $ {*$ns}{Parms} = { %{$ {*$self}{Parms}} };
- $ns->checkparams;
- {
- my ($timeout,$fhvec,$saveblocking) =
- ($ {*$self}{Parms}{'timeout'}, $ {*$self}{FHVec});
- if (defined $timeout and $ {*$self}{Parms}{'blocking'}) {
- $saveblocking = $self->param_saver('blocking');
- $self->setparams({'blocking'=>0});
- my $nfound = CORE::select($fhvec, undef, undef, $timeout);
- }
- unless (CORE::accept($ns, $self)) {
- {
- local $!;
- undef $ns;
- undef $ns;
- }
- return $ns;
- }
- }
- $ {*$ns}{'isopen'} = $ {*$ns}{'isbound'} =
- $ {*$ns}{'isconnected'} = 1;
- $ns->getsockinfo;
- unless ($ns->isconnected) {
- {
- local $!;
- undef $ns;
- undef $ns;
- }
- return $ns;
- }
- $ns->condition;
- $ns;
-}
-
-#& RECV($self, $buf [,$maxlen] [,$flags]) : {$from | undef}
-sub RECV
-{
- my ($from,$buf);
- my $whoami = $_[0]->_trace(\@_,5);
- croak "Invalid arguments to ${whoami}, called"
- if @_ < 2 or @_ > 4 or !ref($_[0]);
- $buf = $_[0]->recv($_[2], $_[3], $from);
- return undef unless defined $buf;
- $_[1] = $buf;
- $from;
-}
-
-#& TIEHANDLE($class, $host, $port [,\%options]) : {$new_obj | undef}
-sub TIEHANDLE
-{ # redirects via $class->new(...)
- $_[0]->_trace(\@_,1);
- my $class = shift;
- my $self;
- if (ref $class and defined fileno($class)) {
- if ($class->isa(__PACKAGE__)) {
- $self = $class->new_from_fh(@_) || $class->new(@_);
- }
- else {
- $self = new_from_fh($class,@_) || new($class,@_);
- }
- }
- else {
- $self = $class->new(@_);
- $self && $self->isconnected && $self;
- }
-}
-
-#& PRINTF($self, $format [,@args]) : boolean
-sub PRINTF
-{
- $_[0]->_trace(\@_,5);
- my $self = shift;
- my $fmt = shift;
- local $\ = ''; # currently not per-file
- $self->PRINT(sprintf $fmt,@_);
-}
-
-#& READ($self, $buffer, $length [,$offset]) : {$lenread | undef}
-sub READ
-{
- my $whoami = $_[0]->_trace(\@_,5);
- croak "Invalid args to ${whoami}, called"
- if @_ < 3 or @_ > 4 or !ref($_[0]);
- my $len = $_[2]+0;
- croak "Negative buffer length in ${whoami}, called"
- if $len < 0;
- if (@_ > 3) {
- $_[3] += 0; # force offset to be numeric
- croak "Buffer offset outside buffer contents in ${whoami}, called"
- if ($_[3] < 0 and $_[3]+length($_[1]) < 0);
- }
- my $buf = $_[0]->recv($len, 0);
- $_[1] = '' unless defined $_[1];
- unless (defined $buf) {
- return undef if $!;
- return 0;
- }
- my $xbuf;
- $len -= length($buf);
- while ($len > 0) { # keep trying to fill the specified length
- $xbuf = $_[0]->recv($len, 0);
- last unless defined $xbuf;
- $buf .= $xbuf;
- $len -= length($xbuf);
- }
- if (@_ > 3) {
- substr($_[1], $_[3]) = $buf;
- }
- else {
- $_[1] = $buf;
- }
- length($buf);
-}
-
-#& GETC($self) : {$charstr | undef}
-sub GETC
-{
- my $whoami = $_[0]->_trace(\@_,6);
- carp "Excess arguments to ${whoami} ignored"
- if @_ > 1;
- $_[0]->recv(1,0);
-}
-
-#& READLINE($self) : {$line | undef || @lines}
-sub READLINE
-{
- return $_[0]->getline unless wantarray and defined($/);
- my $whoami = $_[0]->_trace(\@_,5);
- my $self = shift;
- my (@lines, $line);
- carp "Excess arguments to ${whoami} ignored" if @_;
- while (defined($line = $self->getline)) { push(@lines, $line) }
- @lines;
-}
-
-#& getlines($self) : @lines
-sub getlines
-{
- my $whoami = $_[0]->_trace(\@_,6);
- croak "Invalid call to $whoami" unless @_ == 1;
- croak "Not in list context calling $whoami" unless wantarray;
- $_[0]->READLINE;
-}
-
-
-#& sendto($self, $buf, $where, [$flags]) : boolean
-sub sendto
-{
- my $whoami = $_[0]->_trace(\@_,3);
- my($self,$buf,$whither,$flags) = @_;
- croak "Invalid args to ${whoami}, called"
- if @_ < 3 or !ref $self;
- $flags = 0 unless defined $flags;
- carp "Excess arguments to ${whoami} ignored" if @_ > 4;
- return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
- $self->isopen or $self->open; # generate EBADF return if not open
- if ($ {*$self}{Parms}{netgen_fakeconnect}) {
- return $self->send($buf,$flags,$whither);
- }
- CORE::send($self, $buf, $flags, $whither);
-}
-
-#& EOF($self) : boolean
-sub EOF
-{
- my $whoami = $_[0]->_trace(\@_,3);
- my ($self,$buf) = @_;
- croak "Invalid args to ${whoami}, called" if @_ != 1 or !ref $self;
- return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
- $self->isopen; # generate EBADF return if not open
- return 0 if defined $ {*$self}{sockLineBuf}; # not EOF if can read
- my $fhvec = $ {*$self}{FHVec};
- my $nfound = CORE::select($fhvec, undef, undef, 0);
- return 0 unless $nfound;
- $buf = $self->recv;
- return 1 if ! $! and !defined $buf;
- $ {*$self}{sockLineBuf} = $buf;
- 0;
-}
-
-#& WRITE($self,$buffer,$len[,$offset]) : {$length | undef}
-sub WRITE
-{
- my $whoami = $_[0]->_trace(\@_,3);
- my ($self,$buf,$len,$offset,$blen) = @_;
- croak "Invalid args to ${whoami}, called" if @_ < 2 or @_ > 4 or
- !ref $self;
- $offset = 0 if @_ == 3;
- $blen = length $buf;
- $len = $blen unless defined $len;
- if ($offset < 0) {
- $offset += $blen;
- croak "Offset outside of string in ${whoami}, called" if
- $offset < 0;
- }
- croak "Offset outside of string in ${whoami}, called" if
- $offset > $blen;
- return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
- $self->isopen; # generate EBADF return if not open
- $len = $blen - $offset if $len > $blen - $offset;
- syswrite($self, $buf, $len, $offset);
-}
@@ -1,4 +1,4 @@
-# Copyright 1995,2002 Spider Boardman.
+# Copyright 1995,1999 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -11,11 +11,9 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-# rcsid: "@(#) $Id: Gen.dat,v 1.44 2002/04/10 11:27:18 spider Exp $"
-
package Net::Gen;
-use 5.004_04; # new minimum Perl version for this package
+use 5.004_05; # new minimum Perl version for this package
use strict;
#use Carp; # no! just require Carp when we want to croak.
@@ -23,12 +21,12 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
%_missing $AUTOLOAD $adebug);
BEGIN {
- $VERSION = '1.011';
- eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
+ $VERSION = '0.91';
}
-#use Socket qw(!/pack_sockaddr/ !/^MSG_OOB$/ !SOMAXCONN);
-use Socket ();
+sub Version () { __PACKAGE__ . " v$VERSION" }
+
+use Socket qw(!/pack_sockaddr/ !/^MSG_OOB$/ !SOMAXCONN);
use AutoLoader;
use Exporter ();
use DynaLoader ();
@@ -51,6 +49,7 @@ BEGIN {
VAL_EAGAIN
RD_NODATA
EOF_NONBLOCK
+ SOMAXCONN
EINPROGRESS EALREADY ENOTSOCK EDESTADDRREQ
EMSGSIZE EPROTOTYPE ENOPROTOOPT EPROTONOSUPPORT
ESOCKTNOSUPPORT EOPNOTSUPP EPFNOSUPPORT EAFNOSUPPORT
@@ -62,24 +61,6 @@ BEGIN {
EAGAIN EWOULDBLOCK
ENOENT EINVAL EBADF
SHUT_RD SHUT_WR SHUT_RDWR
- SOL_SOCKET
- SOMAXCONN
- SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTROUTE
- SO_ERROR SO_EXPANDED_RIGHTS SO_FAMILY SO_KEEPALIVE
- SO_LINGER SO_OOBINLINE SO_PAIRABLE SO_RCVBUF
- SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
- SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_STATE SO_TYPE
- SO_USELOOPBACK SO_XSE
- SOCK_STREAM SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET
- AF_UNSPEC AF_UNIX AF_INET AF_IMPLINK AF_PUP AF_CHAOS
- AF_NS AF_ISO AF_OSI AF_ECMA AF_DATAKIT AF_CCITT AF_SNA
- AF_DECnet AF_DLI AF_LAT AF_HYLINK AF_APPLETALK AF_ROUTE
- AF_LINK AF_NETMAN AF_X25 AF_CTF AF_WAN AF_USER AF_LAST
- PF_UNSPEC PF_UNIX PF_INET PF_IMPLINK PF_PUP PF_CHAOS
- PF_NS PF_ISO PF_OSI PF_ECMA PF_DATAKIT PF_CCITT PF_SNA
- PF_DECnet PF_DLI PF_LAT PF_HYLINK PF_APPLETALK PF_ROUTE
- PF_LINK PF_NETMAN PF_X25 PF_CTF PF_WAN PF_USER PF_LAST
- AF_LOCAL PF_LOCAL
);
%EXPORT_TAGS = (
@@ -97,58 +78,18 @@ BEGIN {
ENOENT EINVAL EBADF
)],
shutflags => [qw(SHUT_RD SHUT_WR SHUT_RDWR)],
- sockopts => [qw(SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTROUTE
- SO_ERROR SO_EXPANDED_RIGHTS SO_FAMILY SO_KEEPALIVE
- SO_LINGER SO_OOBINLINE SO_PAIRABLE SO_RCVBUF
- SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
- SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_STATE SO_TYPE
- SO_USELOOPBACK SO_XSE
- )],
- sockvals => [qw(SOL_SOCKET
- SOCK_STREAM SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET
- )],
- af => [qw(AF_UNSPEC AF_UNIX AF_INET AF_IMPLINK AF_PUP AF_CHAOS
- AF_NS AF_ISO AF_OSI AF_ECMA AF_DATAKIT AF_CCITT AF_SNA
- AF_DECnet AF_DLI AF_LAT AF_HYLINK AF_APPLETALK AF_ROUTE
- AF_LINK AF_NETMAN AF_X25 AF_CTF AF_WAN AF_USER AF_LAST
- AF_LOCAL
- )],
- pf => [qw(PF_UNSPEC PF_UNIX PF_INET PF_IMPLINK PF_PUP PF_CHAOS
- PF_NS PF_ISO PF_OSI PF_ECMA PF_DATAKIT PF_CCITT PF_SNA
- PF_DECnet PF_DLI PF_LAT PF_HYLINK PF_APPLETALK PF_ROUTE
- PF_LINK PF_NETMAN PF_X25 PF_CTF PF_WAN PF_USER PF_LAST
- PF_LOCAL
- )],
ALL => [@EXPORT, @EXPORT_OK],
);
- $EXPORT_TAGS{'non_block_vals'} = $EXPORT_TAGS{'NonBlockVals'};
- $EXPORT_TAGS{'families'} = [@{$EXPORT_TAGS{'af'}}, @{$EXPORT_TAGS{'pf'}}];
}
my %loaded;
-
-# dummies for the Carp:: routines, which we'll re-invoke if we get called.
-
-sub croak
-{
- require Carp;
- goto &Carp::croak;
-}
-
-sub carp
-{
- require Carp;
- goto &Carp::carp;
-}
-
-
my $nullsub = sub {}; # handy null warning handler
# If the warning handler is this exact code ref, don't bother calling
# croak in the AUTOLOAD constant section, since we're being called from
# inside the eval in initsockopts().
-sub AUTOLOAD : locked
+sub AUTOLOAD
{
# This AUTOLOAD is used to validate possible missing constants from
# the XS code, or to auto-create get/setattr subs.
@@ -161,7 +102,7 @@ sub AUTOLOAD : locked
# as a key for setparams/getparams, it will be simulated via _accessor().
# Otherwise, control will be passed to the AUTOLOAD in AutoLoader.
-# use attrs 'locked'; # modifies the symbol table and abuses a global
+ use attrs 'locked';
my ($constname,$callpkg);
{ # block to preserve $1,$2,et al.
@@ -171,9 +112,10 @@ sub AUTOLOAD : locked
my $wh = $SIG{__WARN__};
die "\n"
if ($wh and (ref($wh) eq 'CODE') and $wh == $nullsub);
- croak "Your vendor has not defined $callpkg macro $constname, used";
+ require Carp;
+ Carp::croak "Your vendor has not defined $callpkg macro $constname, used";
}
- if (@_ && ref $_[0] && @_ < 3 && exists $ {*{$_[0]}}{Keys}{$constname}) {
+ if (@_ && ref $_[0] && @_ < 3 && exists ${*{$_[0]}}{Keys}{$constname}) {
no strict 'refs'; # allow us to define the sub
my $what = $constname; # don't tie up $constname for closures
warn "Auto-generating accessor $AUTOLOAD\n" if $adebug;
@@ -197,11 +139,24 @@ BEGIN {
# Preloaded methods go here. Autoload methods go after __END__, and are
# processed by the autosplit program.
+# dummies for the Carp:: routines, which we'll re-invoke if we get called.
+
+sub croak
+{
+ require Carp;
+ goto &Carp::croak;
+}
+
+sub carp
+{
+ require Carp;
+ goto &Carp::carp;
+}
+
# This package has the core 'generic' routines for fiddling with
# sockets.
-
# initsockopts - Set up the socket options of a class using this module.
# The structure of a sockopt hash is like this:
# %sockopts = ( OPTION => ['pack_string', $option_number, $option_level,
@@ -216,9 +171,9 @@ BEGIN {
my %evalopts; # avoid compiling an eval per sockopt
-#& initsockopts($class, $level+0, \%sockopts) : void
-sub initsockopts : locked
+sub initsockopts # $class, $level+0, \%sockopts
{
+ use attrs 'locked';
my ($class,$level,$opts) = @_;
croak "Invalid arguments to " . __PACKAGE__ . "::initsockopts, called"
if @_ != 3 or ref $opts ne 'HASH';
@@ -227,13 +182,11 @@ sub initsockopts : locked
my $nullwarn = $nullsub; # a handy __WARN__ handler
# The above has to be there, since the file-scope 'my' won't be seen
# in the generated closure.
- $class = ref $class if ref $class;
$evalopts{$class} ||= eval "package $class; no strict 'refs';" .
'sub ($) {local($SIG{__WARN__})=$nullwarn;local($SIG{__DIE__});' .
'&{$_[0]}()}';
$esub = $evalopts{$class};
foreach $opt (keys %$opts) {
- delete $$opts{$opt}, next if exists $_missing{"${class}::$opt"};
$oval = eval {&$esub($opt)};
delete $$opts{$opt}, next if $@ or !defined($oval) or $oval eq '';
$oval += 0; # force numeric
@@ -258,14 +211,10 @@ my %sockopts;
'SO_DEBUG' => [ 'I' ],
'SO_DONTROUTE' => [ 'I' ],
'SO_ERROR' => [ 'I' ],
- 'SO_EXPANDED_RIGHTS' => [ 'I' ],
'SO_KEEPALIVE' => [ 'I' ],
'SO_OOBINLINE' => [ 'I' ],
- 'SO_PAIRABLE' => [ 'I' ],
'SO_REUSEADDR' => [ 'I' ],
- 'SO_REUSEPORT' => [ 'I' ],
'SO_USELOOPBACK' => [ 'I' ],
- 'SO_XSE' => [ 'I' ],
# Simple integer options
@@ -276,8 +225,6 @@ my %sockopts;
'SO_RCVLOWAT' => [ 'I' ],
'SO_SNDLOWAT' => [ 'I' ],
'SO_TYPE' => [ 'I' ],
- 'SO_STATE' => [ 'I' ],
- 'SO_FAMILY' => [ 'I' ],
# Finally, one which is a struct
@@ -289,8 +236,7 @@ my %sockopts;
__PACKAGE__->initsockopts( SOL_SOCKET(), \%sockopts );
-#& _genfh() : returns orphan globref with HV slot.
-sub _genfh ()
+sub _genfh () # (void), returns orphan globref with HV slot.
{
my $rval = gensym;
*{$rval} = {}; # initialise a hash slot
@@ -301,10 +247,9 @@ my $debug = 0; # module-wide debug hack -- don't use
# On the other hand, per-object debugging isn't so bad....
-# can update $debug file variable
-#& _debug($this [, $newval]) : oldval
-sub _debug : locked
+sub _debug # $this [, $newval] ; returns oldval
{
+ use attrs 'locked';
my ($this,$newval) = @_;
return $this->debug($newval) if ref $this;
# class method here
@@ -313,17 +258,16 @@ sub _debug : locked
$oldval;
}
-#& debug($self [, $newval]) : oldval
-sub debug : locked method
+sub debug # $self [, $newval] ; returns oldval
{
+ use attrs 'locked', 'method';
my ($self,$newval) = @_;
- my $oldval = $ {*$self}{Parms}{'debug'} if defined wantarray;
+ my $oldval = ${*$self}{Parms}{'debug'} if defined wantarray;
$self->setparams({'debug'=>$newval}) if defined $newval;
$oldval;
}
-#& _trace($this, \@args, minlevel, [$moretext]) : void
-sub _trace
+sub _trace # $this , \@args, minlevel, [$moretext]
{
my ($this,$aref,$level,$msg) = @_;
my $rtn = (caller(1))[3];
@@ -334,8 +278,7 @@ sub _trace
${rtn};
}
-#& _setdebug($self, $name, $newval) : {'' | "carp string"}
-sub _setdebug
+sub _setdebug # $self, $name, $newval
{
my ($self,$what,$val) = @_;
return '' unless defined $val;
@@ -352,9 +295,9 @@ my ($F_GETFL,$F_SETFL) =
my $nonblock_flag = eval 'pack("I",VAL_O_NONBLOCK)';
my $eagain = eval 'VAL_EAGAIN';
-#& _accessor($self, $what [, $newval]) : oldvalue
-sub _accessor : locked method
+sub _accessor # $self, $what [, $newval] ; returns oldvalue
{
+ use attrs 'locked', 'method';
my ($self, $what, $newval) = @_;
croak "Usage: \$sock->$what or \$sock->$what(\$newvalue),"
if @_ > 3;
@@ -363,23 +306,19 @@ sub _accessor : locked method
$oldval;
}
-#& _setblocking($self, $name, $newval) : {'' | "carp string"}
-sub _setblocking
+sub _setblocking # $self, $name, $newval
{
my ($self,$what,$newval) = @_;
$newval = 1 unless defined $newval;
# default previous value, just in case
- $ {*$self}{Parms}{$what} = 1 unless
- defined $ {*$self}{Parms}{$what};
+ ${*$self}{Parms}{$what} = 1 unless defined ${*$self}{Parms}{$what};
if ($newval) {
$_[2] = 1; # canonicalise the new value
- if (defined $F_GETFL and defined $F_SETFL and
- defined $nonblock_flag and $self->isopen)
- {
+ if (defined $F_GETFL and defined $F_SETFL and defined $nonblock_flag
+ and $self->isopen) {
if ((CORE::fcntl($self, $F_GETFL, 0) & VAL_O_NONBLOCK) ==
- VAL_O_NONBLOCK)
- {
- $ {*$self}{Parms}{$what} = 0; # note previous status
+ VAL_O_NONBLOCK) {
+ ${*$self}{Parms}{$what} = 0; # note previous status
return 'Failed to clear non-blocking status'
unless eval {CORE::fcntl($self, $F_SETFL,
CORE::fcntl($self, $F_GETFL, 0) &
@@ -390,15 +329,13 @@ sub _setblocking
else {
$_[2] = 0; # canonicalise the new value
unless (defined $F_GETFL and defined $F_SETFL and
- defined $nonblock_flag)
- {
+ defined $nonblock_flag) {
return 'Non-blocking sockets unavailable in this configuration';
}
if ($self->isopen) {
if ((CORE::fcntl($self, $F_GETFL, 0) & VAL_O_NONBLOCK) !=
- VAL_O_NONBLOCK)
- {
- $ {*$self}{Parms}{$what} = 1; # note previous state
+ VAL_O_NONBLOCK) {
+ ${*$self}{Parms}{$what} = 1; # note previous state
return 'Failed to set non-blocking status'
unless eval {CORE::fcntl($self, $F_SETFL,
CORE::fcntl($self, $F_GETFL, 0) |
@@ -409,9 +346,9 @@ sub _setblocking
''; # return goodness if got this far
}
-#& blocking($self [, $newval]) : canonical_oldval
-sub blocking : locked method
+sub blocking # $self [, $newval] ; returns canonical oldval
{
+ use attrs 'locked', 'method';
my ($self, $newval) = @_;
croak 'Usage: $sock->blocking or $sock->blocking(0|1),'
if @_ > 2;
@@ -420,8 +357,7 @@ sub blocking : locked method
$oldval;
}
-#& _settimeout($self, $what, $newval) : {'' | "carp string"}
-sub _settimeout
+sub _settimeout # $self, $what, $newval
{
my ($self,$what,$newval) = @_;
unless (defined $newval) {
@@ -436,7 +372,7 @@ sub _settimeout
}
my @Keys = qw(PF AF type proto dstaddr dstaddrlist srcaddr srcaddrlist
- maxqueue reuseaddr netgen_fakeconnect reuseport);
+ maxqueue reuseaddr);
my %Codekeys = (
'debug' => \&_setdebug,
'blocking' => \&_setblocking,
@@ -448,25 +384,22 @@ my %Keys;
# This hash remembers the original socket option settings after the first time.
my %Opts;
-#& register_param_keys($self, \@keys)
-sub register_param_keys : locked method
+sub registerParamKeys # $self, \@keys
{
+ use attrs 'locked', 'method';
my ($self, $names) = @_;
my $whoami = $self->_trace(\@_,3);
croak "Invalid arguments to ${whoami}(@_), called"
if @_ != 2 or ref $names ne 'ARRAY';
- @{$ {*$self}{Keys}}{@$names} =
- @{$ {*$self}{Keys}}{@$names}; # remember the names
- # this form doesn't clobber pre-existing register_param_handlers values
+ @{${*$self}{Keys}}{@$names} = (); # remember the names
}
-sub registerParamKeys; # helps with -w
-*registerParamKeys = \®ister_param_keys; # alias form preferred by many
+sub register_param_keys; # helps with -w
+*register_param_keys = \®isterParamKeys; # alias form preferred by many
-#& register_param_handlers($self, \@keys, [\]@handlers)
-#& -or- ($self, \%key-handlers)
-sub register_param_handlers : locked method
-{
+sub registerParamHandlers # $self, \@keys, [\]@handlers
+{ # -or- $self, \%key-handlers
+ use attrs 'locked', 'method';
my ($self, $names, @handlers, $handlers) = @_;
my $whoami = $self->_trace(\@_,3);
if (ref $names eq 'HASH') {
@@ -484,54 +417,51 @@ sub register_param_handlers : locked method
croak "Invalid handlers in ${whoami}(@_), called"
if @$handlers != @$names or grep(ref $_ ne 'CODE', @$handlers);
# finally, all is validated, so set the bloody things
- @{$ {*$self}{Keys}}{@$names} = @$handlers;
+ @{${*$self}{Keys}}{@$names} = @$handlers;
}
-sub registerParamHandlers; # helps with -w
-*registerParamHandlers = \®ister_param_handlers; # alias other form
+sub register_param_handlers; # helps with -w
+*register_param_handlers = \®isterParamHandlers; # alias other form
-#& register_options($self, $levelname, $level, \%options)
-sub register_options : locked method
+sub registerOptions # $self, $levelname, $level, \%options
{
+ use attrs 'locked', 'method';
my ($self, $levname, $level, $opts) = @_;
my $whoami = $self->_trace(\@_,3);
croak "Invalid arguments to ${whoami}(@_), called"
if ref $opts ne 'HASH';
- $ {*$self}{Sockopts}{$levname} = $opts;
- $ {*$self}{Sockopts}{$level+0} = $opts;
+ ${*$self}{Sockopts}{$levname} = $opts;
+ ${*$self}{Sockopts}{$level+0} = $opts;
}
-sub registerOptions; # helps with -w
-*registerOptions = \®ister_options; # alias form preferred by many
+sub register_options; # helps with -w
+*register_options = \®isterOptions; # alias form preferred by many
# pseudo-subclass for saving parameters (ParamSaver, inspired by SelectSaver)
-#& param_saver($self, @params) : restoration_object
-sub param_saver : locked method
+sub paramSaver # $self, @params
{
+ use attrs 'locked', 'method';
my ($self, @params) = @_;
- my @delparams =
- # map { exists $ {*$self}{Parms}{$_} ? () : ($_) } @params;
- grep {!exists $ {*$self}{Parms}{$_}} @params;
my %setparams = $self->getparams(\@params);
+ my @delparams = map { exists ${*$self}{Parms}{$_} ? () : ($_) } @params;
bless [$self, \%setparams, \@delparams], 'Net::Gen::ParamSaver';
}
-sub paramSaver; # aliases
-*paramSaver = \¶m_saver;
+sub param_saver; # aliases
+*param_saver = \¶mSaver;
sub ParamSaver;
-*ParamSaver = \¶m_saver;
+*ParamSaver = \¶mSaver;
sub Net::Gen::ParamSaver::DESTROY
{
+ use attrs 'locked';
local $!; # just to be sure we don't clobber it
$_[0]->[0]->setparams($_[0]->[1]);
$_[0]->[0]->delparams($_[0]->[2]);
}
-#& new(classname [, \%params]) : {$self | undef}
-#& -or- $classname [, @ignored]
-sub new
-{
+sub new # classname [, \%params]
+{ # -or- $classname [, @ignored]
my $whoami = $_[0]->_trace(\@_,1);
my($pack,$parms) = @_;
my %parms;
@@ -541,23 +471,23 @@ sub new
if (@_ > 2 and $parms and ref $parms eq 'HASH') {
croak "Invalid argument format to ${whoami}(@_), called";
}
- my $class = ref $pack || $pack;
+ $pack = ref $pack if ref $pack;
my $self = _genfh;
- bless $self,$class;
+ bless $self,$pack;
$pack->_trace(\@_,2,", self=$self after bless");
- $ {*$self}{Parms} = \%parms;
+ ${*$self}{Parms} = \%parms;
if (%Keys) {
- $ {*$self}{Keys} = { %Keys };
- $ {*$self}{Sockopts} = { %Opts };
+ ${*$self}{Keys} = { %Keys };
+ ${*$self}{Sockopts} = { %Opts };
}
else {
- $self->register_param_keys(\@Keys); # register our keys
- $self->register_param_handlers(\%Codekeys);
- $self->register_options('SOL_SOCKET', SOL_SOCKET(), \%sockopts);
- %Keys = %{$ {*$self}{Keys}};
- %Opts = %{$ {*$self}{Sockopts}};
+ $self->registerParamKeys(\@Keys); # register our keys
+ $self->registerParamHandlers(\%Codekeys);
+ $self->registerOptions('SOL_SOCKET', SOL_SOCKET(), \%sockopts);
+ %Keys = %{${*$self}{Keys}};
+ %Opts = %{${*$self}{Sockopts}};
}
- if ($class eq __PACKAGE__) {
+ if ($pack eq __PACKAGE__) {
unless ($self->init) {
local $!; # preserve errno
undef $self; # against the side-effects of this
@@ -575,9 +505,9 @@ sub new
$self;
}
-#& setparams($this, \%newparams [, $newonly [, $check]]) : boolean
-sub setparams : locked method
+sub setparams # $this, \%newparams [, $newonly [, $check]]
{
+ use attrs 'locked', 'method';
my ($self,$newparams,$newonly,$check) = @_;
my $errs = 0;
@@ -587,108 +517,104 @@ sub setparams : locked method
if @_ > 4;
$newonly ||= 0; # undefined or zero is equiv now (-w problem)
- my ($parm,$newval,$pslot);
+ my ($parm,$newval);
while (($parm,$newval) = each %$newparams) {
print STDERR __PACKAGE__ . "::setparams $self $parm" .
(defined $newval ? " $newval" : "") . "\n"
if $self->debug;
(carp "Unknown parameter type $parm for a " . (ref $self) . " object")
, $errs++, next
- unless exists $ {*$self}{Keys}{$parm};
- $pslot = \$ {*$self}{Parms}{$parm};
- next if $newonly < 0 && defined $$pslot;
+ unless exists ${*$self}{Keys}{$parm};
+ next if $newonly < 0 && defined ${*$self}{Parms}{$parm};
if (!$check)
{
# this ungodly construct brought to you by -w
next if
- defined($$pslot) eq defined($newval)
+ defined(${*$self}{Parms}{$parm}) eq defined($newval)
and
!defined($newval) ||
- $$pslot eq $newval ||
- $$pslot !~ /\D/ &&
+ ${*$self}{Parms}{$parm} eq $newval ||
+ ${*$self}{Parms}{$parm} !~ /\D/ &&
$newval !~ /\D/ &&
length($newval) &&
- length($$pslot) &&
- $$pslot == $newval
+ length(${*$self}{Parms}{$parm}) &&
+ ${*$self}{Parms}{$parm} == $newval
;
}
carp("Overwrite of $parm parameter for ".(ref $self)." object ignored")
, $errs++, next
- if $newonly > 0 && defined $$pslot;
- if (defined($ {*$self}{Keys}{$parm}) and
- (ref($ {*$self}{Keys}{$parm}) eq 'CODE'))
- {
- my $rval = &{$ {*$self}{Keys}{$parm}}($self,$parm,$newval);
+ if $newonly > 0 && defined ${*$self}{Parms}{$parm};
+ if (defined(${*$self}{Keys}{$parm}) and
+ (ref(${*$self}{Keys}{$parm}) eq 'CODE')) {
+ my $rval = &{${*$self}{Keys}{$parm}}($self,$parm,$newval);
(carp $rval), $errs++, next if $rval;
}
- # not using $$pslot here in case {Parms} hash re-generated
- $ {*$self}{Parms}{$parm} = $newval;
+ ${*$self}{Parms}{$parm} = $newval;
}
$errs ? undef : 1;
}
-#& delparams($self, \@paramnames) : boolean
-sub delparams : locked method
+sub delparams # $self, \@paramnames ; returns bool
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,1);
my($self,$keysref) = @_;
my(@k,%k);
- @k = grep(exists $ {*$self}{Parms}{$_}, @$keysref);
+ @k = grep(exists ${*$self}{Parms}{$_}, @$keysref);
return 1 unless @k; # if no keys need deleting, succeed vacuously
@k{@k} = (); # a hash of undefs for the following
return undef unless $self->setparams(\%k); # see whether undef is allowed
- delete @{$ {*$self}{Parms}}{@k};
+ delete @{${*$self}{Parms}}{@k};
1; # return goodness
}
-#& checkparams($self) : boolean
-sub checkparams : locked method
+sub checkparams # $self, (void) ; returns bool
{
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,1);
my $self = shift;
carp "Excess arguments to ${whoami} ignored"
if @_;
- my $curparms = $ {*$self}{Parms};
+ my $curparms = ${*$self}{Parms};
$curparms = {} unless ref $curparms eq 'HASH';
# make sure only the valid ones are set when we're done
- $ {*$self}{Parms} = {};
- my(@valkeys) = grep(exists $ {*$self}{Keys}{$_}, keys %$curparms);
+ ${*$self}{Parms} = {};
+ my(@valkeys) = grep(exists ${*$self}{Keys}{$_}, keys %$curparms);
# this assignment allows for inter-key dependencies to be evaluated
- @{$ {*$self}{Parms}}{@valkeys} =
+ @{${*$self}{Parms}}{@valkeys} =
@{$curparms}{@valkeys};
# validate all current against the defined keys
$self->setparams($curparms, 0, 1);
}
-#& init($self) : {$self | undef}
-sub init
+sub init # $self, (void) ; returns updated $self
{
$_[0]->_trace(\@_,1);
my($self) = @_;
$self->checkparams ? $self : undef;
}
-#& getparam($self, $key [, $default [, $defaultifundef]]) : param_value
-sub getparam : locked method
+sub getparam # $self, $key [, $default [, $defaultifundef]]
{
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,2);
my($self,$key,$defval,$noundef) = @_;
carp "Excess arguments to ${whoami}($self) ignored"
if @_ > 4;
if ($noundef) {
- return $defval unless defined($ {*$self}{Parms}{$key});
+ return $defval unless defined(${*$self}{Parms}{$key});
}
else {
- return $defval unless exists($ {*$self}{Parms}{$key});
+ return $defval unless exists(${*$self}{Parms}{$key});
}
- $ {*$self}{Parms}{$key};
+ ${*$self}{Parms}{$key};
}
-#& getparams($self, \@keys [, $noundef]) : (%hash)
-sub getparams : locked method
+sub getparams # $self, \@keys [, $noundef]; returns (%hash)
{
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,2);
my ($self,$aref,$noundef) = @_;
croak "Insufficient arguments to ${whoami}($self), called"
@@ -699,14 +625,14 @@ sub getparams : locked method
if (wantarray) {
# the actual list is wanted -- see which way to do it
if ($noundef) {
- map {defined $ {*$self}{Parms}{$_} ?
- ($_, $ {*$self}{Parms}{$_}) :
+ map {defined ${*$self}{Parms}{$_} ?
+ ($_, ${*$self}{Parms}{$_}) :
()
} @$aref;
}
else {
- map {exists $ {*$self}{Parms}{$_} ?
- ($_, $ {*$self}{Parms}{$_}) :
+ map {exists ${*$self}{Parms}{$_} ?
+ ($_, ${*$self}{Parms}{$_}) :
()
} @$aref;
}
@@ -714,42 +640,42 @@ sub getparams : locked method
else {
# the list count is wanted -- see which way to do it
if ($noundef) {
- 2 * grep {defined $ {*$self}{Parms}{$_}} @$aref;
+ 2 * grep {defined ${*$self}{Parms}{$_}} @$aref;
}
else {
- 2 * grep {exists $ {*$self}{Parms}{$_}} @$aref;
+ 2 * grep {exists ${*$self}{Parms}{$_}} @$aref;
}
}
# my @ret;
# foreach (@$aref) {
-# push(@ret, $_, $ {*$self}{Parms}{$_})
-# if exists($ {*$self}{Parms}{$_}) and
-# !$noundef || defined($ {*$self}{Parms}{$_});
+# push(@ret, $_, ${*$self}{Parms}{$_})
+# if exists(${*$self}{Parms}{$_}) and
+# !$noundef || defined(${*$self}{Parms}{$_});
# }
# wantarray ? @ret : 0+@ret;
}
-#& condition($self)
-sub condition : locked method
+sub condition # $self ; return not useful
{
+ use attrs 'locked', 'method';
my $self = $_[0];
my $sel = SelectSaver->new;
CORE::select($self);
$| = 1;
# $\ = "\015\012";
binmode($self);
- vec($ {*$self}{FHVec} = '', CORE::fileno($self), 1) = 1;
+ vec(${*$self}{FHVec} = '', CORE::fileno($self), 1) = 1;
$self->setparams({'blocking'=>$self->getparam('blocking',1,1)},0,1);
}
-#& open($self [, @ignore]) : boolean
-sub open : locked method
+sub open # $self [, @ignore] ; returns boolean
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,2);
my $self = shift;
$self->stopio if $self->isopen;
- my($pf,$af,$type,$proto) = \@{$ {*$self}{Parms}}{qw(PF AF type proto)};
+ my($pf,$af,$type,$proto) = \@{${*$self}{Parms}}{qw(PF AF type proto)};
$$pf = PF_UNSPEC unless defined $$pf;
$$af = AF_UNSPEC unless defined $$af;
$$type = 0 unless defined $$type;
@@ -760,7 +686,7 @@ sub open : locked method
elsif (($$af == AF_UNSPEC) && ($$pf != PF_UNSPEC)) {
$$af = $$pf;
}
- if ($ {*$self}{'isopen'} = socket($self,$$pf,$$type,$$proto)) {
+ if (${*$self}{'isopen'} = socket($self,$$pf,$$type,$$proto)) {
# keep stdio output buffers out of my way
$self->condition;
}
@@ -773,19 +699,18 @@ sub open : locked method
my %connok = ( EISCONN,1 );
my %connip = ( EWOULDBLOCK,1 , EINPROGRESS,1 , EAGAIN,1 , EALREADY,1 );
-#& _valconnect($self, $addr, $timeout) : boolean
-sub _valconnect
+sub _valconnect # $self, $addr, $timeout ; returns boolean
{
my ($self,$addr,$timeout) = @_;
- my ($fhvec,$rdvec,$wrvec,$nfound) = $ {*$self}{FHVec};
+ my ($fhvec,$rdvec,$wrvec,$nfound) = ${*$self}{FHVec};
# don't block if socket is non-blocking
$timeout = 0 if
- !defined $timeout && !$ {*$self}{Parms}{'blocking'};
+ !defined $timeout && !${*$self}{Parms}{'blocking'};
# assume caller checked for ->isconnecting
$rdvec = $wrvec = $fhvec;
$nfound = CORE::select($rdvec, $wrvec, undef, $timeout);
# If socket is 'ready', then the connect is complete (possibly failed).
- $ {*$self}{'isconnecting'} = 0 if $nfound;
+ ${*$self}{'isconnecting'} = 0 if $nfound;
# If we don't think the connect has finished, just try to invent a
# reasonable error and bug out.
if (!$nfound) {
@@ -795,7 +720,7 @@ sub _valconnect
my $rval;
# If we can try to find out with SO_ERROR, give it a shot.
# This won't give valid results with SOCKS. Tough.
- if ($ {*$self}{Sockopts}{'SOL_SOCKET'}{'SO_ERROR'}) {
+ if (${*$self}{Sockopts}{'SOL_SOCKET'}{'SO_ERROR'}) {
# Don't try the getsockopt if the connect is still pending!
# Solaris 2.5.1 (at least) hangs the getsockopt in that case.
# The connect is complete -- figure out whether we believe
@@ -815,7 +740,7 @@ sub _valconnect
# we can't use that unless we have a stream socket. SOCK_SEQPACKET and
# real datagram services would lose their initial transmission to a
# read check. So, we try it here only if we think we are SOCK_STREAM.
- my $type = $ {*$self}{Parms}{'type'};
+ my $type = ${*$self}{Parms}{'type'};
if ($type && $type==SOCK_STREAM) {
my $buf = "";
$rval = sysread($self,$buf,0);
@@ -830,16 +755,15 @@ sub _valconnect
$rval;
}
-#& _tryconnect($self, $addr, $timeout) : boolean
-sub _tryconnect
+sub _tryconnect # $self, $addr, $timeout ; returns boolean
{
my ($self,$addr,$timeout) = @_;
- if ($ {*$self}{'isconnecting'}) {
- if ($ {*$self}{Parms}{'dstaddr'} and
- ($ {*$self}{Parms}{'dstaddr'} ne $addr))
+ if (${*$self}{'isconnecting'}) {
+ if (${*$self}{Parms}{'dstaddr'} and
+ (${*$self}{Parms}{'dstaddr'} ne $addr))
{
carp "$self->_tryconnect: different destination address while ->isconnecting!"
- if $ {*$self}{Parms}{'debug'} > 2;
+ if ${*$self}{Parms}{'debug'} > 2;
$self->stopio;
return undef unless $self->open;
if ($self->getparam('srcaddr') || $self->getparam('srcaddrlist')
@@ -853,31 +777,21 @@ sub _tryconnect
# So, if we're retrying a non-blocking connect, check by other means
# before trying to use a second connect to get the status.
# Warning: This will not work with SOCKS.
- unless ($ {*$self}{'isconnecting'}) {
- # For Solaris, if datagram socket, don't connect if not bound.
- if ($ {*$self}{Parms}{netgen_fakeconnect}) {
- if (!$self->isbound) {
- $ {*$self}{Parms}{'dstaddr'} = $addr;
- return 1;
- }
- else {
- $self->delparams(['netgen_fakeconnect']);
- }
- }
+ unless (${*$self}{'isconnecting'}) {
my $rval = CORE::connect($self,$addr);
return $rval if $rval;
return 1 if $connok{0+$!};
return $rval unless $connip{0+$!};
- $ {*$self}{'isconnecting'} = 1;
- $ {*$self}{Parms}{'dstaddr'} = $addr;
+ ${*$self}{'isconnecting'} = 1;
+ ${*$self}{Parms}{'dstaddr'} = $addr;
return $rval unless defined $timeout;
}
&_valconnect;
}
-#& connect($self, [@ignored]) : boolean
-sub connect : locked method
+sub connect # $self, [@ignored] ; returns boolean
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,2);
my $self = shift;
my $hval = *$self{HASH};
@@ -928,9 +842,9 @@ sub connect : locked method
$self->isconnected;
}
-#& getsockinfo($self, [@ignored]) : ?dest sockaddr?
-sub getsockinfo : locked method
+sub getsockinfo # $self, [@ignored] ; returns ?dest sockaddr?
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,4);
my $self = shift;
my ($sad,$dad);
@@ -948,9 +862,9 @@ sub getsockinfo : locked method
my %to_shut_flags = (SHUT_RD,1, SHUT_WR,2, SHUT_RDWR,3);
-#& shutdown($self [, $how=SHUT_RDWR]) : boolean
-sub shutdown : locked method
+sub shutdown # $self [, $how=SHUT_RDWR] ; returns boolean
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,3);
my $self = shift;
return 1 unless $self->isconnected or $self->isconnecting;
@@ -960,12 +874,11 @@ sub shutdown : locked method
my $xhow = $to_shut_flags{$how};
($how = SHUT_RDWR), ($xhow = 3)
unless $xhow;
- my $was = ($ {*$self}{'wasconnected'} |= $xhow);
+ my $was = (${*$self}{'wasconnected'} |= $xhow);
my $rval = CORE::shutdown($self, $how);
local $!; # preserve shutdown()'s errno
- $ {*$self}{'isconnecting'} = $ {*$self}{'isconnected'} = 0 if
- $was == 3 or
- (!defined(getpeername($self)) && ($ {*$self}{'wasconnected'} = 3));
+ ${*$self}{'isconnecting'} = ${*$self}{'isconnected'} = 0 if $was == 3 or
+ (!defined(getpeername($self)) && (${*$self}{'wasconnected'} = 3));
$rval;
}
@@ -974,9 +887,9 @@ my @CloseVars = qw(FHVec isopen isbound didlisten wasconnected isconnected
isconnecting);
my @CloseKeys = qw(srcaddr dstaddr);
-#& close($self [, @ignored]) : boolean
-sub close : locked method
+sub close # $self [, @ignored] ; returns boolean
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,3);
my $self = shift;
$self->shutdown if $self->isopen;
@@ -986,9 +899,9 @@ sub close : locked method
sub CLOSE;
*CLOSE = \&close;
-#& stopio($self [, @ignored]) : boolean
-sub stopio : locked method
+sub stopio # $self [, @ignored] ; returns boolean
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,4);
my $self = shift;
my $wasopen = $self->isopen;
@@ -1003,11 +916,7 @@ sub stopio : locked method
# Warning! No intercepting of SIGPIPE is done, so the output routines
# can abort the program.
-# Note that (at least) Solaris 2.5.1 doesn't like connect() on datagram
-# sockets, at least not if they're not bound. So, we fake it here.
-
-#& send($self, $buf, [$flags, [$where]]) : boolean
-sub send
+sub send # $self, $buf, [$flags, [$where]] : boolean
{
my $whoami = $_[0]->_trace(\@_,3);
my($self,$buf,$flags,$whither) = @_;
@@ -1016,32 +925,21 @@ sub send
$flags = 0 unless defined $flags;
carp "Excess arguments to ${whoami} ignored" if @_ > 4;
# send(2) requires connect(2)
- if (!(defined $whither or $self->isconnected)) {
+ unless (defined $whither or $self->isconnected) {
if ($self->getparams([qw(dstaddrlist dstaddr)],1) > 0) {
return undef unless $self->connect;
- if ($ {*$self}{Parms}{netgen_fakeconnect}) {
- $whither = $ {*$self}{Parms}{'dstaddr'};
- }
}
else {
if ($flags & MSG_OOB) {
- $whither = $ {*$self}{lastOOBFrom};
+ $whither = ${*$self}{lastOOBFrom};
}
else {
- $whither = $ {*$self}{lastRegFrom};
+ $whither = ${*$self}{lastRegFrom};
}
# Can't short-circuit this--need to get the right errno value.
# return undef unless defined $whither or $self->connect;
}
}
- elsif ($self->isconnected && $ {*$self}{Parms}{netgen_fakeconnect}) {
- if (defined $whither) {
- # *sigh* -- what errno should I return?
- $! = EISCONN || EINVAL;
- return undef;
- }
- $whither = $ {*$self}{Parms}{'dstaddr'};
- }
return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
$self->isopen; # generate EBADF return if not open
defined $whither
@@ -1052,8 +950,7 @@ sub send
sub SEND;
*SEND = \&send;
-#& put($self, @stuff) : boolean
-sub put
+sub put # $self, @stuff ; returns boolean
{
$_[0]->_trace(\@_,3);
my($self,@args) = @_;
@@ -1065,9 +962,9 @@ sub PRINT; # avoid -w error
sub print; # avoid -w error
*print = \&put; # maybe-useful alias
-#& ckeof($self) : boolean
-sub ckeof : locked method
+sub ckeof # $self ; returns boolean
{
+ use attrs 'locked', 'method';
my $saverr = $!+0;
local $!; # preserve this over fcntl() and such
my $whoami = $_[0]->_trace(\@_,3);
@@ -1091,9 +988,9 @@ sub ckeof : locked method
1; # wrong errno or blocking
}
-#& recv($self, [$maxlen, [$flags, [$from]]]) : {$buf | undef}
-sub recv : locked method
-{
+sub recv # $self, [$maxlen, [$flags, [$from]]] ;
+{ # returns $buf or undef
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,3);
my($self,$maxlen,$flags) = @_;
my($buf,$from,$xfrom) = '';
@@ -1107,16 +1004,16 @@ sub recv : locked method
(stat $self)[11] || 8192
unless $maxlen;
$flags = 0 unless defined $flags;
- if (defined($ {*$self}{sockLineBuf}) && !$flags) {
- $buf = $ {*$self}{sockLineBuf};
+ if (defined(${*$self}{sockLineBuf}) && !$flags) {
+ $buf = ${*$self}{sockLineBuf};
if (length($buf) > $maxlen) {
- $ {*$self}{sockLineBuf} = substr($buf, $maxlen);
+ ${*$self}{sockLineBuf} = substr($buf, $maxlen);
substr($buf, $maxlen) = '';
}
else {
- undef $ {*$self}{sockLineBuf};
+ ${*$self}{sockLineBuf} = undef;
}
- $_[3] = $ {*$self}{lastRegFrom} if @_ > 3;
+ $_[3] = ${*$self}{lastRegFrom} if @_ > 3;
return $buf;
}
$! = 0; # ease EOF checking
@@ -1124,13 +1021,13 @@ sub recv : locked method
my $errnum = $!+0; # preserve possible recv failure
$xfrom = getpeername($self) if defined($from) and $from eq '';
$from = $xfrom if defined($xfrom) and $from eq '' and $xfrom ne '';
- $ {*$self}{lastFrom} = $from;
+ ${*$self}{lastFrom} = $from;
$_[3] = $from if @_ > 3;
if ($flags & MSG_OOB) {
- $ {*$self}{lastOOBFrom} = $from;
+ ${*$self}{lastOOBFrom} = $from;
}
else {
- $ {*$self}{lastRegFrom} = $from;
+ ${*$self}{lastRegFrom} = $from;
}
$! = $errnum; # restore possible failure in case we return
return undef if !defined $from and (EOF_NONBLOCK or $errnum != $eagain);
@@ -1149,9 +1046,9 @@ sub recv : locked method
sub get; # (helps with -w)
*get = \&recv; # a name that works for indirect references
-#& getline($self) : like scalar(<$fhandle>)
-sub getline : locked method
+sub getline # $self ; returns like scalar(<$fhandle>)
{
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,4);
carp "Excess arguments to ${whoami} ignored"
if @_ > 1;
@@ -1159,8 +1056,8 @@ sub getline : locked method
croak "Invalid arguments to ${whoami}, called"
if !@_ or !ref($self);
my ($rval, $buf, $tbuf);
- $buf = $ {*$self}{sockLineBuf};
- undef $ {*$self}{sockLineBuf}; # keep get from returning this again
+ $buf = ${*$self}{sockLineBuf};
+ ${*$self}{sockLineBuf} = undef; # keep get from returning this again
if (!defined($/)) {
$rval = <$self>; # return all of the input
# what about non-blocking sockets here?!?
@@ -1191,7 +1088,7 @@ sub getline : locked method
$tbuf = substr($buf, length($rval));
# duplicate annoyance of paragraph mode
$tbuf =~ s/^\n+//s if $/ eq '';
- $ {*$self}{sockLineBuf} = $tbuf if length($tbuf);
+ ${*$self}{sockLineBuf} = $tbuf if length($tbuf);
return $rval;
}
else {
@@ -1207,39 +1104,34 @@ sub DESTROY
$_[0]->_trace(\@_,1);
}
-#& isopen($self [, @ignored]) : boolean
-sub isopen
+sub isopen # $self [, @ignored] ; returns boolean
{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'isopen'} ? "yes" : "no"));
- $ {*{$_[0]}}{'isopen'};
+ #$_[0]->_trace(\@_,4," - ".(${*{$_[0]}}{'isopen'} ? "yes" : "no"));
+ ${*{$_[0]}}{'isopen'};
}
-#& isconnected($self [, @ignored]) : boolean
-sub isconnected
+sub isconnected # $self [, @ignored] ; returns boolean
{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'isconnected'} ? "yes" : "no"));
- $ {*{$_[0]}}{'isconnected'};
+ #$_[0]->_trace(\@_,4," - ".(${*{$_[0]}}{'isconnected'} ? "yes" : "no"));
+ ${*{$_[0]}}{'isconnected'};
}
-#& isconnecting($self [, @ignored]) : boolean
-sub isconnecting
+sub isconnecting # $self [, @ignored] ; returns boolean
{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'isconnecting'} ? "yes" : "no"));
- $ {*{$_[0]}}{'isconnecting'};
+ #$_[0]->_trace(\@_,4," - ".(${*{$_[0]}}{'isconnecting'} ? "yes" : "no"));
+ ${*{$_[0]}}{'isconnecting'};
}
-#& wasconnected($self [, @ignored]) : boolean
-sub wasconnected
+sub wasconnected # $self [, @ignored] ; returns boolean
{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'wasconnected'} ? "yes" : "no"));
- $ {*{$_[0]}}{'wasconnected'};
+ #$_[0]->_trace(\@_,4," - ".(${*{$_[0]}}{'wasconnected'} ? "yes" : "no"));
+ ${*{$_[0]}}{'wasconnected'};
}
-#& isbound($self [, @ignored]) : boolean
-sub isbound
+sub isbound # $self [, @ignored] ; returns boolean
{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'isbound'} ? "yes" : "no"));
- $ {*{$_[0]}}{'isbound'};
+ #$_[0]->_trace(\@_,4," - ".(${*{$_[0]}}{'isbound'} ? "yes" : "no"));
+ ${*{$_[0]}}{'isbound'};
}
1;
@@ -1265,20 +1157,10 @@ implementors of other modules. To this end, several housekeeping
functions are provided for the use of derived classes, as well as
several inheritable methods. The C<Net::Gen> class does inherit
from C<IO::Handle>, thus making its methods available. See
-L<C<IO::Handle::METHODS>|IO::Handle/METHODS>
-for details on those methods. However, some
-of those methods are overridden, so be sure to check the methods
-described below to be sure. (In particular, the C<fcntl> and C<ioctl>
-methods are overridden.)
-
-Also provided in this distribution are
-L<C<Net::Inet>|Net::Inet>,
-L<C<Net::TCP>|Net::TCP>,
-L<C<Net::TCP::Server>|Net::TCP::Server>,
-L<C<Net::UDP>|Net::UDP>,
-L<C<Net::UNIX>|Net::UNIX>,
-and
-L<C<Net::UNIX::Server>|Net::UNIX::Server>,
+L<IO::Handle/METHODS> for details on those methods.
+
+Also provided in this distribution are C<Net::Inet>, C<Net::TCP>,
+C<Net::UDP>, and C<Net::UNIX>,
which are layered atop C<Net::Gen>.
=head2 Public Methods
@@ -1286,7 +1168,7 @@ which are layered atop C<Net::Gen>.
The public methods are listed alphabetically below. Here is an
indication of their functional groupings:
-=over 4
+=over
=item Creation and setup
@@ -1324,7 +1206,7 @@ C<format_addr>, C<format_local_addr>, C<format_remote_addr>
=item Tied filehandle support
C<SEND>, C<PRINT>, C<PRINTF>, C<RECV>, C<READLINE>, C<READ>, C<GETC>,
-C<WRITE>, C<CLOSE>, C<EOF>, C<BINMODE>, C<FILENO>,
+C<WRITE>, C<CLOSE>, C<EOF>,
C<TIEHANDLE>
=item Tied scalar support
@@ -1336,13 +1218,13 @@ C<FETCH>, C<STORE>, C<TIESCALAR>
Any of the I<keys> known to the C<getparam> and C<setparams> methods
may be used as an I<accessor> function. See L<"Known Object Parameters">
below, and the related sections in the derived classes. For an example,
-see C<blocking>, below.
+see L</blocking> below.
=back
The descriptions, listed alphabetically:
-=over 4
+=over
=item accept
@@ -1391,15 +1273,6 @@ the foregoing discussion, you may be in trouble. Don't panic
until you've checked the discussion of binding in the derived
class you're using, however.
-=item BINMODE
-
-Usage:
-
- binmode(TIEDFH);
-
-A no-op provided for the tied file handle support of perl 5.005_57.
-The sockets managed by this module are always set binmode() anyway.
-
=item blocking
Usage:
@@ -1408,8 +1281,8 @@ Usage:
$oldblocking = $obj->blocking($newvalue);
The C<blocking> method is an example of an I<accessor> method. The
-above usage examples are (effectively) equivalent to the following code
-snippets, respectively:
+above usage examples are (effectively) equivalent to the following calls,
+respectively:
$isblocking = $obj->getparam('blocking');
@@ -1452,8 +1325,8 @@ Usage:
an open() or accept(). (In other words, the C<open> and C<accept>
methods call the C<condition> method.)
Sets the socket to be autoflushed and marks it binmode().
-This method attempts to set the socket blocking or non-blocking, depending on
-the state of the object's C<blocking> parameter. (It may update that parameter
+Attempts to set the socket blocking or non-blocking, depending on the
+state of the object's C<blocking> parameter. (It may update that parameter
if the socket's state cannot be made to match.)
No useful value is returned.
@@ -1503,7 +1376,7 @@ the C<dstaddrlist> object parameter. This is so that the re-try logic
for connections in progress will be more useful.
If, on entry to the C<connect> method, the object is already marked as
-having a connection in progress (C<$obj-E<gt>isconnecting> returns true),
+having a connection in progress (C<$obj->isconnecting> returns true),
then the connection will be re-tried with a timeout of 0 to see whether it
has succeeded in the meanwhile. The appropriate success/fail condition
for that check will be returned, with no further processing of the
@@ -1557,9 +1430,7 @@ Provided for tied filehandle support. Determines whether select()
says that a read would work immediately, and tries it if so.
If the read was tried and returned an eof condition, 1 is returned.
The return is 0 on read errors or when select() said that a read
-would block. Note that this interferes with use of the select()
-built-in, since it has to buffer the read data if the read was
-successful.
+would block.
=item fcntl
@@ -1569,15 +1440,6 @@ Usage:
Returns the result of an fcntl() call on the associated I/O stream.
-=item FETCH
-
-Usage:
-
- $data = $TIED_SCALAR;
-
-This is for the support of the C<TIESCALAR> interface. It returns
-the result of a call to the C<READLINE> method on the underlying object.
-
=item fhvec
Usage:
@@ -1586,19 +1448,16 @@ Usage:
Returns a vector suitable as an argument to the 4-argument select()
call. This is for use in doing selects with multiple I/O streams.
-See also L<"select">.
+See also L</select>.
=item fileno
-=item FILENO
-
Usage:
$fnum = $obj->fileno;
- $fnum = fileno(TIEDFH);
Returns the actual file descriptor number for the underlying socket.
-See L<"getfh"> for some restrictions as to the safety of using this.
+See L</getfh> for some restrictions as to the safety of using this.
=item format_addr
@@ -1633,7 +1492,7 @@ associated with the object.
=item get
This is just a sugar-coated way to call the C<recv> method which will
-work with indirect-object syntax. See L<"recv"> for details.
+work with indirect-object syntax. See L</recv> for details.
=item GETC
@@ -1660,29 +1519,26 @@ calls and traditional socket-level I/O. However, if you're sure you can
keep things straight, here are the rules under which it's safe to use the
embedded filehandle:
-=over 6
+=over
-=item *
+=item Z<>
Don't use perl's own C<stdio> calls. Stick to sysread() and recv().
-=item *
+=item Z<>
Don't use the object's C<getline> method, since that stores a read-ahead
buffer in the object which only the object's own C<get>/C<recv> and
C<getline> methods know to return to you. (The object's C<select> method
knows about the buffer enough to tell you that a read will succeed if
-there's saved data, though.) Similarly, avoid the object's C<EOF> method.
+there's saved data, though.)
-=item *
+=item Z<>
Please don't change the state of the socket behind my back. That
means no close(), shutdown(), connect(), bind(), or listen()
built-ins. Use the corresponding methods instead, or all bets
-are off. Of course, if you're only using this module to get the
-connect() or bind() processing, and you're going to discard the object
-after you've done your I/O, then it's OK to use the built-ins for I/O.
-Just don't expect my code to know what you did behind my back.
+are off.
=back
@@ -1732,16 +1588,14 @@ Usage:
%hash = $obj->getparams(\@keynames, $noundefs);
%hash = $obj->getparams(\@keynames);
- $llen = $obj->getparams(\@keynames, $noundefs);
- $llen = $obj->getparams(\@keynames);
Returns a hash as a list (I<not> a reference) consisting of the key-value
pairs corresponding to the specified keyname list. Only those
keys which exist in the current parameter list of the object will
be returned. If the C<$noundefs> parameter is present and true,
then existing keys with undefined values will be suppressed as with
-non-existent keys. If called in scalar context, returns the
-number of values which would have been returned in list context.
+non-existent keys. If called in a scalar context, returns the
+number of values which would have been returned in array context.
(This is twice the number of key-value pairs, in case that wasn't clear.)
=item getropt
@@ -1755,7 +1609,7 @@ Returns the raw value from a call to the getsockopt() builtin.
If both the C<$level> and C<$option> arguments are given as
numbers, the getsockopt() call will be made even if the given
socket option is not registered with the object. Otherwise, the
-return value for unregistered options will be undef with the
+return value for unregistered objects will be undef with the
value of $! set as described below for the C<getsopt> method.
=item gets
@@ -1782,12 +1636,12 @@ object. If a getsockname() call on the associated filehandle
succeeds, the C<srcaddr> object parameter is set to that returned
sockaddr. If a getpeername() call on the associated filehandle
succeeds, the C<dstaddr> parameter is set to that returned
-sockaddr. In scalar context, if both socket addresses were
+sockaddr. In a scalar context, if both socket addresses were
found, the getpeername() value is returned, otherwise C<undef> is
-returned. In list context, the getsockname() and getpeername()
+returned. In a list context, the getsockname() and getpeername()
values are returned, unless both are undefined.
-Derived classes normally override this method with one which
+Derived classes normally replace this method with one which
provides friendlier return information appropriate to the derived
class, and which establishes more of the object parameters.
@@ -1805,7 +1659,7 @@ socket options in L</initsockopts> below.
Since registered socket options are known by name as well as by
their level and option values, it is possible to make calls using
-only the option name. If the name is not registered with the object,
+only option name. If the name is not registered with the object,
the return value is the same as that for C<getsopt $obj -1,-1>,
which is an empty return array and $! set appropriately (should
be C<EINVAL>).
@@ -1986,8 +1840,7 @@ Usage:
$ok = $obj->PRINTF($format, @args);
$ok = printf TIEDFH $format, @args;
-This method uses the sprintf() builtin and the C<PRINT> method
-to send the @args values to the
+This method uses the printf() builtin to send the @args avlues to the
filehandle associated with the object, using the $format format string.
It exists for the support of tied filehandles.
@@ -2039,7 +1892,7 @@ Usage:
This method supports the use of the E<lt>E<gt> (or readline()) operator
on tied filehandles. In scalar context, it uses the C<getline> method.
-In list context, it reads all remaining input on the socket (until eof, which
+In array context, it reads all remaining input on the socket (until eof, which
makes this unsuitable for connectionless socket types such as UDP), and
splits it into lines based on the current value of the $/ variable.
The return value is unreliable for non-blocking sockets.
@@ -2067,7 +1920,7 @@ Usage:
This method calls the recv() builtin, and returns a buffer (if
one is received) or C<undef> on eof or error. If an eof is seen
-on the socket (as checked with its C<ckeof> method), then $!
+on the socket (as checked with its C<ckeof> method), then C<$!>
will be 0 on return. If the C<$whence> argument is supplied, it
will be filled in with the sending socket address if possible.
If the C<$flags> argument is not supplied, it defaults to 0. If
@@ -2109,7 +1962,7 @@ Usage:
This method calls the send() builtin (three- or four-argument
form). The C<$flags> parameter is defaulted to 0 if not
supplied. If the C<$destsockaddr> value is missing or undefined,
-and the socket is connected (C<$obj-E<gt>isconnected> returns true), then
+and the socket is connected (C<$obj->isconnected> returns true), then
the three-argument form of the send() builtin will be used. Otherwise, the
C<$destsockaddr> parameter will be defaulted from the last recv()
peer address for the same kind of message (depending on whether
@@ -2220,7 +2073,7 @@ the object. This method is a no-op, returning 1, if the
filehandle is not connected. The C<$how> parameter is as per the
shutdown() builtin, which in turn should be as described in the
shutdown(2) manpage. If the C<$how> parameter is not present,
-it is assumed to be C<SHUT_RDWR> (which is 2 on most UNIX systems).
+it is assumed to be C<SHUT_RDWR>(2).
Returns 1 if it has nothing to do, otherwise propagates the return from
the shutdown() builtin.
@@ -2238,49 +2091,6 @@ primarily for the use of server modules which need to avoid
C<shutdown> calls at inappropriate times. This method calls the
C<delparams> method for the keys of C<srcaddr> and C<dstaddr>.
-=item STORE
-
-Usage:
-
- $TIED_SCALAR = $data;
-
-Provided for the support of tied scalars. Results in a call to the
-C<put> method, unless there's exactly one arg and it's C<undef>.
-In that case, since this normally results from C<undef $TIED_SCALAR>,
-it's ignored.
-
-=item TIEHANDLE
-
-Usage:
-
- tie *FH, $package, @options or die;
- print FH $out_data;
- print $in_data while defined($in_data = <FH>);
- untie *FH;
-
-Tieing of a filehandle to a network handle is supported by this base
-However, this method only succeeds if the related call to the C<new>
-method returns an object for which the C<isconnected> method returns
-true. Thus, the most useful example is in
-L<C<Net::UDP>|Net::UDP/"TIEHANDLE support">.
-
-=item TIESCALAR
-
-Usage:
-
- tie $x, $package, @options or die;
- $x = $out_data;
- print $in_data while defined($in_data = $x);
- untie $x;
-
-Tieing of scalars to a network handle is supported by this base class.
-However, this method only succeeds if the related call to the C<new>
-method returns an object for which the C<isconnected> method returns
-true. Thus, the useful examples are in
-L<C<Net::TCP>|Net::TCP/TIESCALAR>
-and
-L<C<Net::UDP>|Net::UDP/"TIESCALAR support">.
-
=item unbind
Usage:
@@ -2300,9 +2110,9 @@ Usage:
$was = $obj->wasconnected;
-Returns true if the object has had a successful connect() completion
+Returns true for if the object has had a successful connect() completion
since it was last opened. Returns false after a close() or on a new
-object. Also returns true if C<$obj-E<gt>isconnecting> is true.
+object.
=item WRITE
@@ -2325,7 +2135,7 @@ Yes, I know that Perl doesn't really have protected methods as
such. However, these are the methods which are only useful for
implementing derived classes, and not for the general user.
-=over 4
+=over
=item ckeof
@@ -2380,15 +2190,15 @@ value is an array ref with the following elements:
[pack template, option value, option level, pack array len]
Such a completed optiondesc is one of the required arguments to
-the C<register_options> method (see below).
-
-=item register_options
+the C<registerOptions> method (see below).
=item registerOptions
+=item register_options
+
Usage:
- $obj->register_options($levelname, $level, \%optiondesc);
+ $obj->registerOptions($levelname, $level, \%optiondesc);
This method attaches the socket options specified by the given
option descriptions hash ref and the given level (as text and as
@@ -2399,16 +2209,16 @@ which get registered.
Example:
- $self->register_options('SOL_SOCKET', SOL_SOCKET+0, \%sockopts);
-
-=item register_param_handlers
+ $self->registerOptions('SOL_SOCKET', SOL_SOCKET+0, \%sockopts);
=item registerParamHandlers
+=item register_param_handlers
+
Usage:
- $obj->register_param_handlers(\@keynames, \@keyhandlers);
- $obj->register_param_handlers(\%key_handler_pairs);
+ $obj->registerParamHandlers(\@keynames, \@keyhandlers);
+ $obj->registerParamHandlers(\%key_handler_pairs);
This method registers the referenced keynames (if they haven't
already been registered), and establishes the referenced
@@ -2421,13 +2231,13 @@ being called from the C<delparams> method). See the other
discussion of validation routines in the C<setparams> method
description, above.
-=item register_param_keys
-
=item registerParamKeys
+=item register_param_keys
+
Usage:
- $obj->register_param_keys(\@keynames);
+ $obj->registerParamKeys(\@keynames);
This method registers the referenced keynames as valid parameters
for C<setparams> and the like for this object. The C<new>
@@ -2455,7 +2265,7 @@ functions as they're referenced. See L<"blocking"> above for an example.
These are the socket options known to the C<Net::Gen> module
itself:
-=over 4
+=over
=item Z<>
@@ -2464,24 +2274,18 @@ C<SO_BROADCAST>,
C<SO_DEBUG>,
C<SO_DONTROUTE>,
C<SO_ERROR>,
-C<SO_EXPANDED_RIGHTS>,
-C<SO_FAMILY>,
C<SO_KEEPALIVE>,
-C<SO_LINGER>,
C<SO_OOBINLINE>,
-C<SO_PAIRABLE>,
-C<SO_RCVBUF>,
-C<SO_RCVLOWAT>,
-C<SO_RCVTIMEO>,
C<SO_REUSEADDR>,
-C<SO_REUSEPORT>,
+C<SO_USELOOPBACK>,
+C<SO_RCVBUF>,
C<SO_SNDBUF>,
-C<SO_SNDLOWAT>,
+C<SO_RCVTIMEO>,
C<SO_SNDTIMEO>,
-C<SO_STATE>,
+C<SO_RCVLOWAT>,
+C<SO_SNDLOWAT>,
C<SO_TYPE>,
-C<SO_USELOOPBACK>,
-C<SO_XSE>
+C<SO_LINGER>
=back
@@ -2490,11 +2294,11 @@ C<SO_XSE>
These are the object parameters registered by the C<Net::Gen>
module itself:
-=over 4
+=over
=item AF
-Address family (will default from PF, and vice versa).
+Address family (will default from PF, and vice versa)
=item blocking
@@ -2507,11 +2311,11 @@ them may surprise you.
=item dstaddr
-The result of getpeername(), or an ephemeral proposed connect() address.
+The result of getpeername(), or an ephemeral proposed connect() address
=item dstaddrlist
-A reference to an array of socket addresses to try for connect().
+A reference to an array of socket addresses to try for connect()
=item maxqueue
@@ -2519,47 +2323,26 @@ An override of the default maximum queue depth parameter for
listen(). This will be used if the $maxqueue argument to
listen() is not supplied.
-=item netgen_fakeconnect
-
-This parameter is set true to keep the C<connect> method from
-really calling the connect() built-in if the socket has not
-had an source address specified and it is not bound. This
-is used by the
-L<Net::UNIX|Net::UNIX>
-and
-L<Net::UDP|Net::UDP>
-modules to keep
-from exercising a bug in some socket implementations with respect
-to how datagram sockets are handled. (This was specifically done
-in response to quirks of Solaris 2.5.1.) Instead, the C<connect>
-method simply sets the C<dstaddr> object parameter, which the C<send>
-method will respect.
-
=item PF
-Protocol family for this object. Will default from AF, and vice versa.
+Protocol family for this object
=item proto
-The protocol to pass to the socket() call (often defaulted to 0).
+The protocol to pass to the socket() call (often defaulted to 0)
=item reuseaddr
A boolean, indicating whether the C<bind> method should do a
-setsockopt() call to set C<SO_REUSEADDR> to 1.
-
-=item reuseport
-
-A boolean, indicating whether the C<bind> method should do a
-setsockopt() call to set C<SO_REUSEPORT> to 1.
+setsockopt() call to set C<SO_REUSEADDR> to 1
=item srcaddr
-The result of getsockname(), or an ephemeral proposed bind() address.
+The result of getsockname(), or an ephemeral proposed bind() address
=item srcaddrlist
-A reference to an array of socket addresses to try for bind().
+A reference to an array of socket addresses to try for bind()
=item timeout
@@ -2575,7 +2358,7 @@ The socket type to create (C<SOCK_STREAM>, C<SOCK_DGRAM>, etc.)
=head2 Non-Method Subroutines
-=over 4
+=over
=item pack_sockaddr
@@ -2639,7 +2422,7 @@ sysopen() or for eventual use in fcntl().
=head2 Exports
-=over 4
+=over
=item default
@@ -2647,49 +2430,33 @@ None.
=item exportable
-C<AF_APPLETALK> C<AF_CCITT> C<AF_CHAOS> C<AF_CTF> C<AF_DATAKIT>
-C<AF_DECnet> C<AF_DLI> C<AF_ECMA> C<AF_HYLINK> C<AF_IMPLINK>
-C<AF_INET> C<AF_ISO> C<AF_LAST> C<AF_LAT> C<AF_LINK> C<AF_LOCAL> C<AF_NETMAN>
-C<AF_NS> C<AF_OSI> C<AF_PUP> C<AF_ROUTE> C<AF_SNA> C<AF_UNIX>
-C<AF_UNSPEC> C<AF_USER> C<AF_WAN> C<AF_X25> C<EADDRINUSE>
-C<EADDRNOTAVAIL> C<EAFNOSUPPORT> C<EAGAIN> C<EALREADY> C<EBADF>
-C<EBADMSG> C<ECONNABORTED> C<ECONNREFUSED> C<ECONNRESET>
-C<EDESTADDRREQ> C<EHOSTDOWN> C<EHOSTUNREACH> C<EINPROGRESS>
-C<EINVAL> C<EISCONN> C<EMSGSIZE> C<ENETDOWN> C<ENETRESET>
-C<ENETUNREACH> C<ENOBUFS> C<ENODATA> C<ENOENT> C<ENOPROTOOPT>
-C<ENOSR> C<ENOSTR> C<ENOTCONN> C<ENOTSOCK> C<EOF_NONBLOCK>
-C<EOPNOTSUPP> C<EPFNOSUPPORT> C<EPROTO> C<EPROTONOSUPPORT>
-C<EPROTOTYPE> C<ESHUTDOWN> C<ESOCKTNOSUPPORT> C<ETIME>
-C<ETIMEDOUT> C<ETOOMANYREFS> C<EWOULDBLOCK> C<pack_sockaddr>
-C<PF_APPLETALK> C<PF_CCITT> C<PF_CHAOS> C<PF_CTF> C<PF_DATAKIT>
-C<PF_DECnet> C<PF_DLI> C<PF_ECMA> C<PF_HYLINK> C<PF_IMPLINK>
-C<PF_INET> C<PF_ISO> C<PF_LAST> C<PF_LAT> C<PF_LINK> C<PF_LOCAL> C<PF_NETMAN>
-C<PF_NS> C<PF_OSI> C<PF_PUP> C<PF_ROUTE> C<PF_SNA> C<PF_UNIX>
-C<PF_UNSPEC> C<PF_USER> C<PF_WAN> C<PF_X25> C<RD_NODATA>
-C<SHUT_RD> C<SHUT_RDWR> C<SHUT_WR> C<SOCK_DGRAM> C<SOCK_RAW>
-C<SOCK_RDM> C<SOCK_SEQPACKET> C<SOCK_STREAM> C<SOL_SOCKET>
-C<SOMAXCONN> C<SO_ACCEPTCONN> C<SO_BROADCAST> C<SO_DEBUG>
-C<SO_DONTROUTE> C<SO_ERROR> C<SO_EXPANDED_RIGHTS> C<SO_FAMILY>
-C<SO_KEEPALIVE> C<SO_LINGER> C<SO_OOBINLINE> C<SO_PAIRABLE>
-C<SO_RCVBUF> C<SO_RCVLOWAT> C<SO_RCVTIMEO> C<SO_REUSEADDR>
-C<SO_REUSEPORT> C<SO_SNDBUF> C<SO_SNDLOWAT> C<SO_SNDTIMEO>
-C<SO_STATE> C<SO_TYPE> C<SO_USELOOPBACK> C<SO_XSE>
-C<unpack_sockaddr> C<VAL_EAGAIN> C<VAL_O_NONBLOCK>
+C<VAL_O_NONBLOCK> C<VAL_EAGAIN> C<RD_NODATA> C<EOF_NONBLOCK>
+C<pack_sockaddr> C<unpack_sockaddr>
+C<SOMAXCONN>
+C<EADDRINUSE> C<EADDRNOTAVAIL> C<EAFNOSUPPORT> C<EAGAIN>
+C<EALREADY> C<EBADF> C<EBADMSG> C<ECONNABORTED> C<ECONNREFUSED>
+C<ECONNRESET> C<EDESTADDRREQ> C<EHOSTDOWN> C<EHOSTUNREACH>
+C<EINPROGRESS> C<EINVAL> C<EISCONN> C<EMSGSIZE> C<ENETDOWN> C<ENETRESET>
+C<ENETUNREACH> C<ENOBUFS> C<ENODATA> C<ENOENT> C<ENOPROTOOPT> C<ENOSR>
+C<ENOSTR> C<ENOTCONN> C<ENOTSOCK> C<EOPNOTSUPP> C<EPFNOSUPPORT>
+C<EPROTO> C<EPROTONOSUPPORT> C<EPROTOTYPE> C<ESHUTDOWN>
+C<ESOCKTNOSUPPORT> C<ETIME> C<ETIMEDOUT> C<ETOOMANYREFS> C<EWOULDBLOCK>
+C<SHUT_RD> C<SHUT_WR> C<SHUT_RDWR>
=item tags
The following I<:tags> are available for grouping exported items
together:
-=over 6
+=over
-=item :af
+=item :NonBlockVals
+
+C<EOF_NONBLOCK> C<RD_NODATA> C<VAL_EAGAIN> C<VAL_O_NONBLOCK>
+
+=item :routines
-C<AF_APPLETALK> C<AF_CCITT> C<AF_CHAOS> C<AF_CTF> C<AF_DATAKIT>
-C<AF_DECnet> C<AF_DLI> C<AF_ECMA> C<AF_HYLINK> C<AF_IMPLINK>
-C<AF_INET> C<AF_ISO> C<AF_LAST> C<AF_LAT> C<AF_LINK> C<AF_LOCAL> C<AF_NETMAN>
-C<AF_NS> C<AF_OSI> C<AF_PUP> C<AF_ROUTE> C<AF_SNA> C<AF_UNIX>
-C<AF_UNSPEC> C<AF_USER> C<AF_WAN> C<AF_X25>
+C<pack_sockaddr> C<unpack_sockaddr>
=item :errnos
@@ -2702,46 +2469,10 @@ C<ENOSTR> C<ENOTCONN> C<ENOTSOCK> C<EOPNOTSUPP> C<EPFNOSUPPORT>
C<EPROTO> C<EPROTONOSUPPORT> C<EPROTOTYPE> C<ESHUTDOWN>
C<ESOCKTNOSUPPORT> C<ETIME> C<ETIMEDOUT> C<ETOOMANYREFS> C<EWOULDBLOCK>
-=item :families
-
-The union of the C<:af> and C<:pf> tags.
-
-=item :NonBlockVals
-
-=item :non_block_vals
-
-C<EOF_NONBLOCK> C<RD_NODATA> C<VAL_EAGAIN> C<VAL_O_NONBLOCK>
-
-=item :pf
-
-C<PF_APPLETALK> C<PF_CCITT> C<PF_CHAOS> C<PF_CTF> C<PF_DATAKIT>
-C<PF_DECnet> C<PF_DLI> C<PF_ECMA> C<PF_HYLINK> C<PF_IMPLINK>
-C<PF_INET> C<PF_ISO> C<PF_LAST> C<PF_LAT> C<PF_LINK> C<PF_LOCAL> C<PF_NETMAN>
-C<PF_NS> C<PF_OSI> C<PF_PUP> C<PF_ROUTE> C<PF_SNA> C<PF_UNIX>
-C<PF_UNSPEC> C<PF_USER> C<PF_WAN> C<PF_X25>
-
-=item :routines
-
-C<pack_sockaddr> C<unpack_sockaddr>
-
=item :shutflags
C<SHUT_RD> C<SHUT_WR> C<SHUT_RDWR>
-=item :sockopts
-
-C<SO_ACCEPTCONN> C<SO_BROADCAST> C<SO_DEBUG> C<SO_DONTROUTE>
-C<SO_ERROR> C<SO_EXPANDED_RIGHTS> C<SO_FAMILY> C<SO_KEEPALIVE>
-C<SO_LINGER> C<SO_OOBINLINE> C<SO_PAIRABLE> C<SO_RCVBUF>
-C<SO_RCVLOWAT> C<SO_RCVTIMEO> C<SO_REUSEADDR> C<SO_REUSEPORT>
-C<SO_SNDBUF> C<SO_SNDLOWAT> C<SO_SNDTIMEO> C<SO_STATE> C<SO_TYPE>
-C<SO_USELOOPBACK> C<SO_XSE>
-
-=item :sockvals
-
-C<SOL_SOCKET> C<SOCK_STREAM> C<SOCK_DGRAM> C<SOCK_RAW>
-C<SOCK_RDM> C<SOCK_SEQPACKET>
-
=item :ALL
All of the above.
@@ -2752,22 +2483,9 @@ 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::UNIX(3)|Net::UNIX>,
-Net::Dnet(3)
-
=head1 AUTHOR
-Spider Boardman E<lt>spidb@cpan.orgE<gt>
+Spider Boardman F<E<lt>spider@Orb.Nashua.NH.USE<gt>>
=cut
@@ -2775,79 +2493,73 @@ Spider Boardman E<lt>spidb@cpan.orgE<gt>
#any real autoloaded methods go after this line
-#& setdebug($this, [bool, [norecurse]]) : previous
-sub setdebug
+sub setdebug # $this, [bool, [norecurse]] ; returns previous
{
$_[0]->_debug($_[1]);
}
# fluff routine to make things easy
-#& setparam($self, $name, $value, [newonly, [docheck]]) : boolean
-sub setparam
-{
+sub setparam # $self, $name, $value, [newonly, [docheck]] ;
+{ # returns boolean
my $whoami = $_[0]->_trace(\@_,1);
my($self,$key,$val,$newonly,$docheck) = @_;
carp "Excess arguments to ${whoami} ignored"
if @_ > 5;
croak "Invalid arguments to ${whoami}, called"
- if @_ < 3 or not ref $self or not exists $ {*$self}{Keys}{$key};
+ if @_ < 3 or not ref $self or not exists ${*$self}{Keys}{$key};
$self->setparams({$key => $val}, $newonly, $docheck);
}
-#& bind($self [, @ignored]) : boolean
-sub bind : locked method
+sub bind # $self [, @ignored] ; returns boolean
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,2);
my $self = shift;
$self->close if
$self->wasconnected || $self->isconnected || $self->isconnecting ||
$self->isbound;
- return $ {*$self}{'isbound'} = undef unless
- $self->isopen or $self->open;
- $self->setsopt('SO_REUSEADDR', 1) if $ {*$self}{Parms}{reuseaddr};
- $self->setsopt('SO_REUSEPORT', 1) if $ {*$self}{Parms}{reuseport};
+ return ${*$self}{'isbound'} = undef unless $self->isopen or $self->open;
+ $self->setsopt('SO_REUSEADDR', 1) if ${*$self}{Parms}{reuseaddr};
my $rval;
- if ($ {*$self}{Parms}{srcaddrlist}) {
+ if (${*$self}{Parms}{srcaddrlist}) {
my $tryaddr;
- foreach $tryaddr (@{$ {*$self}{Parms}{srcaddrlist}}) {
+ foreach $tryaddr (@{${*$self}{Parms}{srcaddrlist}}) {
next unless $rval = CORE::bind($self, $tryaddr);
- $ {*$self}{Parms}{srcaddr} = $tryaddr;
+ ${*$self}{Parms}{srcaddr} = $tryaddr;
last;
}
}
- elsif (defined($ {*$self}{Parms}{srcaddr}) and
- length $ {*$self}{Parms}{srcaddr})
- {
- $rval = CORE::bind($self, $ {*$self}{Parms}{srcaddr});
+ elsif (defined(${*$self}{Parms}{srcaddr}) and
+ length ${*$self}{Parms}{srcaddr}) {
+ $rval = CORE::bind($self, ${*$self}{Parms}{srcaddr});
}
else {
- $rval = CORE::bind($self, pack_sockaddr($ {*$self}{Parms}{AF},''));
+ $rval = CORE::bind($self, pack_sockaddr(${*$self}{Parms}{AF},''));
}
- $ {*$self}{'isbound'} = $rval;
+ ${*$self}{'isbound'} = $rval;
return $rval unless $rval;
$self->getsockinfo;
$self->isbound;
}
-#& unbind($self [, @ignored])
-sub unbind : locked method
+sub unbind # $self [, @ignored] ; return not useful
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,2);
my($self) = @_;
$self->close unless $self->isconnected || $self->isconnecting;
$self->delparams([qw(srcaddrlist)]);
}
-#& delparam($self, @paramnames) : boolean
-sub delparam
+sub delparam # $self, @paramnames ; returns bool
{
my ($self,@keys) = @_;
$self->delparams(\@keys);
}
-#& listen($self [, $maxq=SOMAXCONN]) : boolean
-sub listen : locked method
+sub listen # $self [, $maxq=SOMAXCONN] ; returns boolean
{
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,2);
my ($self,$maxq) = @_;
$maxq = $self->getparam('maxqueue',SOMAXCONN,1) unless defined $maxq;
@@ -2855,15 +2567,14 @@ sub listen : locked method
$maxq =~ /\D/ or !ref $self;
carp "Excess args for ${whoami}(@_) ignored" if @_ > 2;
return undef unless $self->isbound or $self->bind;
- $ {*$self}{'didlisten'} = $maxq;
- CORE::listen($self,$maxq) or undef $ {*$self}{'didlisten'};
+ ${*$self}{'didlisten'} = $maxq;
+ CORE::listen($self,$maxq) or undef ${*$self}{'didlisten'};
}
-#& didlisten($self [, @ignored]) : boolean
-sub didlisten
+sub didlisten # $self [, @ignored] ; returns boolean
{
- #$_[0]->_trace(\@_,4," - ".($ {*{$_[0]}}{'didlisten'} ? "yes" : "no"));
- $ {*{$_[0]}}{'didlisten'};
+ #$_[0]->_trace(\@_,4," - ".(${*{$_[0]}}{'didlisten'} ? "yes" : "no"));
+ ${*{$_[0]}}{'didlisten'};
}
sub TIESCALAR
@@ -2874,14 +2585,18 @@ sub TIESCALAR
$self && $self->isconnected && $self;
}
-sub FETCH : locked method
+sub FETCH
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,2);
- scalar $_[0]->READLINE;
+ my $self = shift;
+ my $line = $self->READLINE;
+ $line;
}
-sub STORE : locked method
+sub STORE
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,2);
my $self = shift;
return if @_ == 1 and !defined $_[0]; # "undef $x"
@@ -2890,9 +2605,8 @@ sub STORE : locked method
# socket-option routines
-#& _findxopt($self, $realp, @args) : ($aref,@subargs)
-sub _findxopt
-{
+sub _findxopt # $self, $realp, @args ;
+{ # returns ($aref,@subargs)
my($self,$realp,@args) = @_;
my($aref,$level,$what);
$level = shift @args; # try input arg as level first
@@ -2900,7 +2614,7 @@ sub _findxopt
# if numeric, it had better be the level
$level = ((substr($level, 0, 1) eq '0') ? oct($level) : $level+0);
}
- $aref = $ {*$self}{Sockopts}{$level};
+ $aref = ${*$self}{Sockopts}{$level};
if (!$aref) {
# here, we have to search for the ruddy thing by keyword
# if level was numeric, punt by trying to force EINVAL
@@ -2911,15 +2625,16 @@ sub _findxopt
last unless $what =~ /^(0x[\da-f]+|0[0-7]*|[1-9]\d*)$/si;
$what = ((substr($what, 0, 1) eq '0') ? oct($what) : $what+0);
$aref = ['h*', $what, $level, 0+@args];
- return ($aref,@args);
+ unshift(@args, $aref);
+ return @args;
}
return getsockopt($self,-1,-1) unless $level =~ /\D/;
$what = $level;
- foreach $level (keys %{$ {*$self}{Sockopts}}) {
- next unless ref($ {*$self}{Sockopts}{$level}) eq 'HASH';
- last if $aref = $ {*$self}{Sockopts}{$level}{$what};
+ foreach $level (keys %{${*$self}{Sockopts}}) {
+ next unless ref(${*$self}{Sockopts}{$level}) eq 'HASH';
+ last if $aref = ${*$self}{Sockopts}{$level}{$what};
}
- $ {*$self}{Sockopts}{$what} = $aref if ref $aref eq 'ARRAY';
+ ${*$self}{Sockopts}{$what} = $aref if ref $aref eq 'ARRAY';
}
elsif (ref $aref eq 'HASH') {
$what = shift @args;
@@ -2933,9 +2648,9 @@ sub _findxopt
($aref,@args);
}
-#& _getxopt($this, $realp, [$level,] $what) : @values
-sub _getxopt : locked method
+sub _getxopt # $this, $realp, [$level,] $what
{
+ use attrs 'locked', 'method';
my($self,$realp,@args) = @_;
my($aref,$level,$what,$rval,$format);
@args = $self->_findxopt($realp, @args); # get the array ref
@@ -2945,7 +2660,7 @@ sub _getxopt : locked method
$level = $$aref[2];
$format = $$aref[0];
$rval = getsockopt($self,$level+0,$what+0);
- if ($self->debug > 3) {
+ if ($self->_debug > 3) {
@args = unpack($format,$rval) if defined $rval;
print STDERR " - getsockopt $self,$level,$what => ";
print STDERR (defined $rval ? "@args\n" : "(undef)\n");
@@ -2955,23 +2670,21 @@ sub _getxopt : locked method
unpack($format,$rval);
}
-#& getsopt($this, [$level,] $what) : @values
-sub getsopt
+sub getsopt # $this, [$level,] $what
{
my($self,@args) = @_;
$self->_getxopt(0,@args);
}
-#& getropt($this, [$level,] $what) : $value
-sub getropt
+sub getropt # $this, [$level,] $what
{
my($self,@args) = @_;
$self->_getxopt(1,@args);
}
-#& _setxopt($this, $realp, [$level,] $what, @vals) : boolean
-sub _setxopt : locked method
+sub _setxopt # $this, $realp, [$level,] $what, @vals
{
+ use attrs 'locked', 'method';
my($self,$realp,@args) = @_;
my($aref,$level,$what,$rval,$format);
@args = $self->_findxopt($realp, @args); # get the array ref and real args
@@ -2990,68 +2703,49 @@ sub _setxopt : locked method
}
print STDERR " - setsockopt $self,$level,$what,",
join($",unpack($format,$rval)),"\n"
- if $self->debug > 3;
+ if $self->_debug > 3;
setsockopt($self,$level+0,$what+0,$rval);
}
-#& setsopt($this, [$level,] $what, @vals) : boolean
-sub setsopt
+sub setsopt # $this, [$level,] $what, @vals
{
$_[0]->_trace(\@_,2);
my($self,@args) = @_;
$self->_setxopt(0,@args);
}
-#& setropt($this, [$level,] $what, $realvalue) : boolean
-sub setropt
+sub setropt # $this, [$level,] $what, $realvalue
{
$_[0]->_trace(\@_,2);
my($self,@args) = @_;
$self->_setxopt(1,@args);
}
-#& BINMODE($this)
-sub BINMODE : locked method
-{
- # Need to allow for PerlIO layers here
- @_ > 1 ? binmode($_[0], $_[1]) : 1;
-}
-
-#& FILENO($this) : {$int | undef}
-sub FILENO
-{
-# $_[0]->_trace(\@_,4);
- CORE::fileno($_[0]);
-}
-
-#& fileno($this) : {$int | undef}
-sub fileno
+sub fileno # $this
{
# $_[0]->_trace(\@_,4);
CORE::fileno($_[0]);
}
-#& getfh($this) : {$gvref | undef}
-sub getfh
+sub getfh # $this
{
# $_[0]->_trace(\@_,4);
$_[0];
}
-#& fhvec($this) : {$fhvec | undef}
-sub fhvec
+sub fhvec # $this
{
$_[0]->_trace(\@_,4);
my($self) = @_;
return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
$self->isopen and
defined(CORE::fileno($self)); # return EBADF unless open
- $ {*$self}{FHVec}; # already setup by condition()
+ ${*$self}{FHVec}; # already setup by condition()
}
-#& select($this [[, $read, $write, $xcept, $timeout]]) : $nready | @list
-sub select : locked method
+sub select # $this [[, $read, $write, $xcept, $timeout]]
{
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,4);
my($self,$doread,$dowrite,$doxcept,$timer) = @_;
my($fhvec,$rvec,$wvec,$xvec,$nfound,$timeleft) = $self->fhvec;
@@ -3059,24 +2753,23 @@ sub select : locked method
$rvec = $doread ? $fhvec : undef;
$wvec = $dowrite ? $fhvec : undef;
$xvec = $doxcept ? $fhvec : undef;
- $timer = 0 if $doread and defined($ {*$self}{sockLineBuf});
+ $timer = 0 if $doread and defined(${*$self}{sockLineBuf});
($nfound, $timeleft) = CORE::select($rvec, $wvec, $xvec, $timer)
or return ();
- if (defined($ {*$self}{sockLineBuf}) && $doread && ($rvec ne $fhvec)) {
- $nfound++;
+ if (defined(${*$self}{sockLineBuf}) && $doread && ($rvec ne $fhvec)) {
+ $nfound += 1;
$rvec |= $fhvec;
}
- wantarray ?
- ($nfound, $timeleft,
- $doread && $rvec eq $fhvec,
- $dowrite && $wvec eq $fhvec,
- $doxcept && $xvec eq $fhvec)
- : $nfound;
+ return $nfound unless wantarray;
+ ($nfound, $timeleft,
+ $doread && $rvec eq $fhvec,
+ $dowrite && $wvec eq $fhvec,
+ $doxcept && $xvec eq $fhvec);
}
-#& ioctl($this, @args) : $scalar
-sub ioctl : locked method
+sub ioctl # $this, @args
{
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,4);
croak "Insufficient arguments to ${whoami}(@_), found"
if @_ < 3;
@@ -3085,9 +2778,9 @@ sub ioctl : locked method
CORE::ioctl($_[0], $_[1], $_[2]);
}
-#& fcntl($this, @args) : $scalar
-sub fcntl : locked method
+sub fcntl # $this, @args
{
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,4);
croak "Insufficient arguments to ${whoami}(@_), found"
if @_ < 3;
@@ -3096,8 +2789,7 @@ sub fcntl : locked method
CORE::fcntl($_[0], $_[1], $_[2]);
}
-#& format_addr($thunk, $sockaddr) : {$string | undef}
-sub format_addr
+sub format_addr # $thunk, $sockaddr
{
return undef unless defined $_[1];
my($rval,$fam,$addr);
@@ -3112,31 +2804,28 @@ sub format_addr
$rval;
}
-#& format_local_addr($this, [@args]) : {$string | undef}
-sub format_local_addr
+sub format_local_addr # $this, [@args]
{
my($self,@args) = @_;
$self->format_addr($self->getparam('srcaddr'),@args);
}
-#& format_remote_addr($this, [@args]) : {$string | undef}
-sub format_remote_addr
+sub format_remote_addr # $this, [@args]
{
my($self,@args) = @_;
$self->format_addr($self->getparam('dstaddr'),@args);
}
-#& new_from_fh(classname, $filehandle) : {$obj | undef}
-sub new_from_fh
+sub new_from_fh # classname, $filehandle
{
my $whoami = $_[0]->_trace(\@_,2);
my($pack) = @_;
+ $pack = ref $pack if ref $pack;
if (@_ != 2) {
croak "Invalid number of arguments to ${whoami}, called";
}
my ($fh,$rfh);
- eval {local $SIG{__DIE__}; local $SIG{__WARN__}; $fh=CORE::fileno($_[1])};
- unless(defined $fh) {
+ unless(defined(eval {$fh=CORE::fileno($_[1])})) {
if ($_[1] =~ /\D/ or !length($_[1])) {
croak "Invalid filehandle '$_[1]' in ${whoami}, called";
}
@@ -3152,36 +2841,36 @@ sub new_from_fh
}
return $self;
}
- $ {*$self}{'isopen'} = 1;
- $ {*$self}{'isconnected'} = 1 if getpeername($self);
+ ${*$self}{'isopen'} = 1;
+ ${*$self}{'isconnected'} = 1 if getpeername($self);
$rfh = getsockname($self);
if (defined $rfh and length $rfh) {
($fh, $rfh) = unpack_sockaddr($rfh);
- $ {*$self}{AF} = $fh if defined $fh and length $fh and $fh ne '0';
- $ {*$self}{'isbound'} = defined $rfh and $rfh =~ /[^\0]/;
+ ${*$self}{AF} = $fh if defined $fh and length $fh and $fh ne '0';
+ ${*$self}{'isbound'} = defined $rfh and $rfh =~ /[^\0]/;
}
($rfh) = $self->getsopt('SO_TYPE');
- $ {*$self}{type} = $rfh if defined $rfh;
+ ${*$self}{type} = $rfh if defined $rfh;
$self->getsockinfo;
$self->isopen && $self;
}
-#& accept($self) : {$new_obj | undef}
-sub accept
+sub accept # $self ; returns new (ref $self) or undef
{
my $whoami = $_[0]->_trace(\@_,2);
my($self) = @_;
carp "Excess args to ${whoami}(@_) ignored" if @_ > 1;
return undef unless $self->didlisten or $self->listen;
- my $ns = $self->new;
+ my $xclass = ref $self;
+ my $ns = $xclass->new;
return undef unless $ns;
$ns->stopio; # make sure we can use the filehandle
- $ {*$ns}{Parms} = { %{$ {*$self}{Parms}} };
+ ${*$ns}{Parms} = { %{${*$self}{Parms}} };
$ns->checkparams;
{
my ($timeout,$fhvec,$saveblocking) =
- ($ {*$self}{Parms}{'timeout'}, $ {*$self}{FHVec});
- if (defined $timeout and $ {*$self}{Parms}{'blocking'}) {
+ (${*$self}{Parms}{'timeout'}, ${*$self}{FHVec});
+ if (defined $timeout) {
$saveblocking = $self->param_saver('blocking');
$self->setparams({'blocking'=>0});
my $nfound = CORE::select($fhvec, undef, undef, $timeout);
@@ -3195,8 +2884,7 @@ sub accept
return $ns;
}
}
- $ {*$ns}{'isopen'} = $ {*$ns}{'isbound'} =
- $ {*$ns}{'isconnected'} = 1;
+ ${*$ns}{'isopen'} = ${*$ns}{'isbound'} = ${*$ns}{'isconnected'} = 1;
$ns->getsockinfo;
unless ($ns->isconnected) {
{
@@ -3210,9 +2898,8 @@ sub accept
$ns;
}
-#& RECV($self, $buf [,$maxlen] [,$flags]) : {$from | undef}
-sub RECV
-{
+sub RECV # $self, $buf [,$maxlen] [,$flags]
+{ # returns $from ( for tied-FH handling )
my ($from,$buf);
my $whoami = $_[0]->_trace(\@_,5);
croak "Invalid arguments to ${whoami}, called"
@@ -3223,18 +2910,18 @@ sub RECV
$from;
}
-#& TIEHANDLE($class, $host, $port [,\%options]) : {$new_obj | undef}
-sub TIEHANDLE
+sub TIEHANDLE # $class, $host, $port [,\%options]
{ # redirects via $class->new(...)
$_[0]->_trace(\@_,1);
my $class = shift;
my $self;
if (ref $class and defined fileno($class)) {
if ($class->isa(__PACKAGE__)) {
- $self = $class->new_from_fh(@_) || $class->new(@_);
+ $self = $class->new_from_fh($class,@_) || $class->new(@_);
}
else {
- $self = new_from_fh($class,@_) || new($class,@_);
+ $self = __PACKAGE__->new_from_fh($class,@_) ||
+ __PACKAGE__->new($class,@_);
}
}
else {
@@ -3243,9 +2930,8 @@ sub TIEHANDLE
}
}
-#& PRINTF($self, $format [,@args]) : boolean
-sub PRINTF
-{
+sub PRINTF # $self, $format [,@args]
+{ # returns boolean
$_[0]->_trace(\@_,5);
my $self = shift;
my $fmt = shift;
@@ -3253,9 +2939,8 @@ sub PRINTF
$self->PRINT(sprintf $fmt,@_);
}
-#& READ($self, $buffer, $length [,$offset]) : {$lenread | undef}
-sub READ
-{
+sub READ # $self, $buffer, $length [,$offset]
+{ # returns $lenread or undef
my $whoami = $_[0]->_trace(\@_,5);
croak "Invalid args to ${whoami}, called"
if @_ < 3 or @_ > 4 or !ref($_[0]);
@@ -3290,18 +2975,16 @@ sub READ
length($buf);
}
-#& GETC($self) : {$charstr | undef}
-sub GETC
-{
+sub GETC # $self
+{ # returns $charstr or undef
my $whoami = $_[0]->_trace(\@_,6);
carp "Excess arguments to ${whoami} ignored"
if @_ > 1;
$_[0]->recv(1,0);
}
-#& READLINE($self) : {$line | undef || @lines}
-sub READLINE
-{
+sub READLINE # $self
+{ # returns $line, @lines, or undef
return $_[0]->getline unless wantarray and defined($/);
my $whoami = $_[0]->_trace(\@_,5);
my $self = shift;
@@ -3311,8 +2994,7 @@ sub READLINE
@lines;
}
-#& getlines($self) : @lines
-sub getlines
+sub getlines # $self
{
my $whoami = $_[0]->_trace(\@_,6);
croak "Invalid call to $whoami" unless @_ == 1;
@@ -3321,8 +3003,7 @@ sub getlines
}
-#& sendto($self, $buf, $where, [$flags]) : boolean
-sub sendto
+sub sendto # $self, $buf, $where, [$flags] ; returns bool
{
my $whoami = $_[0]->_trace(\@_,3);
my($self,$buf,$whither,$flags) = @_;
@@ -3332,32 +3013,27 @@ sub sendto
carp "Excess arguments to ${whoami} ignored" if @_ > 4;
return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
$self->isopen or $self->open; # generate EBADF return if not open
- if ($ {*$self}{Parms}{netgen_fakeconnect}) {
- return $self->send($buf,$flags,$whither);
- }
CORE::send($self, $buf, $flags, $whither);
}
-#& EOF($self) : boolean
-sub EOF
+sub EOF # $self ; returns bool
{
my $whoami = $_[0]->_trace(\@_,3);
my ($self,$buf) = @_;
croak "Invalid args to ${whoami}, called" if @_ != 1 or !ref $self;
return getsockopt($self,SOL_SOCKET,SO_TYPE) unless
$self->isopen; # generate EBADF return if not open
- return 0 if defined $ {*$self}{sockLineBuf}; # not EOF if can read
- my $fhvec = $ {*$self}{FHVec};
+ return 0 if defined ${*$self}{sockLineBuf}; # not EOF if can still read
+ my $fhvec = ${*$self}{FHVec};
my $nfound = CORE::select($fhvec, undef, undef, 0);
return 0 unless $nfound;
$buf = $self->recv;
return 1 if ! $! and !defined $buf;
- $ {*$self}{sockLineBuf} = $buf;
+ ${*$self}{sockLineBuf} = $buf;
0;
}
-#& WRITE($self,$buffer,$len[,$offset]) : {$length | undef}
-sub WRITE
+sub WRITE # $self,$buffer,$len[,$offset] ; returns length
{
my $whoami = $_[0]->_trace(\@_,3);
my ($self,$buf,$len,$offset,$blen) = @_;
@@ -1,4502 +0,0 @@
-# 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: Inet.dat,v 1.26 2002/03/30 10:10:39 spider Exp $"
-
-package Net::Inet;
-use 5.004_04; # new minimum Perl version for this package
-
-use strict;
-# use Carp;
-sub croak { require Carp; goto &Carp::croak; }
-sub carp { require Carp; goto &Carp::carp; }
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
-
-
-BEGIN {
- $VERSION = '1.0';
- eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
-}
-
-use AutoLoader;
-#use Exporter ();
-use Net::Gen 1.0 qw(:ALL);
-use Socket qw(/^inet_/);
-
-BEGIN {
- @ISA = 'Net::Gen';
-
-# Items to export into callers namespace by default
-# (move infrequently used names to @EXPORT_OK below)
- @EXPORT = qw(
- INADDR_ALLHOSTS_GROUP
- INADDR_ALLRTRS_GROUP
- INADDR_ANY
- INADDR_BROADCAST
- INADDR_LOOPBACK
- INADDR_MAX_LOCAL_GROUP
- INADDR_NONE
- INADDR_UNSPEC_GROUP
- IPPORT_RESERVED
- IPPORT_USERRESERVED
- IPPORT_DYNAMIC
- IPPROTO_EGP
- IPPROTO_EON
- IPPROTO_GGP
- IPPROTO_HELLO
- IPPROTO_ICMP
- IPPROTO_IDP
- IPPROTO_IGMP
- IPPROTO_IP
- IPPROTO_IPIP
- IPPROTO_MAX
- IPPROTO_PUP
- IPPROTO_RAW
- IPPROTO_RSVP
- IPPROTO_TCP
- IPPROTO_TP
- IPPROTO_UDP
- htonl
- htons
- inet_addr
- inet_aton
- inet_ntoa
- ntohl
- ntohs
- );
-
-# Other items we are prepared to export if requested
- @EXPORT_OK = qw(
- DEFTTL
- ICMP_ADVLENMIN
- ICMP_ECHO
- ICMP_ECHOREPLY
- ICMP_INFOTYPE
- ICMP_IREQ
- ICMP_IREQREPLY
- ICMP_MASKLEN
- ICMP_MASKREPLY
- ICMP_MASKREQ
- ICMP_MAXTYPE
- ICMP_MINLEN
- ICMP_PARAMPROB
- ICMP_REDIRECT
- ICMP_REDIRECT_HOST
- ICMP_REDIRECT_NET
- ICMP_REDIRECT_TOSHOST
- ICMP_REDIRECT_TOSNET
- ICMP_SOURCEQUENCH
- ICMP_TIMXCEED
- ICMP_TIMXCEED_INTRANS
- ICMP_TIMXCEED_REASS
- ICMP_TSLEN
- ICMP_TSTAMP
- ICMP_TSTAMPREPLY
- ICMP_UNREACH
- ICMP_UNREACH_HOST
- ICMP_UNREACH_NEEDFRAG
- ICMP_UNREACH_NET
- ICMP_UNREACH_PORT
- ICMP_UNREACH_PROTOCOL
- ICMP_UNREACH_SRCFAIL
- IN_BADCLASS
- IN_CLASSA
- IN_CLASSA_HOST
- IN_CLASSA_MAX
- IN_CLASSA_NET
- IN_CLASSA_NSHIFT
- IN_CLASSA_SUBHOST
- IN_CLASSA_SUBNET
- IN_CLASSA_SUBNSHIFT
- IN_CLASSB
- IN_CLASSB_HOST
- IN_CLASSB_MAX
- IN_CLASSB_NET
- IN_CLASSB_NSHIFT
- IN_CLASSB_SUBHOST
- IN_CLASSB_SUBNET
- IN_CLASSB_SUBNSHIFT
- IN_CLASSC
- IN_CLASSC_HOST
- IN_CLASSC_MAX
- IN_CLASSC_NET
- IN_CLASSC_NSHIFT
- IN_CLASSD
- IN_CLASSD_HOST
- IN_CLASSD_NET
- IN_CLASSD_NSHIFT
- IN_EXPERIMENTAL
- IN_LOOPBACKNET
- IN_MULTICAST
- IPFRAGTTL
- IPOPT_CIPSO
- IPOPT_CLASS
- IPOPT_CONTROL
- IPOPT_COPIED
- IPOPT_DEBMEAS
- IPOPT_EOL
- IPOPT_LSRR
- IPOPT_MINOFF
- IPOPT_NOP
- IPOPT_NUMBER
- IPOPT_OFFSET
- IPOPT_OLEN
- IPOPT_OPTVAL
- IPOPT_RESERVED1
- IPOPT_RESERVED2
- IPOPT_RIPSO_AUX
- IPOPT_RR
- IPOPT_SATID
- IPOPT_SECURITY
- IPOPT_SECUR_CONFID
- IPOPT_SECUR_EFTO
- IPOPT_SECUR_MMMM
- IPOPT_SECUR_RESTR
- IPOPT_SECUR_SECRET
- IPOPT_SECUR_TOPSECRET
- IPOPT_SECUR_UNCLASS
- IPOPT_SSRR
- IPOPT_TS
- IPOPT_TS_PRESPEC
- IPOPT_TS_TSANDADDR
- IPOPT_TS_TSONLY
- IPPORT_TIMESERVER
- IPTOS_LOWDELAY
- IPTOS_PREC_CRITIC_ECP
- IPTOS_PREC_FLASH
- IPTOS_PREC_FLASHOVERRIDE
- IPTOS_PREC_IMMEDIATE
- IPTOS_PREC_INTERNETCONTROL
- IPTOS_PREC_NETCONTROL
- IPTOS_PREC_PRIORITY
- IPTOS_PREC_ROUTINE
- IPTOS_RELIABILITY
- IPTOS_THROUGHPUT
- IPTTLDEC
- IPVERSION
- IP_ADD_MEMBERSHIP
- IP_DEFAULT_MULTICAST_LOOP
- IP_DEFAULT_MULTICAST_TTL
- IP_DF
- IP_DROP_MEMBERSHIP
- IP_HDRINCL
- IP_MAXPACKET
- IP_MAX_MEMBERSHIPS
- IP_MF
- IP_MSS
- IP_MULTICAST_IF
- IP_MULTICAST_LOOP
- IP_MULTICAST_TTL
- IP_OPTIONS
- IP_RECVDSTADDR
- IP_RECVOPTS
- IP_RECVRETOPTS
- IP_RETOPTS
- IP_TOS
- IP_TTL
- MAXTTL
- MAX_IPOPTLEN
- MINTTL
- SUBNETSHIFT
- pack_sockaddr_in
- unpack_sockaddr_in
- );
-
- %EXPORT_TAGS = (
- sockopts => [qw(IP_HDRINCL IP_RECVDSTADDR IP_RECVOPTS
- IP_RECVRETOPTS IP_TOS IP_TTL IP_ADD_MEMBERSHIP
- IP_DROP_MEMBERSHIP IP_MULTICAST_IF
- IP_MULTICAST_LOOP IP_MULTICAST_TTL
- IP_OPTIONS IP_RETOPTS)],
- routines => [qw(pack_sockaddr_in unpack_sockaddr_in
- inet_ntoa inet_aton inet_addr
- htonl ntohl htons ntohs
- ICMP_INFOTYPE IN_BADCLASS
- IN_EXPERIMENTAL IN_MULTICAST
- IPOPT_CLASS IPOPT_COPIED IPOPT_NUMBER)],
- icmpvalues => [qw(ICMP_ADVLENMIN ICMP_ECHO ICMP_ECHOREPLY
- ICMP_IREQ ICMP_IREQREPLY ICMP_MASKLEN
- ICMP_MASKREPLY ICMP_MASKREQ ICMP_MAXTYPE
- ICMP_MINLEN ICMP_PARAMPROB ICMP_REDIRECT
- ICMP_REDIRECT_HOST ICMP_REDIRECT_NET
- ICMP_REDIRECT_TOSHOST ICMP_REDIRECT_TOSNET
- ICMP_SOURCEQUENCH ICMP_TIMXCEED
- ICMP_TIMXCEED_INTRANS ICMP_TIMXCEED_REASS
- ICMP_TSLEN ICMP_TSTAMP ICMP_TSTAMPREPLY
- ICMP_UNREACH ICMP_UNREACH_HOST
- ICMP_UNREACH_NEEDFRAG ICMP_UNREACH_NET
- ICMP_UNREACH_PORT ICMP_UNREACH_PROTOCOL
- ICMP_UNREACH_SRCFAIL)],
- ipoptions => [qw(IPOPT_CIPSO IPOPT_CONTROL IPOPT_DEBMEAS
- IPOPT_EOL IPOPT_LSRR IPOPT_MINOFF IPOPT_NOP
- IPOPT_OFFSET IPOPT_OLEN IPOPT_OPTVAL
- IPOPT_RESERVED1 IPOPT_RESERVED2
- IPOPT_RIPSO_AUX IPOPT_RR IPOPT_SATID
- IPOPT_SECURITY IPOPT_SECUR_CONFID
- IPOPT_SECUR_EFTO IPOPT_SECUR_MMMM
- IPOPT_SECUR_RESTR IPOPT_SECUR_SECRET
- IPOPT_SECUR_TOPSECRET IPOPT_SECUR_UNCLASS
- IPOPT_SSRR
- IPOPT_TS IPOPT_TS_PRESPEC
- IPOPT_TS_TSANDADDR IPOPT_TS_TSONLY
- MAX_IPOPTLEN)],
- iptosvalues => [qw(IPTOS_LOWDELAY IPTOS_PREC_CRITIC_ECP
- IPTOS_PREC_FLASH IPTOS_PREC_FLASHOVERRIDE
- IPTOS_PREC_IMMEDIATE IPTOS_PREC_INTERNETCONTROL
- IPTOS_PREC_NETCONTROL IPTOS_PREC_PRIORITY
- IPTOS_PREC_ROUTINE IPTOS_RELIABILITY
- IPTOS_THROUGHPUT)],
- protocolvalues => [qw(DEFTTL
- INADDR_ALLHOSTS_GROUP INADDR_ALLRTRS_GROUP
- INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK
- INADDR_MAX_LOCAL_GROUP INADDR_NONE
- INADDR_UNSPEC_GROUP
- IN_LOOPBACKNET
- IPPORT_RESERVED IPPORT_USERRESERVED
- IPPORT_DYNAMIC
- IPPROTO_EGP IPPROTO_EON IPPROTO_GGP
- IPPROTO_HELLO IPPROTO_ICMP IPPROTO_IDP
- IPPROTO_IGMP IPPROTO_IP IPPROTO_IPIP
- IPPROTO_MAX IPPROTO_PUP IPPROTO_RAW
- IPPROTO_RSVP IPPROTO_TCP IPPROTO_TP
- IPPROTO_UDP
- IPFRAGTTL
- IPTTLDEC IPVERSION
- IP_DF IP_MAXPACKET IP_MF IP_MSS
- MAXTTL MAX_IPOPTLEN MINTTL)],
- ipmulticast => [qw(IP_ADD_MEMBERSHIP IP_DEFAULT_MULTICAST_LOOP
- IP_DEFAULT_MULTICAST_TTL IP_DROP_MEMBERSHIP
- IP_MAX_MEMBERSHIPS IP_MULTICAST_IF
- IP_MULTICAST_LOOP IP_MULTICAST_TTL)],
- deprecated => [qw(IN_CLASSA_HOST IN_CLASSA_MAX IN_CLASSA_NET
- IN_CLASSA_NSHIFT IN_CLASSA_SUBHOST
- IN_CLASSA_SUBNET IN_CLASSA_SUBNSHIFT
- IN_CLASSB_HOST IN_CLASSB_MAX IN_CLASSB_NET
- IN_CLASSB_NSHIFT IN_CLASSB_SUBHOST
- IN_CLASSB_SUBNET IN_CLASSB_SUBNSHIFT
- IN_CLASSC_HOST IN_CLASSC_MAX IN_CLASSC_NET
- IN_CLASSC_NSHIFT
- IN_CLASSD_HOST IN_CLASSD_NET IN_CLASSD_NSHIFT
- IN_CLASSA IN_CLASSB IN_CLASSC IN_CLASSD
- IPPORT_TIMESERVER
- SUBNETSHIFT)],
- ALL => [@EXPORT, @EXPORT_OK],
- );
-
-}
-
-# sub AUTOLOAD inherited from Net::Gen
-
-# inherited autoload for 'regular' subroutines is being removed in
-# 5.003_96, so cheat a little.
-
-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 = (
- # socket options from the list above
- # simple booleans first
-
- 'IP_HDRINCL' => ['I'],
- 'IP_RECVDSTADDR' => ['I'],
- 'IP_RECVOPTS' => ['I'],
- 'IP_RECVRETOPTS' => ['I'],
-
- # simple integer options
-
- 'IP_TOS' => ['I'],
- 'IP_TTL' => ['I'],
-
- # structured options
-
- 'IP_ADD_MEMBERSHIP'=> ['a4a4'], # ip_mreq
- 'IP_DROP_MEMBERSHIP'=> ['a4a4'], # ip_mreq
- 'IP_MULTICAST_IF' => ['a4'], # inet_addr
- 'IP_MULTICAST_LOOP'=> ['C'], # u_char
- 'IP_MULTICAST_TTL' => ['C'], # u_char
- 'IP_OPTIONS' => ['a4C40'], # ip_options
- 'IP_RETOPTS' => ['a4C40'], # ip_options
-
- # out of known IP options
- );
-
-__PACKAGE__->initsockopts( IPPROTO_IP(), \%sockopts );
-
-#& htonl($number||@numbers) : $number || @numbers
-sub htonl
-{
- return unless defined wantarray;
- carp "Wrong number of arguments ($#_) to " . __PACKAGE__ . "::htonl, called"
- if @_ != 1 and !wantarray;
- unpack('N*', pack('L*', @_));
-}
-
-#& htons($number||@numbers) : $number || @numbers
-sub htons
-{
- return unless defined wantarray;
- carp "Wrong number of arguments ($#_) to " . __PACKAGE__ . "::htons, called"
- if @_ != 1 and !wantarray;
- unpack('n*', pack('S*', @_));
-}
-
-#& ntohl($number||@numbers) : $number || @numbers
-sub ntohl
-{
- return unless defined wantarray;
- carp "Wrong number of arguments ($#_) to " . __PACKAGE__ . "::ntohl, called"
- if @_ != 1 and !wantarray;
- unpack('L*', pack('N*', @_));
-}
-
-#& ntohs($number||@numbers) : $number || @numbers
-sub ntohs
-{
- return unless defined wantarray;
- carp "Wrong number of arguments ($#_) to " . __PACKAGE__ . "::ntohs, called"
- if @_ != 1 and !wantarray;
- unpack('S*', pack('n*', @_));
-}
-
-# removed inet_ntoa that was here -- the one in Socket is (now) good enough
-
-#& pack_sockaddr_in([$family,] $port, $in_addr) : $packed_addr
-sub pack_sockaddr_in ($$;$)
-{
- unshift(@_,AF_INET) if @_ == 2;
- _pack_sockaddr_in($_[0], $_[1], $_[2]);
-}
-
-# sub unpack_sockaddr_in is in XS code
-
-
-# Get the prototypes right for the autoloaded values, to avoid confusing
-# the caller's code with changes in prototypes.
-
-# sub inet_aton in Socket.xs
-
-sub inet_addr; # (helps with -w)
-*inet_addr = \&inet_aton; # same code for old interface
-
-
-my $debug = 0;
-
-#& _debug($this, [$newval]) : oldval
-#+attrs locked
-sub _debug
-{
- my ($this,$newval) = @_;
- return $this->debug($newval) if ref $this;
- my $prev = $debug;
- $debug = 0+$newval if defined $newval;
- $prev;
-}
-
-my %keyhandlers;
-my @hostkeys = qw(thishost desthost);
-@keyhandlers{@hostkeys} = (\&_sethost) x @hostkeys;
-my @portkeys = qw(thisservice thisport destservice destport);
-@keyhandlers{@portkeys} = (\&_setport) x @portkeys;
-my @protokeys = qw(IPproto proto);
-@keyhandlers{@protokeys} = (\&_setproto) x @protokeys;
-# Don't include "handled" keys in this list, since that's redundant.
-my @Keys = qw(lclhost lcladdr lclservice lclport
- remhost remaddr remservice remport);
-
-# leave these to be init'ed on the first new() call
-my (%Keys,%Sopts);
-
-#& new($class, [\%params]) : {$obj | undef}
-sub new
-{
- my $whoami = $_[0]->_trace(\@_,1);
- my($class,@Args,$self) = @_;
- $self = $class->SUPER::new(@Args);
- $class = ref $class if ref $class;
- $class->_trace(\@_,2,", self" .
- (defined $self ? "=$self" : " undefined") .
- " after sub-new");
- if ($self) {
- CORE::dump if $debug > 1 and
- ref $self ne $class || "$self" !~ /HASH/;
- # init object debug level
- $self->setparams({'debug'=>$debug},-1);
- if (%Keys) {
- $ {*$self}{Keys} = { %Keys } ;
- }
- else {
- # register our keys and their handlers
- $self->register_param_keys(\@Keys);
- $self->register_param_handlers(\%keyhandlers);
- %Keys = %{ $ {*$self}{Keys} } ;
- }
- if (%Sopts) {
- $ {*$self}{Sockopts} = { %Sopts } ;
- }
- else {
- # register our socket options
- $self->register_options('IPPROTO_IP', IPPROTO_IP(), \%sockopts);
- %Sopts = %{ $ {*$self}{Sockopts} } ;
- }
- # set our expected parameters
- $self->setparams({PF => PF_INET, AF => AF_INET},-1);
- if ($class eq __PACKAGE__) {
- unless ($self->init(@Args)) {
- local $!; # protect returned errno value
- undef $self; # against close problems inside perl
- undef $self; # another statement needed for sequencing
- }
- }
- if ($self) {
- $self->_trace(0,1," returning self=$self");
- }
- else {
- $class->_trace(0,1," returning self=(undef)");
- }
- }
- else {
- $class->_trace(0,1," returning self=(undef)");
- }
- $self;
-}
-
-#& _hostport($self, {'this'|'dest'}, [\]@list) : boolean
-sub _hostport
-{
- my($self,$which,@args,$aref) = @_;
- $aref = \@args; # assume in-line list unless proved otherwise
- $aref = $args[0] if @args == 1 && ref $args[0] && ref $args[0] eq 'ARRAY';
- return undef if $which ne 'dest' and $which ne 'this';
- if (@$aref) { # assume this is ('desthost','destport')
- my %p; # where we'll build the params list
- if (@$aref == 3 and ref($$aref[2]) and ref($$aref[2]) eq 'HASH') {
- %p = %{$$aref[2]};
- }
- else {
- %p = splice(@$aref,2); # assume valid params after
- }
- $p{"${which}host"} = $$aref[0] if defined $$aref[0];
- $p{"${which}port"} = $$aref[1] if defined $$aref[1];
- $self->setparams(\%p);
- }
- else {
- 1; # succeed vacuously if no work
- }
-}
-
-#& init($self, [\%params || @speclist]) : {$self | undef}
-#+attrs locked
-sub init
-{
- $_[0]->_trace(\@_,2);
- my($self,@args) = @_;
- return $self unless $self = $self->SUPER::init(@args);
- if (@args > 1 || @args == 1 && (!ref $args[0] || ref $args[0] ne 'HASH')) {
- return undef unless $self->_hostport('dest',@args);
- }
-# my @r; # dummy array needed in 5.000
-# if ((@r=$self->getparams([qw(type proto)],1)) == 4) { # have type and proto
- if ($self->getparams([qw(type proto)],1) == 4) { # have type and proto
- unless ($self->open) { # create the socket
- return undef; # and refuse to make less object than requested
- }
- }
- if ($self->getparam('srcaddrlist')) {
- # have enough object already to attempt the binding
- return undef unless $self->bind; # make no less object than requested
- }
- if ($self->getparam('dstaddrlist')) {
- # have enough object already to attempt the connection
- return undef unless $self->connect or
- $self->isconnecting and !$self->blocking;
- # make no less object than requested
- }
- # I think this is all we need here ?
- $self;
-}
-
-#& connect($self, [\]@([host],[port])) : boolean
-#+attrs locked method
-sub connect
-{
- my($self,@args) = @_;
- return undef if @args and not $self->_hostport('dest',@args);
- $self->SUPER::connect;
-}
-
-#& _sethost($self,$key,$newval) : {'' | "carp string"}
-sub _sethost
-{
- my($self,$key,$newval) = @_;
- return "Invalid args to " . __PACKAGE__ . "::_sethost(@_), called"
- if @_ != 3 or ref($ {*$self}{Keys}{$key}) ne 'CODE';
- # check for call from delparams
- if (!defined $newval) {
- my @delkeys;
- if ($key eq 'thishost') {
- @delkeys =
- qw(srcaddrlist srcaddr lclhost lcladdr lclport lclservice);
- }
- elsif ($key eq 'desthost') {
- @delkeys =
- qw(dstaddrlist dstaddr remhost remaddr remport remservice);
- }
- splice(@delkeys, 1) if @delkeys and $self->isconnected;
- $self->delparams(\@delkeys) if @delkeys;
- return ''; # ok to delete
- }
-
- # here we're really trying to set some kind of address (we think)
- my ($pkey,$port);
- ($pkey = $key) =~ s/host$/port/;
- my (@addrs,$addr,$cport);
- ($newval,$cport) = ($1,$2) if
- $newval =~ m/^(.+):([-\w]+(?:\(\d+\))?)$/;
- if ($newval =~ m/^(\[?)([a-fx.\d]+)(\]?)$/si) {
- return "Invalid address literal $newval found"
- if length($1) != length($3);
- $addr = inet_aton($2);
- }
- if (defined $addr and substr($newval, 0, 1) eq '[') {
- push(@addrs,$addr);
- $addr = '[' . inet_ntoa($addr) . ']';
- }
- else {
- my(@hinfo,$hname);
- $hname = $newval;
- do {
- @hinfo = gethostbyname($hname);
- } while (!@hinfo && $hname =~ s/\.$//);
- if (!@hinfo and defined $addr) {
- push(@addrs, $addr);
- $addr = inet_ntoa($addr);
- }
- else {
- return "Host $newval not found ($?)," unless @hinfo > 4;
- return "Host $newval has strange address family ($hinfo[2]),"
- if $self->getparam('AF',AF_INET,1) != $hinfo[2];
- @addrs = splice(@hinfo,4);
- $addr = $hinfo[0]; # save canonical name for real setup
- # just in case this is /etc/hosts or old sunos, try harder
- if ($addr !~ /.\../ and $hinfo[1]) {
- for $hname (split(' ',$hinfo[1])) {
- if ($hname =~ /.\../) {
- $addr = $hname;
- last;
- }
- }
- }
- }
- }
- # valid so far, get out if can't form addresses yet
- $port = $ {*$self}{Parms}{$pkey};
- return '' unless
- defined $cport or
- defined $port or
- $pkey eq 'thisport'; # allow for 'bind'
- if (defined $cport) {
- return $newval if $newval = &_setport($self,$pkey,$cport);
- $port = $cport;
- }
- $port = 0 unless defined $port;
- my $af = $self->getparam('AF',AF_INET,1);
- for (@addrs) {
- $_ = pack_sockaddr_in($af, $port+0, $_);
- }
- $pkey = (($key eq 'desthost') ? 'dstaddrlist' : 'srcaddrlist');
- $self->setparams({$pkey => [@addrs]});
- # finally, we have validation
- $_[2] = $addr; # update the canonical representation to store
- print STDERR " - " . __PACKAGE__ . "::_sethost $self $key ",
- $self->format_addr($addr,1),"\n"
- if $ {*$self}{Parms}{'debug'};
- ''; # return nullstring for goodness
-}
-
-# These port assignments were generated from IANA's list of assigned ports
-# as of 1997/05/17.
-
-my %udp_ports;
-
-my $udp_ports = "tcpmux 1
-rje 5
-echo 7
-discard 9
-null 9
-sink 9
-systat 11
-daytime 13
-netstat 15
-qotd 17
-quote 17
-msp 18
-chargen 19
-source 19
-ttytst 19
-ftp-data 20
-ftp 21
-ssh 22
-telnet 23
-mail 25
-smtp 25
-nsw-fe 27
-msg-icp 29
-msg-auth 31
-dsp 33
-time 37
-rap 38
-rlp 39
-graphics 41
-name 42
-nameserver 42
-nicname 43
-whois 43
-mpm-flags 44
-mpm 45
-mpm-snd 46
-ni-ftp 47
-auditd 48
-tacacs 49
-re-mail-ck 50
-la-maint 51
-xns-time 52
-dns 53
-domain 53
-xns-ch 54
-isi-gl 55
-xns-auth 56
-xns-mail 58
-ni-mail 61
-acas 62
-whois++ 63
-covia 64
-tacacs-ds 65
-sql*net 66
-bootp 67
-bootps 67
-bootpc 68
-tftp 69
-gopher 70
-netrjs-1 71
-netrjs-2 72
-netrjs-3 73
-netrjs-4 74
-deos 76
-vettcp 78
-finger 79
-http 80
-www 80
-www-http 80
-hosts2-ns 81
-xfer 82
-ctf 84
-mfcobol 86
-kerberos 88
-su-mit-tg 89
-dnsix 90
-mit-dov 91
-npp 92
-dcp 93
-objcall 94
-supdup 95
-dixie 96
-swift-rvf 97
-tacnews 98
-metagram 99
-hostname 101
-hostnames 101
-iso-tsap 102
-gppitnp 103
-acr-nema 104
-csnet-ns 105
-3com-tsmux 106
-rtelnet 107
-snagas 108
-pop2 109
-pop3 110
-sunrpc 111
-mcidas 112
-auth 113
-ident 113
-audionews 114
-sftp 115
-ansanotify 116
-uucp-path 117
-sqlserv 118
-nntp 119
-untp 119
-cfdptkt 120
-erpc 121
-smakynet 122
-ntp 123
-ansatrader 124
-locus-map 125
-unitary 126
-locus-con 127
-gss-xlicen 128
-pwdgen 129
-cisco-fna 130
-cisco-tna 131
-cisco-sys 132
-statsrv 133
-ingres-net 134
-epmap 135
-profile 136
-netbios-ns 137
-netbios-dgm 138
-netbios-ssn 139
-emfis-data 140
-emfis-cntl 141
-bl-idm 142
-imap 143
-news 144
-uaac 145
-iso-tp0 146
-iso-ip 147
-jargon 148
-aed-512 149
-sql-net 150
-hems 151
-bftp 152
-sgmp 153
-netsc-prod 154
-netsc-dev 155
-sqlsrv 156
-knet-cmp 157
-pcmail-srv 158
-nss-routing 159
-sgmp-traps 160
-snmp 161
-snmp-trap 162
-snmptrap 162
-cmip-man 163
-smip-agent 164
-xns-courier 165
-s-net 166
-namp 167
-snmp-rt 167
-rsvd 168
-send 169
-print-srv 170
-multiplex 171
-cl/1 172
-xyplex-mux 173
-mailq 174
-vmnet 175
-genrad-mux 176
-xdmcp 177
-nextstep 178
-bgp 179
-ris 180
-unify 181
-audit 182
-ocbinder 183
-ocserver 184
-remote-kis 185
-kis 186
-aci 187
-mumps 188
-qft 189
-cacp 190
-gacp 190
-prospero 191
-osu-nms 192
-srmp 193
-irc 194
-dn6-nlm-aud 195
-dn6-smm-red 196
-dlsold 197
-dls-mon 198
-smux 199
-src 200
-at-rtmp 201
-at-nbp 202
-at-3 203
-at-echo 204
-at-5 205
-at-zis 206
-at-7 207
-at-8 208
-qmtp 209
-z39.50 210
-914c/g 211
-anet 212
-ipx 213
-vmpwscs 214
-softpc 215
-cailic 216
-dbase 217
-mpp 218
-uarps 219
-imap3 220
-fln-spx 221
-rsh-spx 222
-cdc 223
-direct 242
-sur-meas 243
-dayna 244
-link 245
-dsp3270 246
-ibm-rap 256
-set 257
-yak-chat 258
-esro-gen 259
-openport 260
-nsiiops 261
-arcisdms 262
-hdap 263
-http-mgmt 280
-personal-link 281
-cableport-ax 282
-entrusttime 309
-pdap 344
-pawserv 345
-zserv 346
-fatserv 347
-csi-sgwp 348
-matip-type-a 350
-matip-type-b 351
-dtag-ste-sb 352
-clearcase 371
-ulistproc 372
-legent-1 373
-legent-2 374
-hassle 375
-nip 376
-tnetos 377
-dsetos 378
-is99c 379
-is99s 380
-hp-collector 381
-hp-managed-node 382
-hp-alarm-mgr 383
-arns 384
-ibm-app 385
-asa 386
-aurp 387
-unidata-ldm 388
-ldap 389
-uis 390
-synotics-relay 391
-synotics-broker 392
-dis 393
-embl-ndt 394
-netcp 395
-netware-ip 396
-mptn 397
-kryptolan 398
-iso-tsap-c2 399
-work-sol 400
-ups 401
-genie 402
-decap 403
-nced 404
-ncld 405
-imsp 406
-timbuktu 407
-prm-sm 408
-prm-nm 409
-decladebug 410
-rmt 411
-synoptics-trap 412
-smsp 413
-infoseek 414
-bnet 415
-silverplatter 416
-onmux 417
-hyper-g 418
-ariel1 419
-smpte 420
-ariel2 421
-ariel3 422
-opc-job-start 423
-opc-job-track 424
-icad-el 425
-smartsdp 426
-svrloc 427
-ocs_cmu 428
-ocs_amu 429
-utmpsd 430
-utmpcd 431
-iasd 432
-nnsp 433
-mobileip-agent 434
-mobilip-mn 435
-dna-cml 436
-comscm 437
-dsfgw 438
-dasp 439
-sgcp 440
-decvms-sysmgt 441
-cvc_hostd 442
-https 443
-shttp 443
-snpp 444
-microsoft-ds 445
-ddm-rdb 446
-ddm-dfm 447
-ddm-byte 448
-as-servermap 449
-tserver 450
-sfs-smp-net 451
-sfs-config 452
-creativeserver 453
-contentserver 454
-creativepartnr 455
-macon-udp 456
-scohelp 457
-appleqtc 458
-ampr-rcmd 459
-skronk 460
-datarampsrv 461
-datasurfsrv 461
-datarampsrvsec 462
-datasurfsrvsec 462
-alpes 463
-kpasswd 464
-smtps 465
-ssmtp 465
-digital-vrc 466
-mylex-mapd 467
-photuris 468
-rcp 469
-scx-proxy 470
-mondex 471
-ljk-login 472
-hybrid-pop 473
-tn-tl-w2 474
-tn-tl-fd1 476
-ss7ns 477
-spsc 478
-iafserver 479
-iafdbase 480
-ph 481
-bgs-nsi 482
-ulpnet 483
-integra-sme 484
-powerburst 485
-avian 486
-saft 487
-gss-http 488
-nest-protocol 489
-micom-pfs 490
-go-login 491
-ticf-1 492
-ticf-2 493
-pov-ray 494
-intecourier 495
-pim-rp-disc 496
-dantz 497
-siam 498
-iso-ill 499
-isakmp 500
-stmf 501
-asa-appl-proto 502
-intrinsa 503
-citadel 504
-mailbox-lm 505
-ohimsrv 506
-crs 507
-xvttp 508
-snare 509
-fcp 510
-firstclass 510
-mynet 511
-mynet-as 511
-biff 512
-comsat 512
-rwho 513
-who 513
-whod 513
-syslog 514
-printer 515
-spooler 515
-videotex 516
-otalk 517
-talk 517
-ntalk 518
-unixtime 519
-utime 519
-route 520
-routed 520
-router 520
-ripng 521
-ulp 522
-ncp 524
-timed 525
-timeserver 525
-newdate 526
-tempo 526
-stx 527
-custix 528
-courier 530
-rpc 530
-chat 531
-conference 531
-netnews 532
-readnews 532
-netwall 533
-mm-admin 534
-iiop 535
-opalis-rdv 536
-netmsp 537
-gdomap 538
-apertus-ldp 539
-uucp 540
-uucpd 540
-uucp-rlogin 541
-commerce 542
-klogin 543
-krcmd 544
-kshell 544
-appleqtcsrvr 545
-dhcpv6-client 546
-dhcpv6-server 547
-afpovertcp 548
-idfp 549
-new-rwho 550
-new-who 550
-cybercash 551
-deviceshare 552
-pirp 553
-rtsp 554
-dsf 555
-brfs 556
-remotefs 556
-rfs 556
-rfs_server 556
-openvms-sysipc 557
-sdnskmp 558
-teedtap 559
-rmonitor 560
-rmonitord 560
-monitor 561
-chcmd 562
-chshell 562
-nntps 563
-snntp 563
-9pfs 564
-whoami 565
-streettalk 566
-banyan-rpc 567
-ms-shuttle 568
-ms-rome 569
-demon 570
-meter_demon 570
-meterd 570
-meter 571
-udemon 571
-sonar 572
-banyan-vip 573
-ftp-agent 574
-vemmi 575
-ipcd 576
-vnas 577
-ipdd 578
-decbsrv 579
-sntp-heartbeat 580
-bdp 581
-scc-security 582
-philips-vc 583
-keyserver 584
-imap4-ssl 585
-password-chg 586
-submission 587
-ipcserver 600
-urm 606
-nqs 607
-sift-uft 608
-npmp-trap 609
-npmp-local 610
-npmp-gui 611
-hmmp-ind 612
-hmmp-op 613
-sshell 614
-sslshell 614
-sco-inetmgr 615
-sco-sysmgr 616
-sco-dtmgr 617
-dei-icda 618
-digital-evm 619
-sco-websrvrmgr 620
-escp-ip 621
-servstat 633
-ginad 634
-rlzdbase 635
-ldaps 636
-sldap 636
-lanserver 637
-doom 666
-mdqs 666
-disclose 667
-mecomm 668
-meregister 669
-vacdsm-sws 670
-vacdsm-app 671
-vpps-qua 672
-cimplex 673
-acap 674
-elcsd 704
-errlog 704
-agentx 705
-entrust-kmsh 709
-entrust-ash 710
-netviewdm1 729
-netviewdm2 730
-netviewdm3 731
-netgw 741
-netrcs 742
-flexlm 744
-fujitsu-dev 747
-ris-cm 748
-kerberos-adm 749
-kerberos-iv 750
-loadav 750
-pump 751
-qrh 752
-rrh 753
-tell 754
-nlogin 758
-con 759
-ns 760
-rxe 761
-quotad 762
-cycleserv 763
-omserv 764
-webster 765
-phone 767
-phonebook 767
-vid 769
-cadlock 770
-rtip 771
-cycleserv2 772
-notify 773
-acmaint_dbd 774
-acmaint_transd 775
-wpages 776
-wpgs 780
-concert 786
-mdbs_daemon 800
-device 801
-iclcnet-locate 886
-iclcnet_svinfo 887
-accessbuilder 888
-ftps-data 989
-ftps 990
-nas 991
-stelnet 992
-telnets 992
-imap4s 993
-imaps 993
-simap4 993
-ircs 994
-sirc 994
-pop3s 995
-spop3 995
-vsinet 996
-maitrd 997
-puparp 998
-applix 999
-puprouter 999
-ock 1000
-blackjack 1025
-iad1 1030
-iad2 1031
-iad3 1032
-neod1 1047
-neod2 1048
-nim 1058
-nimreg 1059
-instl_boots 1067
-instl_bootc 1068
-socks 1080
-ansoft-lm-1 1083
-ansoft-lm-2 1084
-nfsd-keepalive 1110
-lmsocialserver 1111
-murray 1123
-nfa 1155
-mc-client 1180
-lupa 1212
-nerv 1222
-hermes 1248
-bmc-patroldb 1313
-pdps 1314
-vpjp 1345
-alta-ana-lm 1346
-bbn-mmc 1347
-bbn-mmx 1348
-sbook 1349
-editbench 1350
-equationbuilder 1351
-lotusnote 1352
-relief 1353
-rightbrain 1354
-edge 1355
-intuitive 1355
-intuitive-edge 1355
-cuillamartin 1356
-pegboard 1357
-connlcli 1358
-ftsrv 1359
-mimer 1360
-linx 1361
-timeflies 1362
-ndm-requester 1363
-ndm-server 1364
-adapt-sna 1365
-netware-csp 1366
-dcs 1367
-screencast 1368
-gv-us 1369
-us-gv 1370
-fc-cli 1371
-fc-ser 1372
-chromagrafx 1373
-molly 1374
-bytex 1375
-ibm-pps 1376
-cichlid 1377
-elan 1378
-dbreporter 1379
-telesis-licman 1380
-apple-licman 1381
-gwha 1383
-os-licman 1384
-atex_elmd 1385
-checksum 1386
-cadsi-lm 1387
-objective-dbc 1388
-iclpv-dm 1389
-iclpv-sc 1390
-iclpv-sas 1391
-iclpv-pm 1392
-iclpv-nls 1393
-iclpv-nlc 1394
-iclpv-wsm 1395
-dvl-activemail 1396
-audio-activmail 1397
-video-activmail 1398
-cadkey-licman 1399
-cadkey-tablet 1400
-usim 1400
-goldleaf-licman 1401
-prm-sm-np 1402
-prm-nm-np 1403
-igi-lm 1404
-ibm-res 1405
-netlabs-lm 1406
-dbsa-lm 1407
-sophia-lm 1408
-here-lm 1409
-hiq 1410
-af 1411
-innosys 1412
-innosys-acl 1413
-ibm-mqseries 1414
-dbstar 1415
-novell-lu6.2 1416
-timbuktu-srv2 1418
-timbuktu-srv3 1419
-timbuktu-srv4 1420
-gandalf-lm 1421
-autodesk-lm 1422
-essbase 1423
-hybrid 1424
-zion-lm 1425
-sais 1426
-mloadd 1427
-informatik-lm 1428
-nms 1429
-tpdu 1430
-rgtp 1431
-blueberry-lm 1432
-ms-sql-s 1433
-ms-sql-m 1434
-ibm-cics 1435
-saism 1436
-tabula 1437
-eicon-server 1438
-eicon-x25 1439
-eicon-slp 1440
-cadis-1 1441
-cadis-2 1442
-ies-lm 1443
-marcam-lm 1444
-proxima-lm 1445
-ora-lm 1446
-apri-lm 1447
-oc-lm 1448
-peport 1449
-dwf 1450
-infoman 1451
-gtegsc-lm 1452
-genie-lm 1453
-esl-lm 1455
-dca 1456
-valisys-lm 1457
-nrcabq-lm 1458
-proshare1 1459
-proshare2 1460
-ibm_wrless_lan 1461
-world-lm 1462
-nucleus 1463
-msl_lmd 1464
-pipes 1465
-oceansoft-lm 1466
-aal-lm 1469
-uaiact 1470
-csdmbase 1471
-csdm 1472
-openmath 1473
-telefinder 1474
-taligent-lm 1475
-clvm-cfg 1476
-ms-sna-server 1477
-ms-sna-base 1478
-dberegister 1479
-pacerforum 1480
-airs 1481
-miteksys-lm 1482
-afs 1483
-confluent 1484
-lansource 1485
-nms_topo_serv 1486
-localinfosrvr 1487
-docstor 1488
-dmdocbroker 1489
-insitu-conf 1490
-anynetgateway 1491
-stone-design-1 1492
-netmap_lm 1493
-ica 1494
-cvc 1495
-liberty-lm 1496
-rfx-lm 1497
-watcom-sql 1498
-fhc 1499
-vlsi-lm 1500
-saiscm 1501
-shivadiscovery 1502
-databeam 1503
-imtc-mcs 1503
-evb-elm 1504
-funkproxy 1505
-utcd 1506
-symplex 1507
-diagmond 1508
-robcad-lm 1509
-mvx-lm 1510
-3l-l1 1511
-wins 1512
-fujitsu-dtc 1513
-fujitsu-dtcns 1514
-ifor-protocol 1515
-vpad 1516
-vpac 1517
-vpvd 1518
-vpvc 1519
-atm-zip-office 1520
-ncube-lm 1521
-cichild-lm 1523
-ingreslock 1524
-orasrv 1525
-prospero-np 1525
-pdap-np 1526
-tlisrv 1527
-mciautoreg 1528
-coauthor 1529
-rap-service 1530
-rap-listen 1531
-miroconnect 1532
-virtual-places 1533
-micromuse-lm 1534
-ampr-info 1535
-ampr-inter 1536
-sdsc-lm 1537
-3ds-lm 1538
-intellistor-lm 1539
-rds 1540
-rds2 1541
-gridgen-elmd 1542
-simba-cs 1543
-aspeclmd 1544
-vistium-share 1545
-abbaccuray 1546
-laplink 1547
-axon-lm 1548
-shivasound 1549
-3m-image-lm 1550
-hecmtl-db 1551
-pciarray 1552
-sna-cs 1553
-caci-lm 1554
-livelan 1555
-ashwin 1556
-arbortext-lm 1557
-xingmpeg 1558
-web2host 1559
-asci-val 1560
-facilityview 1561
-pconnectmgr 1562
-cadabra-lm 1563
-pay-per-view 1564
-windd 1565
-winddlb 1565
-corelvideo 1566
-jlicelmd 1567
-tsspmap 1568
-ets 1569
-orbixd 1570
-rdb-dbs-disp 1571
-chip-lm 1572
-itscomm-ns 1573
-mvel-lm 1574
-oraclenames 1575
-moldflow-lm 1576
-hypercube-lm 1577
-jacobus-lm 1578
-tn-tl-r2 1580
-vmf-msg-port 1581
-msims 1582
-simbaexpress 1583
-tn-tl-fd2 1584
-intv 1585
-ibm-abtact 1586
-pra_elmd 1587
-triquest-lm 1588
-vqp 1589
-gemini-lm 1590
-ncpm-pm 1591
-commonspace 1592
-mainsoft-lm 1593
-sixtrak 1594
-radio 1595
-radio-bc 1596
-orbplus-iiop 1597
-picknfs 1598
-simbaservices 1599
-issd 1600
-aas 1601
-dec-inspect 1602
-picodbc 1603
-icabrowser 1604
-slp 1605
-slm-api 1606
-stt 1607
-smart-lm 1608
-isysg-lm 1609
-taurus-wh 1610
-ill 1611
-netbill-trans 1612
-netbill-keyrep 1613
-netbill-cred 1614
-netbill-auth 1615
-netbill-prod 1616
-nimrod-agent 1617
-skytelnet 1618
-xs-openstorage 1619
-faxportwinport 1620
-softdataphone 1621
-ontime 1622
-jaleosnd 1623
-udp-sr-port 1624
-svs-omagent 1625
-cncp 1636
-cnap 1637
-cnip 1638
-cert-initiator 1639
-cert-responder 1640
-invision 1641
-isis-am 1642
-isis-ambc 1643
-datametrics 1645
-sa-msg-port 1646
-rsap 1647
-concurrent-lm 1648
-inspect 1649
-nkd 1650
-shiva_confsrvr 1651
-xnmp 1652
-alphatech-lm 1653
-stargatealerts 1654
-dec-mbadmin 1655
-dec-mbadmin-h 1656
-fujitsu-mmpdc 1657
-sixnetudr 1658
-sg-lm 1659
-skip-mc-gikreq 1660
-netview-aix-1 1661
-netview-aix-2 1662
-netview-aix-3 1663
-netview-aix-4 1664
-netview-aix-5 1665
-netview-aix-6 1666
-netview-aix-7 1667
-netview-aix-8 1668
-netview-aix-9 1669
-netview-aix-10 1670
-netview-aix-11 1671
-netview-aix-12 1672
-proshare-mc-1 1673
-proshare-mc-2 1674
-pdp 1675
-netcomm2 1676
-groupwise 1677
-prolink 1678
-darcorp-lm 1679
-microcom-sbp 1680
-sd-elmd 1681
-lanyon-lantern 1682
-ncpm-hip 1683
-snaresecure 1684
-n2nremote 1685
-cvmon 1686
-nsjtp-ctrl 1687
-nsjtp-data 1688
-firefox 1689
-ng-umds 1690
-empire-empuma 1691
-sstsys-lm 1692
-rrirtr 1693
-rrimwm 1694
-rrilwm 1695
-rrifmm 1696
-rrisat 1697
-rsvp-encap-1 1698
-rsvp-encap-2 1699
-mps-raft 1700
-l2f 1701
-deskshare 1702
-hb-engine 1703
-bcs-broker 1704
-slingshot 1705
-jetform 1706
-vdmplay 1707
-gat-lmd 1708
-centra 1709
-impera 1710
-pptconference 1711
-registrar 1712
-conferencetalk 1713
-sesi-lm 1714
-houdini-lm 1715
-xmsg 1716
-fj-hdnet 1717
-h323gatedisc 1718
-h323gatestat 1719
-h323hostcall 1720
-caicci 1721
-hks-lm 1722
-pptp 1723
-csbphonemaster 1724
-iden-ralp 1725
-winddx 1727
-telindus 1728
-citynl 1729
-roketz 1730
-msiccp 1731
-proxim 1732
-sipat 1733
-cambertx-lm 1734
-privatechat 1735
-street-stream 1736
-ultimad 1737
-gamegen1 1738
-webaccess 1739
-encore 1740
-cisco-net-mgmt 1741
-3com-nsd 1742
-cinegrfx-lm 1743
-ncpm-ft 1744
-remote-winsock 1745
-ftrapid-1 1746
-ftrapid-2 1747
-oracle-em1 1748
-aspen-services 1749
-sslp 1750
-swiftnet 1751
-lofr-lm 1752
-translogic-lm 1753
-oracle-em2 1754
-ms-streaming 1755
-capfast-lmd 1756
-cnhrp 1757
-tftp-mcast 1758
-spss-lm 1759
-www-ldap-gw 1760
-cft-0 1761
-cft-1 1762
-cft-2 1763
-cft-3 1764
-cft-4 1765
-cft-5 1766
-cft-6 1767
-cft-7 1768
-bmc-net-adm 1769
-bmc-net-svc 1770
-vaultbase 1771
-essweb-gw 1772
-kmscontrol 1773
-global-dtserv 1774
-femis 1776
-powerguardian 1777
-prodigy-internet 1778
-pharmasoft 1779
-dpkeyserv 1780
-answersoft-lm 1781
-hp-hcip 1782
-fjris 1783
-finle-lm 1784
-windlm 1785
-funk-logger 1786
-funk-license 1787
-psmond 1788
-hello 1789
-nmsp 1790
-ea1 1791
-ibm-dt-2 1792
-rsc-robot 1793
-cera-bcm 1794
-dpi-proxy 1795
-vocaltec-admin 1796
-uma 1797
-etp 1798
-netrisk 1799
-ansys-lm 1800
-msmq 1801
-concomp1 1802
-hp-hcip-gwy 1803
-enl 1804
-enl-name 1805
-musiconline 1806
-fhsp 1807
-oracle-vp2 1808
-oracle-vp1 1809
-jerand-lm 1810
-scientia-sdb 1811
-radius 1812
-radius-acct 1813
-tdp-suite 1814
-mmpft 1815
-etftp 1818
-plato-lm 1819
-mcagent 1820
-donnyworld 1821
-es-elmd 1822
-unisys-lm 1823
-metrics-pas 1824
-fjicl-tep-a 1901
-fjicl-tep-b 1902
-linkname 1903
-fjicl-tep-c 1904
-sugp 1905
-tpmd 1906
-tportmapperreq 1906
-intrastar 1907
-dawn 1908
-global-wlink 1909
-armadp 1913
-elm-momentum 1914
-facelink 1915
-persoft 1916
-noagent 1917
-can-nds 1918
-can-dch 1919
-can-ferret 1920
-close-combat 1944
-dialogic-elmd 1945
-tekpls 1946
-eye2eye 1948
-ismaeasdaqlive 1949
-ismaeasdaqtest 1950
-bcs-lmserver 1951
-dlsrap 1973
-foliocorp 1985
-licensedaemon 1986
-tr-rsrb-p1 1987
-tr-rsrb-p2 1988
-mshnet 1989
-tr-rsrb-p3 1989
-stun-p1 1990
-stun-p2 1991
-ipsendmsg 1992
-stun-p3 1992
-snmp-tcp-port 1993
-stun-port 1994
-perf-port 1995
-tr-rsrb-port 1996
-gdp-port 1997
-x25-svc-port 1998
-tcp-id-port 1999
-callbook 2000
-curry 2001
-wizard 2001
-globe 2002
-emce 2004
-oracle 2005
-raid 2006
-raid-cc 2006
-raid-am 2007
-terminaldb 2008
-whosockami 2009
-pipe_server 2010
-servserv 2011
-raid-ac 2012
-raid-cd 2013
-raid-sf 2014
-raid-cs 2015
-bootserver 2016
-bootclient 2017
-rellpack 2018
-about 2019
-xinupageserver 2020
-xinuexpansion1 2021
-xinuexpansion2 2022
-xinuexpansion3 2023
-xinuexpansion4 2024
-xribs 2025
-scrabble 2026
-shadowserver 2027
-submitserver 2028
-device2 2030
-blackboard 2032
-glogger 2033
-scoremgr 2034
-imsldoc 2035
-objectmanager 2038
-lam 2040
-interbase 2041
-isis 2042
-isis-bcast 2043
-rimsl 2044
-cdfunc 2045
-sdfunc 2046
-dls 2047
-dls-monitor 2048
-nfs 2049
-shilp 2049
-dlsrpn 2065
-dlswpn 2067
-zephyr-srv 2102
-zephyr-clt 2103
-zephyr-hm 2104
-minipay 2105
-mc-gt-srv 2180
-ats 2201
-imtc-map 2202
-kali 2213
-unreg-ab1 2221
-unreg-ab2 2222
-inreg-ab3 2223
-ivs-video 2232
-infocrypt 2233
-directplay 2234
-sercomm-wlink 2235
-nani 2236
-optech-port1-lm 2237
-aviva-sna 2238
-imagequery 2239
-ivsd 2241
-xmquery 2279
-lnvpoller 2280
-lnvconsole 2281
-lnvalarm 2282
-lnvstatus 2283
-lnvmaps 2284
-lnvmailmon 2285
-nas-metering 2286
-dna 2287
-netml 2288
-pehelp 2307
-sdhelp 2308
-cvspserver 2401
-rtsserv 2500
-rtsclient 2501
-netrek 2592
-tqdata 2700
-www-dev 2784
-aic-np 2785
-aic-oncrpc 2786
-piccolo 2787
-fryeserv 2788
-media-agent 2789
-mao 2908
-funk-dialout 2909
-tdaccess 2910
-blockade 2911
-epicon 2912
-hbci 3000
-redwood-broker 3001
-exlm-agent 3002
-ping-pong 3010
-trusted-web 3011
-hlserver 3047
-pctrader 3048
-nsws 3049
-vmodem 3141
-rdc-wh-eos 3142
-seaview 3143
-tarantella 3144
-csi-lfap 3145
-mc-brk-srv 3180
-ccmail 3264
-altav-tunnel 3265
-ns-cfg-server 3266
-ibm-dial-out 3267
-msft-gc 3268
-msft-gc-ssl 3269
-verismart 3270
-csoft-prev 3271
-user-manager 3272
-sxmp 3273
-ordinox-server 3274
-samd 3275
-maxim-asics 3276
-dec-notes 3333
-bmap 3421
-prsvp 3455
-vat 3456
-vat-control 3457
-d3winosfi 3458
-integral 3459
-udt_os 3900
-mapper-nodemgr 3984
-mapper-mapethd 3985
-mapper-ws_ethd 3986
-terabase 4000
-netcheque 4008
-chimera-hwm 4009
-samsung-unidex 4010
-altserviceboot 4011
-pda-gate 4012
-acl-manager 4013
-nuts_dem 4132
-nuts_bootp 4133
-nifty-hmi 4134
-oirtgsvc 4141
-oidocsvc 4142
-oidsr 4143
-rwhois 4321
-unicall 4343
-vinainstall 4344
-krb524 4444
-nv-video 4444
-upnotifyp 4445
-n1-fwp 4446
-n1-rmgmt 4447
-asc-slmd 4448
-arcryptoip 4449
-camp 4450
-ctisystemmsg 4451
-ctiprogramload 4452
-nssalertmgr 4453
-nssagentmgr 4454
-sae-urn 4500
-urn-x-cdchoice 4501
-rfa 4672
-commplex-main 5000
-commplex-link 5001
-rfe 5002
-claris-fmpro 5003
-avt-profile-1 5004
-avt-profile-2 5005
-telelpathstart 5010
-telelpathattack 5011
-zenginkyo-1 5020
-zenginkyo-2 5021
-mmcc 5050
-rmonitor_secure 5145
-atmp 5150
-aol 5190
-aol-1 5191
-aol-2 5192
-aol-3 5193
-padl2sim 5236
-hacl-hb 5300
-hacl-gs 5301
-hacl-cfg 5302
-hacl-probe 5303
-hacl-local 5304
-hacl-test 5305
-sun-mc-grp 5306
-sco-aip 5307
-cfengine 5308
-jprinter 5309
-outlaws 5310
-tmlogin 5311
-excerpt 5400
-excerpts 5401
-mftp 5402
-hpoms-ci-lstn 5403
-hpoms-dps-lstn 5404
-netsupport 5405
-systemics-sox 5406
-foresyte-clear 5407
-foresyte-sec 5408
-salient-dtasrv 5409
-salient-usrmgr 5410
-actnet 5411
-continuus 5412
-wwiotalk 5413
-statusd 5414
-ns-server 5415
-sns-gateway 5416
-sns-agent 5417
-mcntp 5418
-dj-ice 5419
-cylink-c 5420
-personal-agent 5555
-esmmanager 5600
-esmagent 5601
-a1-msc 5602
-a1-bs 5603
-a3-sdunode 5604
-a4-sdunode 5605
-pcanywheredata 5631
-pcanywherestat 5632
-rrac 5678
-dccm 5679
-proshareaudio 5713
-prosharevideo 5714
-prosharedata 5715
-prosharerequest 5716
-prosharenotify 5717
-openmail 5729
-fcopy-server 5745
-openmailg 5755
-x500ms 5757
-openmailns 5766
-s-openmail 5767
-x11 6000
-softcm 6110
-spc 6111
-dtspcd 6112
-backup-express 6123
-meta-corp 6141
-aspentec-lm 6142
-watershed-lm 6143
-statsci1-lm 6144
-statsci2-lm 6145
-lonewolf-lm 6146
-montage-lm 6147
-tal-pod 6149
-crip 6253
-clariion-evr01 6389
-lvision-lm 6471
-xdsxdm 6558
-vocaltec-gold 6670
-vision_server 6672
-vision_elmd 6673
-ambit-lm 6831
-acmsoda 6969
-afs3-fileserver 7000
-afs3-callback 7001
-afs3-prserver 7002
-afs3-vlserver 7003
-afs3-kaserver 7004
-afs3-volser 7005
-afs3-errors 7006
-afs3-bos 7007
-afs3-update 7008
-afs3-rmtsys 7009
-ups-onlinet 7010
-lazy-ptop 7099
-font-service 7100
-fodms 7200
-dlip 7201
-winqedit 7395
-pmdmgr 7426
-oveadmgr 7427
-ovladmgr 7428
-opi-sock 7429
-xmpv7 7430
-pmd 7431
-telops-lmd 7491
-pafec-lm 7511
-cbt 7777
-accu-lmgr 7781
-quest-vista 7980
-irdmi2 7999
-irdmi 8000
-pro-ed 8032
-npmp 8450
-ddi-udp-1 8888
-ddi-udp-2 8889
-ddi-udp-3 8890
-ddi-udp-4 8891
-ddi-udp-5 8892
-ddi-udp-6 8893
-ddi-udp-7 8894
-cslistener 9000
-man 9535
-sd 9876
-distinct32 9998
-distinct 9999
-ndmp 10000
-tsaf 12753
-dsmcc-config 13818
-dsmcc-session 13819
-dsmcc-passthru 13820
-dsmcc-download 13821
-dsmcc-ccp 13822
-isode-dua 17007
-biimenu 18000
-webphone 21845
-netspeak-is 21846
-netspeak-cs 21847
-netspeak-acd 21848
-netspeak-cps 21849
-wnn6 22273
-vocaltec-phone 22555
-aws-brf 22800
-brf-gw 22951
-icl-twobase1 25000
-icl-twobase2 25001
-icl-twobase3 25002
-icl-twobase4 25003
-icl-twobase5 25004
-icl-twobase6 25005
-icl-twobase7 25006
-icl-twobase8 25007
-icl-twobase9 25008
-icl-twobase10 25009
-vocaltec-hos 25793
-wnn6-ds 26208
-dbbrowse 47557
-alc 47806
-ap 47806
-bacnet 47808
-";
-
-my %tcp_ports;
-
-my $tcp_ports = "tcpmux 1
-rje 5
-echo 7
-discard 9
-null 9
-sink 9
-systat 11
-daytime 13
-netstat 15
-qotd 17
-quote 17
-msp 18
-chargen 19
-source 19
-ttytst 19
-ftp-data 20
-ftp 21
-ssh 22
-telnet 23
-mail 25
-smtp 25
-nsw-fe 27
-msg-icp 29
-msg-auth 31
-dsp 33
-time 37
-rap 38
-rlp 39
-graphics 41
-name 42
-nameserver 42
-nicname 43
-whois 43
-mpm-flags 44
-mpm 45
-mpm-snd 46
-ni-ftp 47
-auditd 48
-tacacs 49
-re-mail-ck 50
-la-maint 51
-xns-time 52
-dns 53
-domain 53
-xns-ch 54
-isi-gl 55
-xns-auth 56
-xns-mail 58
-ni-mail 61
-acas 62
-whois++ 63
-covia 64
-tacacs-ds 65
-sql*net 66
-bootp 67
-bootps 67
-bootpc 68
-tftp 69
-gopher 70
-netrjs-1 71
-netrjs-2 72
-netrjs-3 73
-netrjs-4 74
-deos 76
-vettcp 78
-finger 79
-http 80
-www 80
-www-http 80
-hosts2-ns 81
-xfer 82
-ctf 84
-mfcobol 86
-kerberos 88
-su-mit-tg 89
-dnsix 90
-mit-dov 91
-npp 92
-dcp 93
-objcall 94
-supdup 95
-dixie 96
-swift-rvf 97
-tacnews 98
-metagram 99
-newacct 100
-hostname 101
-hostnames 101
-iso-tsap 102
-gppitnp 103
-acr-nema 104
-csnet-ns 105
-cso 105
-3com-tsmux 106
-rtelnet 107
-snagas 108
-pop2 109
-pop3 110
-sunrpc 111
-mcidas 112
-auth 113
-ident 113
-audionews 114
-sftp 115
-ansanotify 116
-uucp-path 117
-sqlserv 118
-nntp 119
-cfdptkt 120
-erpc 121
-smakynet 122
-ntp 123
-ansatrader 124
-locus-map 125
-unitary 126
-locus-con 127
-gss-xlicen 128
-pwdgen 129
-cisco-fna 130
-cisco-tna 131
-cisco-sys 132
-statsrv 133
-ingres-net 134
-epmap 135
-profile 136
-netbios-ns 137
-netbios-dgm 138
-netbios-ssn 139
-emfis-data 140
-emfis-cntl 141
-bl-idm 142
-imap 143
-news 144
-uaac 145
-iso-tp0 146
-iso-ip 147
-jargon 148
-aed-512 149
-sql-net 150
-hems 151
-bftp 152
-sgmp 153
-netsc-prod 154
-netsc-dev 155
-sqlsrv 156
-knet-cmp 157
-pcmail-srv 158
-nss-routing 159
-sgmp-traps 160
-snmp 161
-snmptrap 162
-cmip-man 163
-cmip-agent 164
-xns-courier 165
-s-net 166
-namp 167
-rsvd 168
-send 169
-print-srv 170
-multiplex 171
-cl/1 172
-xyplex-mux 173
-mailq 174
-vmnet 175
-genrad-mux 176
-xdmcp 177
-nextstep 178
-bgp 179
-ris 180
-unify 181
-audit 182
-ocbinder 183
-ocserver 184
-remote-kis 185
-kis 186
-aci 187
-mumps 188
-qft 189
-gacp 190
-prospero 191
-osu-nms 192
-srmp 193
-irc 194
-dn6-nlm-aud 195
-dn6-smm-red 196
-dlsold 197
-dls-mon 198
-smux 199
-src 200
-at-rtmp 201
-at-nbp 202
-at-3 203
-at-echo 204
-at-5 205
-at-zis 206
-at-7 207
-at-8 208
-qmtp 209
-z39.50 210
-914c/g 211
-anet 212
-ipx 213
-vmpwscs 214
-softpc 215
-cailic 216
-dbase 217
-mpp 218
-uarps 219
-imap3 220
-fln-spx 221
-rsh-spx 222
-cdc 223
-direct 242
-sur-meas 243
-dayna 244
-link 245
-dsp3270 246
-ibm-rap 256
-set 257
-yak-chat 258
-esro-gen 259
-openport 260
-nsiiops 261
-arcisdms 262
-hdap 263
-http-mgmt 280
-personal-link 281
-cableport-ax 282
-entrusttime 309
-pdap 344
-pawserv 345
-zserv 346
-fatserv 347
-csi-sgwp 348
-matip-type-a 350
-matip-type-b 351
-dtag-ste-sb 352
-clearcase 371
-ulistproc 372
-legent-1 373
-legent-2 374
-hassle 375
-nip 376
-tnetos 377
-dsetos 378
-is99c 379
-is99s 380
-hp-collector 381
-hp-managed-node 382
-hp-alarm-mgr 383
-arns 384
-ibm-app 385
-asa 386
-aurp 387
-unidata-ldm 388
-ldap 389
-uis 390
-synotics-relay 391
-synotics-broker 392
-dis 393
-embl-ndt 394
-netcp 395
-netware-ip 396
-mptn 397
-kryptolan 398
-iso-tsap-c2 399
-work-sol 400
-ups 401
-genie 402
-decap 403
-nced 404
-ncld 405
-imsp 406
-timbuktu 407
-prm-sm 408
-prm-nm 409
-decladebug 410
-rmt 411
-synoptics-trap 412
-smsp 413
-infoseek 414
-bnet 415
-silverplatter 416
-onmux 417
-hyper-g 418
-ariel1 419
-smpte 420
-ariel2 421
-ariel3 422
-opc-job-start 423
-opc-job-track 424
-icad-el 425
-smartsdp 426
-svrloc 427
-ocs_cmu 428
-ocs_amu 429
-utmpsd 430
-utmpcd 431
-iasd 432
-nnsp 433
-mobileip-agent 434
-mobilip-mn 435
-dna-cml 436
-comscm 437
-dsfgw 438
-dasp 439
-sgcp 440
-decvms-sysmgt 441
-cvc_hostd 442
-https 443
-shttp 443
-snpp 444
-microsoft-ds 445
-ddm-rdb 446
-ddm-dfm 447
-ddm-rfm 447
-ddm-byte 448
-as-servermap 449
-tserver 450
-sfs-smp-net 451
-sfs-config 452
-creativeserver 453
-contentserver 454
-creativepartnr 455
-macon-tcp 456
-scohelp 457
-appleqtc 458
-ampr-rcmd 459
-skronk 460
-datarampsrv 461
-datasurfsrv 461
-datarampsrvsec 462
-datasurfsrvsec 462
-alpes 463
-kpasswd 464
-smtps 465
-ssmtp 465
-digital-vrc 466
-mylex-mapd 467
-photuris 468
-rcp 469
-scx-proxy 470
-mondex 471
-ljk-login 472
-hybrid-pop 473
-tn-tl-w1 474
-tcpnethaspsrv 475
-tn-tl-fd1 476
-ss7ns 477
-spsc 478
-iafserver 479
-iafdbase 480
-ph 481
-bgs-nsi 482
-ulpnet 483
-integra-sme 484
-powerburst 485
-avian 486
-saft 487
-gss-http 488
-nest-protocol 489
-micom-pfs 490
-go-login 491
-ticf-1 492
-ticf-2 493
-pov-ray 494
-intecourier 495
-pim-rp-disc 496
-dantz 497
-siam 498
-iso-ill 499
-isakmp 500
-stmf 501
-asa-appl-proto 502
-intrinsa 503
-citadel 504
-mailbox-lm 505
-ohimsrv 506
-crs 507
-xvttp 508
-snare 509
-fcp 510
-firstclass 510
-mynet 511
-mynet-as 511
-exec 512
-login 513
-cmd 514
-rcmd 514
-shell 514
-printer 515
-spooler 515
-videotex 516
-otalk 517
-talk 517
-ntalk 518
-unixtime 519
-utime 519
-efs 520
-ripng 521
-ulp 522
-ibm-db2 523
-ncp 524
-timed 525
-timeserver 525
-newdate 526
-tempo 526
-stx 527
-custix 528
-irc-serv 529
-courier 530
-rpc 530
-chat 531
-conference 531
-netnews 532
-readnews 532
-netwall 533
-mm-admin 534
-iiop 535
-opalis-rdv 536
-netmsp 537
-gdomap 538
-apertus-ldp 539
-uucp 540
-uucpd 540
-uucp-rlogin 541
-commerce 542
-klogin 543
-krcmd 544
-kshell 544
-appleqtcsrvr 545
-dhcpv6-client 546
-dhcpv6-server 547
-afpovertcp 548
-idfp 549
-new-rwho 550
-new-who 550
-cybercash 551
-deviceshare 552
-pirp 553
-rtsp 554
-dsf 555
-brfs 556
-remotefs 556
-rfs 556
-rfs_server 556
-openvms-sysipc 557
-sdnskmp 558
-teedtap 559
-rmonitor 560
-rmonitord 560
-monitor 561
-chcmd 562
-chshell 562
-nntps 563
-snntp 563
-9pfs 564
-whoami 565
-streettalk 566
-banyan-rpc 567
-ms-shuttle 568
-ms-rome 569
-demon 570
-meterd 570
-meter 571
-udemon 571
-sonar 572
-banyan-vip 573
-ftp-agent 574
-vemmi 575
-ipcd 576
-vnas 577
-ipdd 578
-decbsrv 579
-sntp-heartbeat 580
-bdp 581
-scc-security 582
-philips-vc 583
-keyserver 584
-imap4-ssl 585
-password-chg 586
-submission 587
-ipcserver 600
-urm 606
-nqs 607
-sift-uft 608
-npmp-trap 609
-npmp-local 610
-npmp-gui 611
-hmmp-ind 612
-hmmp-op 613
-sshell 614
-sslshell 614
-sco-inetmgr 615
-sco-sysmgr 616
-sco-dtmgr 617
-dei-icda 618
-digital-evm 619
-sco-websrvrmgr 620
-escp 621
-escp-ip 621
-servstat 633
-ginad 634
-rlzdbase 635
-ldaps 636
-sldap 636
-lanserver 637
-doom 666
-mdqs 666
-disclose 667
-mecomm 668
-meregister 669
-vacdsm-sws 670
-vacdsm-app 671
-vpps-qua 672
-cimplex 673
-acap 674
-elcsd 704
-errlog 704
-agentx 705
-entrust-kmsh 709
-entrust-ash 710
-netviewdm1 729
-netviewdm2 730
-netviewdm3 731
-netgw 741
-netrcs 742
-flexlm 744
-fujitsu-dev 747
-ris-cm 748
-kerberos-adm 749
-rfile 750
-pump 751
-qrh 752
-rrh 753
-tell 754
-nlogin 758
-con 759
-ns 760
-rxe 761
-quotad 762
-cycleserv 763
-omserv 764
-webster 765
-phone 767
-phonebook 767
-vid 769
-cadlock 770
-rtip 771
-cycleserv2 772
-submit 773
-rpasswd 774
-entomb 775
-wpages 776
-wpgs 780
-concert 786
-mdbs_daemon 800
-device 801
-iclcnet-locate 886
-iclcnet_svinfo 887
-accessbuilder 888
-xact-backup 911
-ftps-data 989
-ftps 990
-nas 991
-telnets 992
-imaps 993
-ircs 994
-pop3s 995
-spop3 995
-vsinet 996
-maitrd 997
-busboy 998
-garcon 999
-puprouter 999
-ock 1000
-blackjack 1025
-iad1 1030
-iad2 1031
-iad3 1032
-neod1 1047
-neod2 1048
-nim 1058
-nimreg 1059
-instl_boots 1067
-instl_bootc 1068
-socks 1080
-ansoft-lm-1 1083
-ansoft-lm-2 1084
-nfsd-status 1110
-lmsocialserver 1111
-murray 1123
-nfa 1155
-mc-client 1180
-lupa 1212
-nerv 1222
-hermes 1248
-bmc_patroldb 1313
-pdps 1314
-vpjp 1345
-alta-ana-lm 1346
-bbn-mmc 1347
-bbn-mmx 1348
-sbook 1349
-editbench 1350
-equationbuilder 1351
-lotusnote 1352
-relief 1353
-rightbrain 1354
-edge 1355
-intuitive 1355
-intuitive-edge 1355
-cuillamartin 1356
-pegboard 1357
-connlcli 1358
-ftsrv 1359
-mimer 1360
-linx 1361
-timeflies 1362
-ndm-requester 1363
-ndm-server 1364
-adapt-sna 1365
-netware-csp 1366
-dcs 1367
-screencast 1368
-gv-us 1369
-us-gv 1370
-fc-cli 1371
-fc-ser 1372
-chromagrafx 1373
-molly 1374
-bytex 1375
-ibm-pps 1376
-cichlid 1377
-elan 1378
-dbreporter 1379
-telesis-licman 1380
-apple-licman 1381
-gwha 1383
-os-licman 1384
-atex_elmd 1385
-checksum 1386
-cadsi-lm 1387
-objective-dbc 1388
-iclpv-dm 1389
-iclpv-sc 1390
-iclpv-sas 1391
-iclpv-pm 1392
-iclpv-nls 1393
-iclpv-nlc 1394
-iclpv-wsm 1395
-dvl-activemail 1396
-audio-activmail 1397
-video-activmail 1398
-cadkey-licman 1399
-cadkey-tablet 1400
-goldleaf-licman 1401
-prm-sm-np 1402
-prm-nm-np 1403
-igi-lm 1404
-ibm-res 1405
-netlabs-lm 1406
-dbsa-lm 1407
-sophia-lm 1408
-here-lm 1409
-hiq 1410
-af 1411
-innosys 1412
-innosys-acl 1413
-ibm-mqseries 1414
-dbstar 1415
-novell-lu6.2 1416
-timbuktu-srv1 1417
-timbuktu-srv2 1418
-timbuktu-srv3 1419
-timbuktu-srv4 1420
-gandalf-lm 1421
-autodesk-lm 1422
-essbase 1423
-hybrid 1424
-zion-lm 1425
-sais 1426
-mloadd 1427
-informatik-lm 1428
-nms 1429
-tpdu 1430
-rgtp 1431
-blueberry-lm 1432
-ms-sql-s 1433
-ms-sql-m 1434
-ibm-cics 1435
-saism 1436
-tabula 1437
-eicon-server 1438
-eicon-x25 1439
-eicon-slp 1440
-cadis-1 1441
-cadis-2 1442
-ies-lm 1443
-marcam-lm 1444
-proxima-lm 1445
-ora-lm 1446
-apri-lm 1447
-oc-lm 1448
-peport 1449
-dwf 1450
-infoman 1451
-gtegsc-lm 1452
-genie-lm 1453
-interhdl_elmd 1454
-esl-lm 1455
-dca 1456
-valisys-lm 1457
-nrcabq-lm 1458
-proshare1 1459
-proshare2 1460
-ibm_wrless_lan 1461
-world-lm 1462
-nucleus 1463
-msl_lmd 1464
-pipes 1465
-oceansoft-lm 1466
-aal-lm 1469
-uaiact 1470
-csdmbase 1471
-csdm 1472
-openmath 1473
-telefinder 1474
-taligent-lm 1475
-clvm-cfg 1476
-ms-sna-server 1477
-ms-sna-base 1478
-dberegister 1479
-pacerforum 1480
-airs 1481
-miteksys-lm 1482
-afs 1483
-confluent 1484
-lansource 1485
-nms_topo_serv 1486
-localinfosrvr 1487
-docstor 1488
-dmdocbroker 1489
-insitu-conf 1490
-anynetgateway 1491
-stone-design-1 1492
-netmap_lm 1493
-ica 1494
-cvc 1495
-liberty-lm 1496
-rfx-lm 1497
-watcom-sql 1498
-fhc 1499
-vlsi-lm 1500
-saiscm 1501
-shiva 1502
-shivadiscovery 1502
-databeam 1503
-imtc-mcs 1503
-evb-elm 1504
-funkproxy 1505
-utcd 1506
-symplex 1507
-diagmond 1508
-robcad-lm 1509
-mvx-lm 1510
-3l-l1 1511
-wins 1512
-fujitsu-dtc 1513
-fujitsu-dtcns 1514
-ifor-protocol 1515
-vpad 1516
-vpac 1517
-vpvd 1518
-vpvc 1519
-atm-zip-office 1520
-ncube-lm 1521
-cichild 1523
-cichild-lm 1523
-ingres 1524
-ingreslock 1524
-orasrv 1525
-prospero-np 1525
-pdap-np 1526
-tlisrv 1527
-mciautoreg 1528
-coauthor 1529
-rap-service 1530
-rap-listen 1531
-miroconnect 1532
-virtual-places 1533
-micromuse-lm 1534
-ampr-info 1535
-ampr-inter 1536
-sdsc-lm 1537
-3ds-lm 1538
-intellistor-lm 1539
-rds 1540
-rds2 1541
-gridgen-elmd 1542
-simba-cs 1543
-aspeclmd 1544
-vistium-share 1545
-abbaccuray 1546
-laplink 1547
-axon-lm 1548
-shivahose 1549
-3m-image-lm 1550
-hecmtl-db 1551
-pciarray 1552
-sna-cs 1553
-caci-lm 1554
-livelan 1555
-ashwin 1556
-arbortext-lm 1557
-xingmpeg 1558
-web2host 1559
-asci-val 1560
-facilityview 1561
-pconnectmgr 1562
-cadabra-lm 1563
-pay-per-view 1564
-windd 1565
-winddlb 1565
-corelvideo 1566
-jlicelmd 1567
-tsspmap 1568
-ets 1569
-orbixd 1570
-rdb-dbs-disp 1571
-chip-lm 1572
-itscomm-ns 1573
-mvel-lm 1574
-oraclenames 1575
-moldflow-lm 1576
-hypercube-lm 1577
-jacobus-lm 1578
-ioc-sea-lm 1579
-tn-tl-r1 1580
-vmf-msg-port 1581
-msims 1582
-simbaexpress 1583
-tn-tl-fd2 1584
-intv 1585
-ibm-abtact 1586
-pra_elmd 1587
-triquest-lm 1588
-vqp 1589
-gemini-lm 1590
-ncpm-pm 1591
-commonspace 1592
-mainsoft-lm 1593
-sixtrak 1594
-radio 1595
-radio-sm 1596
-orbplus-iiop 1597
-picknfs 1598
-simbaservices 1599
-issd 1600
-aas 1601
-dec-inspect 1602
-pickodbc 1603
-picodbc 1603
-icabrowser 1604
-slp 1605
-slm-api 1606
-stt 1607
-smart-lm 1608
-isysg-lm 1609
-taurus-wh 1610
-ill 1611
-netbill-trans 1612
-netbill-keyrep 1613
-netbill-cred 1614
-netbill-auth 1615
-netbill-prod 1616
-nimrod-agent 1617
-skytelnet 1618
-xs-openstorage 1619
-faxportwinport 1620
-softdataphone 1621
-ontime 1622
-jaleosnd 1623
-udp-sr-port 1624
-svs-omagent 1625
-cncp 1636
-cnap 1637
-cnip 1638
-cert-initiator 1639
-cert-responder 1640
-invision 1641
-isis-am 1642
-isis-ambc 1643
-saiseh 1644
-datametrics 1645
-sa-msg-port 1646
-rsap 1647
-concurrent-lm 1648
-inspect 1649
-nkd 1650
-shiva_confsrvr 1651
-xnmp 1652
-alphatech-lm 1653
-stargatealerts 1654
-dec-mbadmin 1655
-dec-mbadmin-h 1656
-fujitsu-mmpdc 1657
-sixnetudr 1658
-sg-lm 1659
-skip-mc-gikreq 1660
-netview-aix-1 1661
-netview-aix-2 1662
-netview-aix-3 1663
-netview-aix-4 1664
-netview-aix-5 1665
-netview-aix-6 1666
-netview-aix-7 1667
-netview-aix-8 1668
-netview-aix-9 1669
-netview-aix-10 1670
-netview-aix-11 1671
-netview-aix-12 1672
-proshare-mc-1 1673
-proshare-mc-2 1674
-pdp 1675
-netcomm1 1676
-groupwise 1677
-prolink 1678
-darcorp-lm 1679
-microcom-sbp 1680
-sd-elmd 1681
-lanyon-lantern 1682
-ncpm-hip 1683
-snaresecure 1684
-n2nremote 1685
-cvmon 1686
-nsjtp-ctrl 1687
-nsjtp-data 1688
-firefox 1689
-ng-umds 1690
-empire-empuma 1691
-sstsys-lm 1692
-rrirtr 1693
-rrimwm 1694
-rrilwm 1695
-rrifmm 1696
-rrisat 1697
-rsvp-encap-1 1698
-rsvp-encapsulation-1 1698
-rsvp-encap-2 1699
-rsvp-encapsulation-2 1699
-mps-raft 1700
-l2f 1701
-deskshare 1702
-hb-engine 1703
-bcs-broker 1704
-slingshot 1705
-jetform 1706
-vdmplay 1707
-gat-lmd 1708
-centra 1709
-impera 1710
-pptconference 1711
-registrar 1712
-conferencetalk 1713
-sesi-lm 1714
-houdini-lm 1715
-xmsg 1716
-fj-hdnet 1717
-h323gatedisc 1718
-h323gatestat 1719
-h323hostcall 1720
-caicci 1721
-hks-lm 1722
-pptp 1723
-csbphonemaster 1724
-iden-ralp 1725
-iberiagames 1726
-winddx 1727
-telindus 1728
-citynl 1729
-roketz 1730
-msiccp 1731
-proxim 1732
-sipat 1733
-cambertx-lm 1734
-privatechat 1735
-street-stream 1736
-ultimad 1737
-gamegen1 1738
-webaccess 1739
-encore 1740
-cisco-net-mgmt 1741
-3com-nsd 1742
-cinegrfx-lm 1743
-ncpm-ft 1744
-remote-winsock 1745
-ftrapid-1 1746
-ftrapid-2 1747
-oracle-em1 1748
-aspen-services 1749
-sslp 1750
-swiftnet 1751
-lofr-lm 1752
-translogic-lm 1753
-oracle-em2 1754
-ms-streaming 1755
-capfast-lmd 1756
-cnhrp 1757
-tftp-mcast 1758
-spss-lm 1759
-www-ldap-gw 1760
-cft-0 1761
-cft-1 1762
-cft-2 1763
-cft-3 1764
-cft-4 1765
-cft-5 1766
-cft-6 1767
-cft-7 1768
-bmc-net-adm 1769
-bmc-net-svc 1770
-vaultbase 1771
-essweb-gw 1772
-kmscontrol 1773
-global-dtserv 1774
-femis 1776
-powerguardian 1777
-prodigy-internet 1778
-pharmasoft 1779
-dpkeyserv 1780
-answersoft-lm 1781
-hp-hcip 1782
-fjris 1783
-finle-lm 1784
-windlm 1785
-funk-logger 1786
-funk-license 1787
-psmond 1788
-hello 1789
-nmsp 1790
-ea1 1791
-ibm-dt-2 1792
-rsc-robot 1793
-cera-bcm 1794
-dpi-proxy 1795
-vocaltec-admin 1796
-uma 1797
-etp 1798
-netrisk 1799
-ansys-lm 1800
-msmq 1801
-concomp1 1802
-hp-hcip-gwy 1803
-enl 1804
-enl-name 1805
-musiconline 1806
-fhsp 1807
-oracle-vp2 1808
-oracle-vp1 1809
-jerand-lm 1810
-scientia-sdb 1811
-radius 1812
-radius-acct 1813
-tdp-suite 1814
-mmpft 1815
-etftp 1818
-plato-lm 1819
-mcagent 1820
-donnyworld 1821
-es-elmd 1822
-unisys-lm 1823
-metrics-pas 1824
-fjicl-tep-a 1901
-fjicl-tep-b 1902
-linkname 1903
-fjicl-tep-c 1904
-sugp 1905
-tpmd 1906
-tportmapperreq 1906
-intrastar 1907
-dawn 1908
-global-wlink 1909
-mtp 1911
-armadp 1913
-elm-momentum 1914
-facelink 1915
-persoft 1916
-noagent 1917
-can-nds 1918
-can-dch 1919
-can-ferret 1920
-close-combat 1944
-dialogic-elmd 1945
-tekpls 1946
-eye2eye 1948
-ismaeasdaqlive 1949
-ismaeasdaqtest 1950
-bcs-lmserver 1951
-dlsrap 1973
-foliocorp 1985
-licensedaemon 1986
-tr-rsrb-p1 1987
-tr-rsrb-p2 1988
-mshnet 1989
-tr-rsrb-p3 1989
-stun-p1 1990
-stun-p2 1991
-ipsendmsg 1992
-stun-p3 1992
-snmp-tcp-port 1993
-stun-port 1994
-perf-port 1995
-tr-rsrb-port 1996
-gdp-port 1997
-x25-svc-port 1998
-tcp-id-port 1999
-callbook 2000
-dc 2001
-globe 2002
-mailbox 2004
-berknet 2005
-invokator 2006
-dectalk 2007
-conf 2008
-search 2010
-raid-cc 2011
-ttyinfo 2012
-raid-am 2013
-troff 2014
-cypress 2015
-bootserver 2016
-cypress-stat 2017
-terminaldb 2018
-whosockami 2019
-xinupageserver 2020
-servexec 2021
-down 2022
-xinuexpansion3 2023
-xinuexpansion4 2024
-ellpack 2025
-scrabble 2026
-shadowserver 2027
-submitserver 2028
-device2 2030
-blackboard 2032
-glogger 2033
-scoremgr 2034
-imsldoc 2035
-objectmanager 2038
-lam 2040
-interbase 2041
-isis 2042
-isis-bcast 2043
-rimsl 2044
-cdfunc 2045
-sdfunc 2046
-dls 2047
-dls-monitor 2048
-nfs 2049
-shilp 2049
-dlsrpn 2065
-dlswpn 2067
-zephyr-srv 2102
-zephyr-clt 2103
-zephyr-hm 2104
-minipay 2105
-mc-gt-srv 2180
-ats 2201
-imtc-map 2202
-kali 2213
-unreg-ab1 2221
-unreg-ab2 2222
-inreg-ab3 2223
-ivs-video 2232
-infocrypt 2233
-directplay 2234
-sercomm-wlink 2235
-nani 2236
-optech-port1-lm 2237
-aviva-sna 2238
-imagequery 2239
-ivsd 2241
-xmquery 2279
-lnvpoller 2280
-lnvconsole 2281
-lnvalarm 2282
-lnvstatus 2283
-lnvmaps 2284
-lnvmailmon 2285
-nas-metering 2286
-dna 2287
-netml 2288
-pehelp 2307
-sdhelp 2308
-cvspserver 2401
-rtsserv 2500
-rtsclient 2501
-hp-3000-telnet 2564
-netrek 2592
-tqdata 2700
-www-dev 2784
-aic-np 2785
-aic-oncrpc 2786
-piccolo 2787
-fryeserv 2788
-media-agent 2789
-mao 2908
-funk-dialout 2909
-tdaccess 2910
-blockade 2911
-epicon 2912
-hbci 3000
-redwood-broker 3001
-exlm-agent 3002
-gw 3010
-trusted-web 3011
-hlserver 3047
-pctrader 3048
-nsws 3049
-vmodem 3141
-rdc-wh-eos 3142
-seaview 3143
-tarantella 3144
-csi-lfap 3145
-mc-brk-srv 3180
-ccmail 3264
-altav-tunnel 3265
-ns-cfg-server 3266
-ibm-dial-out 3267
-msft-gc 3268
-msft-gc-ssl 3269
-verismart 3270
-csoft-prev 3271
-user-manager 3272
-sxmp 3273
-ordinox-server 3274
-samd 3275
-maxim-asics 3276
-dec-notes 3333
-bmap 3421
-mira 3454
-prsvp 3455
-vat 3456
-vat-control 3457
-d3winosfi 3458
-integral 3459
-mapper-nodemgr 3984
-mapper-mapethd 3985
-mapper-ws_ethd 3986
-terabase 4000
-netcheque 4008
-chimera-hwm 4009
-samsung-unidex 4010
-altserviceboot 4011
-pda-gate 4012
-acl-manager 4013
-nuts_dem 4132
-nuts_bootp 4133
-nifty-hmi 4134
-oirtgsvc 4141
-oidocsvc 4142
-oidsr 4143
-rwhois 4321
-unicall 4343
-vinainstall 4344
-krb524 4444
-nv-video 4444
-upnotifyp 4445
-n1-fwp 4446
-n1-rmgmt 4447
-asc-slmd 4448
-arcryptoip 4449
-camp 4450
-ctisystemmsg 4451
-ctiprogramload 4452
-nssalertmgr 4453
-nssagentmgr 4454
-sae-urn 4500
-urn-x-cdchoice 4501
-hylafax 4559
-rfa 4672
-commplex-main 5000
-commplex-link 5001
-rfe 5002
-claris-fmpro 5003
-avt-profile-1 5004
-avt-profile-2 5005
-telelpathstart 5010
-telepathstart 5010
-telelpathattack 5011
-telepathattack 5011
-zenginkyo-1 5020
-zenginkyo-2 5021
-mmcc 5050
-rmonitor_secure 5145
-atmp 5150
-america-online 5190
-aol 5190
-americaonline1 5191
-aol-1 5191
-americaonline2 5192
-aol-2 5192
-americaonline3 5193
-aol-3 5193
-padl2sim 5236
-hacl-hb 5300
-hacl-gs 5301
-hacl-cfg 5302
-hacl-probe 5303
-hacl-local 5304
-hacl-test 5305
-sun-mc-grp 5306
-sco-aip 5307
-cfengine 5308
-jprinter 5309
-outlaws 5310
-tmlogin 5311
-excerpt 5400
-excerpts 5401
-mftp 5402
-hpoms-ci-lstn 5403
-hpoms-dps-lstn 5404
-netsupport 5405
-systemics-sox 5406
-foresyte-clear 5407
-foresyte-sec 5408
-salient-dtasrv 5409
-salient-usrmgr 5410
-actnet 5411
-continuus 5412
-wwiotalk 5413
-statusd 5414
-ns-server 5415
-sns-gateway 5416
-sns-agent 5417
-mcntp 5418
-dj-ice 5419
-cylink-c 5420
-personal-agent 5555
-esmmanager 5600
-esmagent 5601
-a1-msc 5602
-a1-bs 5603
-a3-sdunode 5604
-a4-sdunode 5605
-pcanywheredata 5631
-pcanywherestat 5632
-rrac 5678
-dccm 5679
-proshareaudio 5713
-prosharevideo 5714
-prosharedata 5715
-prosharerequest 5716
-prosharenotify 5717
-openmail 5729
-fcopy-server 5745
-openmailg 5755
-x500ms 5757
-openmailns 5766
-s-openmail 5767
-x11 6000
-softcm 6110
-spc 6111
-dtspcd 6112
-backup-express 6123
-meta-corp 6141
-aspentec-lm 6142
-watershed-lm 6143
-statsci1-lm 6144
-statsci2-lm 6145
-lonewolf-lm 6146
-montage-lm 6147
-tal-pod 6149
-crip 6253
-clariion-evr01 6389
-skip-cert-recv 6455
-skip-cert-send 6456
-lvision-lm 6471
-xdsxdm 6558
-vocaltec-gold 6670
-vision_server 6672
-vision_elmd 6673
-ambit-lm 6831
-acmsoda 6969
-afs3-fileserver 7000
-afs3-callback 7001
-afs3-prserver 7002
-afs3-vlserver 7003
-afs3-kaserver 7004
-afs3-volser 7005
-afs3-errors 7006
-afs3-bos 7007
-afs3-update 7008
-afs3-rmtsys 7009
-ups-onlinet 7010
-lazy-ptop 7099
-font-service 7100
-virprot-lm 7121
-clutild 7174
-fodms 7200
-dlip 7201
-winqedit 7395
-pmdmgr 7426
-oveadmgr 7427
-ovladmgr 7428
-opi-sock 7429
-xmpv7 7430
-pmd 7431
-telops-lmd 7491
-pafec-lm 7511
-cbt 7777
-accu-lmgr 7781
-quest-vista 7980
-irdmi2 7999
-irdmi 8000
-pro-ed 8032
-npmp 8450
-ddi-tcp-1 8888
-ddi-tcp-2 8889
-ddi-tcp-3 8890
-ddi-tcp-4 8891
-ddi-tcp-5 8892
-ddi-tcp-6 8893
-ddi-tcp-7 8894
-cslistener 9000
-man 9535
-sd 9876
-distinct32 9998
-distinct 9999
-ndmp 10000
-tsaf 12753
-dsmcc-config 13818
-dsmcc-session 13819
-dsmcc-passthru 13820
-dsmcc-download 13821
-dsmcc-ccp 13822
-isode-dua 17007
-biimenu 18000
-webphone 21845
-netspeak-is 21846
-netspeak-cs 21847
-netspeak-acd 21848
-netspeak-cps 21849
-wnn6 22273
-vocaltec-wconf 22555
-aws-brf 22800
-brf-gw 22951
-icl-twobase1 25000
-icl-twobase2 25001
-icl-twobase3 25002
-icl-twobase4 25003
-icl-twobase5 25004
-icl-twobase6 25005
-icl-twobase7 25006
-icl-twobase8 25007
-icl-twobase9 25008
-icl-twobase10 25009
-vocaltec-hos 25793
-quake 26000
-wnn6-ds 26208
-dbbrowse 47557
-alc 47806
-ap 47806
-bacnet 47808
-";
-
-#& _ianaport($servname,\%ports,\$ports) : {$portnum | undef}
-sub _ianaport ($\%\$)
-{
- my ($svc,$defports,$rstr) = @_;
- unless (%$defports) {
- %$defports = split(' ', $$rstr);
- # now have to force a real free() and not just SvPOK_off()
- $$rstr = $defports; # convert SVt_PV to SVt_RV to free the string
- undef $$rstr;
- }
- $defports->{$svc};
-}
-
-#& _setport($self,$key,$newval) : {'' | "carp string"}
-sub _setport
-{
- my($self,$key,$newval) = @_;
- return "Invalid arguments to " . __PACKAGE__ . "::_setport(@_), called"
- if @_ != 3 || !exists($ {*$self}{Keys}{$key});
- my $whoami = $self->_trace(\@_,1);
- my($skey,$hkey,$pkey,$svc,$port,$proto,$type,$host,$reval);
- my($pname,$defport,@serv);
- ($skey = $key) =~ s/port$/service/; # a key known to be for a service
- ($pkey = $key) =~ s/service$/port/; # and one for the port
- ($hkey = $pkey) =~ s/port$/host/; # another for calling _sethost
- if (!defined $newval) { # deleting a service or port
- delete $ {*$self}{Parms}{$skey};
- delete $ {*$self}{Parms}{$pkey} unless $self->isconnected;
- my @delkeys;
- if ($pkey eq 'thisport') {
- @delkeys = qw(srcaddrlist srcaddr);
- }
- elsif ($pkey eq 'destport') {
- @delkeys = qw(dstaddrlist dstaddr);
- }
- pop(@delkeys) if @delkeys and $self->isconnected;
- $self->delparams(\@delkeys) if @delkeys;
- return ''; # ok to delete
- }
- # here, we're trying to set a port or service
- $pname = $self->getparam('IPproto');
- $proto = $self->getparam('proto'); # try to find our protocol
- if (!defined($pname) && !$proto
- && defined($type = $self->getparam('type'))) {
- # try to infer protocol from SO_TYPE
- if ($type == SOCK_STREAM) {
- $proto = IPPROTO_TCP();
- }
- elsif ($type == SOCK_DGRAM) {
- $proto = IPPROTO_UDP();
- }
- }
- if (defined $proto and not defined $pname) {
- $pname = getprotobynumber($proto);
- unless (defined $pname) {
- if ($proto == IPPROTO_UDP()) {
- $pname = 'udp';
- }
- elsif ($proto == IPPROTO_TCP()) {
- $pname = 'tcp';
- }
- elsif ($proto == IPPROTO_ICMP()) {
- $pname = 'icmp';
- }
- }
- }
-
- $reval = $newval; # make resetting $_[2] simple
- $svc = $ {*$self}{Parms}{$skey}; # preserve earlier values
- $port = $ {*$self}{Parms}{$pkey};
- $port = undef if
- defined($port) and $port =~ /\D/; # but stored ports must be numeric
- ($newval,$defport) = ($1,$2+0)
- if $newval =~ /^(.+)\((\d+)\)$/;
- if ($skey eq $key || $newval =~ /\D/) { # trying to set a service
- @serv = getservbyname($newval,$pname); # try to find the port info
- }
- if ($newval !~ /\D/ && !@serv) { # setting a port number (even if service)
- $port = $newval+0; # just in case no servent is found
- @serv = getservbyport(htons($port),$pname) if $pname;
- }
- if (@serv) { # if we resolved name/number input
- $svc = $serv[0]; # save the canonical service name (and number?)
- $port = 0+$serv[2] unless $key eq $pkey and $newval !~ /\D/;
- }
- elsif (!$defport && $newval =~ /\D/) { # unknown service
- if ($pname eq 'udp') {
- $defport = _ianaport("\L$newval",%udp_ports,$udp_ports);
- }
- elsif ($pname eq 'tcp') {
- $defport = _ianaport("\L$newval",%tcp_ports,$tcp_ports);
- }
- return "Unknown service $newval, found" unless $defport;
- $port = $defport+0;
- $svc = $newval;
- }
- elsif ($defport && $newval) {
- $svc = $newval;
- $port = $defport;
- }
- elsif ($key eq $skey or $newval =~ /\D/) { # setting unknown service
- return "Unknown service $newval, found";
- }
- $reval = (($key eq $skey) ? $svc : $port); # in case we get that far
- $ {*$self}{Parms}{$skey} = $svc if $svc; # in case no port change
- $_[2] = $reval;
- print STDERR " - " . __PACKAGE__ . "::_setport $self $skey $svc\n" if
- $svc and $self->debug;
- print STDERR " - " . __PACKAGE__ . "::_setport $self $pkey $port\n" if
- defined $port and $self->debug;
-# Have to keep going here for implicit bind() from init().
-# return '' if defined($ {*$self}{Parms}{$pkey}) and
-# $ {*$self}{Parms}{$pkey} == $port; # not an update if same number
- $ {*$self}{Parms}{$pkey} = $port; # in case was service key
- # check for whether we can ask _sethost to set {dst,src}addrlist now
- return '' unless
- defined($host = $ {*$self}{Parms}{$hkey}) or $hkey eq 'thishost';
- $host = '0' if !defined $host; # 'thishost' value was null
- $self->setparams({$hkey => $host},0,1); # try it
- ''; # return goodness from here
-}
-
-#& _setproto($this, $key, $newval) : {'' | "carp string"}
-sub _setproto
-{
- my($self,$key,$newval) = @_;
- if (!defined $newval) { # delparams call?
- # make both go away at once
- delete @{ $ {*$self}{Parms} }{'IPproto','proto'};
- return '';
- }
- my($pname,$proto);
- if ($key ne 'proto' or $newval =~ /\D/) { # have to try for name->number
- my @pval = getprotobyname($newval);
- if (@pval) {
- $pname = $pval[0];
- $proto = $pval[2];
- }
- }
- if (!defined($proto) and $newval !~ /\D/) { # numeric proto, find name
- $proto = $newval+0;
- $pname = getprotobynumber($proto);
- }
- return "Unknown protocol ($newval), seen"
- unless defined $proto;
- unless (defined $pname) {
- if ($proto == IPPROTO_UDP) {
- $pname = 'udp';
- }
- elsif ($proto == IPPROTO_TCP) {
- $pname = 'tcp';
- }
- elsif ($proto == IPPROTO_ICMP) {
- $pname = 'icmp';
- }
- }
- $ {*$self}{Parms}{IPproto} = $pname; # update our values
- $ {*$self}{Parms}{proto} = $proto;
- # make sure the right value gets set
- $_[2] = (($key eq 'proto') ? $proto : $pname);
- ''; # return goodness
-}
-
-#& _addrinfo($this, $sockaddr) : (name, addr, service, portnum)
-sub _addrinfo
-{
- my($this,$sockaddr) = @_;
- my($fam,$port,$serv,$name,$addr,@hinfo);
- ($fam,$port,$addr) = unpack_sockaddr_in($sockaddr);
- @hinfo = gethostbyaddr($addr,$fam);
- $addr = inet_ntoa($addr);
- $name = (!@hinfo) ? $addr : $hinfo[0];
- $serv = getservbyport(htons($port),
- (ref $this) && $this->getparam('IPproto')) || $port;
- ($name, $addr, $serv, $port);
-}
-
-#& getsockinfo($this) : $remote_addr || ($local_addr, $rem_addr) | ()
-#+attrs locked method
-sub getsockinfo
-{
- my($self) = @_;
- my($rem,$lcl,$port,$serv,$name,$addr);
- ($lcl,$rem) = $self->SUPER::getsockinfo;
- if (defined $rem and length($rem)) {
- ($name, $addr, $serv, $port) = $self->_addrinfo($rem);
- $self->setparams({remhost => $name, remaddr => $addr,
- remservice => $serv, remport => $port});
- }
- if (defined $lcl and length($lcl)) {
- ($name, $addr, $serv, $port) = $self->_addrinfo($lcl);
- $self->setparams({lclhost => $name, lcladdr => $addr,
- lclservice => $serv, lclport => $port});
- }
- wantarray ? ((defined $lcl || defined $rem) ? ($lcl,$rem) : ())
- : $rem;
-}
-
-#& format_addr($this, $sockaddr, [numeric_only]) : $string
-sub format_addr
-{
- my($this,$sockaddr,$numeric) = @_;
- my($name,$addr,$serv,$port) = $this->_addrinfo($sockaddr);
- if ($numeric) {
- "${addr}:${port}";
- }
- else {
- "${name}:${serv}";
- }
-}
-
-
-1;
-
-# autoloaded methods go after the END token (& pod) below
-
-__END__
-
-=head1 NAME
-
-Net::Inet - Internet socket interface module
-
-=head1 SYNOPSIS
-
- use Net::Gen; # optional
- use Net::Inet;
-
-=head1 DESCRIPTION
-
-The C<Net::Inet> module provides basic services for handling
-socket-based communications for the Internet protocol family. It
-inherits from
-L<C<Net::Gen>|Net::Gen>,
-and is a base for
-L<C<Net::TCP>|Net::TCP>
-and
-L<C<Net::UDP>|Net::UDP>.
-
-=head2 Public Methods
-
-=over 4
-
-=item new
-
-Usage:
-
- $obj = new Net::Inet;
- $obj = new Net::Inet $desthost, $destservice;
- $obj = new Net::Inet \%parameters;
- $obj = new Net::Inet $desthost, $destservice, \%parameters;
- $obj = 'Net::Inet'->new();
- $obj = 'Net::Inet'->new($desthost, $destservice);
- $obj = 'Net::Inet'->new(\%parameters);
- $obj = 'Net::Inet'->new($desthost, $destservice, \%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 set up
-the parameter validation it needs in the object before allowing
-the validation.) Otherwise, it will cause the parameters to be
-validated by calling its C<init> method. 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 if
-the object is non-blocking and a connect() call is in progress.
-
-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/perl-porters/1998-01/msg01674.html
-for details.
-
-=item init
-
-Usage:
-
- return undef unless $self->init;
- return undef unless $self->init(\%parameters);
- return undef unless $self->init($desthost, $destservice);
- return undef unless $self->init($desthost, $destservice, \%parameters);
-
-Verifies that all previous parameter assignments are valid (via
-C<checkparams>). Returns the incoming object on success, and
-C<undef> on failure. Usually called only via a derived class's
-C<init> method or its own C<new> call.
-
-=item bind
-
-Usage:
-
- $ok = $obj->bind;
- $ok = $obj->bind($lclhost, $lclservice);
- $ok = $obj->bind($lclhost, $lclservice, \%parameters);
-
-Sets up the C<srcaddrlist> object parameter with the specified
-$lclhost and $lclservice arguments if supplied (via the C<thishost> and
-C<thisport> object parameters), and then returns the value from
-the inherited C<bind> method. Changing of parameters is also
-allowed, mainly for setting debug status or timeouts.
-
-Example:
-
- $ok = $obj->bind(0, 'echo(7)'); # attach to the local TCP echo port
-
-=item unbind
-
-Usage:
-
- $obj->unbind;
-
-Deletes the C<thishost> and C<thisport> object parameters, and
-then (assuming that succeeds, which it should) returns the value
-from the inherited C<unbind> method.
-
-=item connect
-
-Usage:
-
- $ok = $obj->connect;
- $ok = $obj->connect($host, $service);
- $ok = $obj->connect($host, $service, \%parameters);
-
-Attempts to establish a connection for the object. If the $host
-or $service arguments are specified, they will be used to set the
-C<desthost> and C<destservice>/C<destport> object parameters,
-with side-effects of setting up the C<dstaddrlist> object
-parameter. Then, the result of a call to the inherited
-C<connect> method will be returned. Changing of parameters is
-also allowed, mainly for setting debug status or timeouts.
-
-=item format_addr
-
-Usage:
-
- $string = $obj->format_addr($sockaddr);
- $string = $obj->format_addr($sockaddr, $numeric_only);
- $string = format_addr Module $sockaddr;
- $string = format_addr Module $sockaddr, $numeric_only;
-
-Returns a formatted representation of the address. This is a
-method so that it can be overridden by derived classes. It is
-used to implement ``pretty-printing'' methods for source and
-destination addresses. If the $numeric_only argument is true,
-the address and port number will be used even if they can be
-resolved to names. Otherwise, the resolved hostname and service
-name will be used if possible.
-
-=item format_local_addr
-
-Usage:
-
- $string = $obj->format_local_addr;
- $string = $obj->format_local_addr($numeric_only);
-
-Returns a formatted representation of the local socket address
-associated with the object. A sugar-coated way of calling the
-C<format_addr> method for the C<srcaddr> object parameter.
-
-=item format_remote_addr
-
-Usage:
-
- $string = $obj->format_remote_addr;
-
-Returns a formatted representation of the remote socket address
-associated with the object. A sugar-coated way of calling the
-C<format_addr> method for the C<dstaddr> object parameter.
-
-=item getsockinfo
-
-An augmented form of
-L<C<Net::Gen::getsockinfo>|Net::Gen/getsockinfo>. Aside from
-updating more object parameters, it behaves the same as that in
-the base class. The additional object parameters which get set
-are C<lcladdr>, C<lclhost>, C<lclport>, C<lclservice>,
-C<remaddr>, C<remhost>, C<remport>, and C<remservice>. (They are
-described in L<"Known Object Parameters"> below.)
-
-=back
-
-There are also various I<accessor> methods for the object parameters.
-See L<Net::Gen/"Public Methods"> (where it talks about C<Accessors>)
-for calling details.
-See L<"Known Object Parameters"> below
-for those defined by this class.
-
-=head2 Protected Methods
-
-[See the note in L<Net::Gen/"Protected Methods"> about my
-definition of protected methods in Perl.]
-
-None.
-
-=head2 Known Socket Options
-
-These are the socket options known to the C<Net::Inet> module
-itself:
-
-=over 4
-
-=item Z<>
-
-C<IP_HDRINCL> C<IP_RECVDSTADDR> C<IP_RECVOPTS> C<IP_RECVRETOPTS>
-C<IP_TOS> C<IP_TTL> C<IP_ADD_MEMBERSHIP> C<IP_DROP_MEMBERSHIP>
-C<IP_MULTICAST_IF> C<IP_MULTICAST_LOOP> C<IP_MULTICAST_TTL>
-C<IP_OPTIONS> C<IP_RETOPTS>
-
-=back
-
-=head2 Known Object Parameters
-
-These are the object parameters registered by the C<Net::Inet>
-module itself:
-
-=over 4
-
-=item IPproto
-
-The name of the Internet protocol in use on the socket associated
-with the object. Set as a side-effect of setting the C<proto>
-object parameter, and vice versa.
-
-=item proto
-
-Used the same way as with L<C<Net::Gen>|Net::Gen/proto>,
-but has a handler attached
-to keep it in sync with C<IPproto>.
-
-=item thishost
-
-The source host name or address to use for the C<bind> method.
-When used in conjunction with the C<thisservice> or C<thisport>
-object parameter, causes the C<srcaddrlist> object parameter to
-be set, which is how it affects the bind() action. This
-parameter is validated, and must be either a valid internet
-address or a hostname for which an address can be found. If a
-hostname is given, and multiple addresses are found for it, then
-each address will be entered into the C<srcaddrlist> array
-reference.
-
-=item desthost
-
-The destination host name or address to use for the C<connect>
-method. When used in conjunction with the C<destservice> or
-C<destport> object parameter, causes the C<dstaddrlist> object
-parameter to be set, which is how it affects the connect()
-action. This parameter is validated, and must be either a valid
-internet address or a hostname for which an address can be found.
-If a hostname is given, and multiple addresses are found for it,
-then each address will be entered into the C<dstaddrlist> array
-reference, in order. This allows the C<connect> method to
-attempt a connection to each address, as per RFC 1123.
-
-=item thisservice
-
-The source service name (or number) to use for the C<bind>
-method. An attempt will be made to translate the supplied
-service name with getservbyname(). If that succeeds, or if it
-fails but the supplied value was strictly numeric, the port
-number will be set in the C<thisport> object parameter. If the
-supplied value is not numeric and can't be translated, the
-attempt to set the value will fail. Otherwise, this causes the
-C<srcaddrlist> object parameter to be updated, in preparation for
-an invocation of the C<bind> method (possibly implicitly from the
-C<connect> method).
-
-=item thisport
-
-The source service number (or name) to use for the C<bind>
-method. An attempt will be made to translate the supplied
-service name with getservbyname() if it is not strictly numeric.
-If that succeeds, the given name will be set in the
-C<thisservice> parameter, and the resolved port number will be
-set in the C<thisport> object parameter. If the supplied value
-is strictly numeric, and a call to getservbyport can resolve a
-name for the service, the C<thisservice> parameter will be
-updated appropriately. If the supplied value is not numeric and
-can't be translated, the attempt to set the value will fail.
-Otherwise, this causes the C<srcaddrlist> object parameter to be
-updated, in preparation for an invocation of the C<bind> method
-(possibly implicitly from the C<connect> method).
-
-=item destservice
-
-The destination service name (or number) to use for the
-C<connect> method. An attempt will be made to translate the
-supplied service name with getservbyname(). If that succeeds, or
-if it fails but the supplied value was strictly numeric, the port
-number will be set in the C<destport> object parameter. If the
-supplied value is not numeric and can't be translated, the
-attempt to set the value will fail. Otherwise, if the
-C<desthost> parameter has a defined value, this causes the
-C<dstaddrlist> object parameter to be updated, in preparation for
-an invocation of the C<connect> method.
-
-=item destport
-
-The destination service number (or name) to use for the
-C<connect> method. An attempt will be made to translate the
-supplied service name with getservbyname() if it is not strictly
-numeric. If that succeeds, the given name will be set in the
-C<destservice> parameter, and the resolved port number will be
-set in the C<destport> parameter. If the supplied value is
-strictly numeric, and a call to getservbyport can resolve a name
-for the service, the C<destservice> parameter will be updated
-appropriately. If the supplied value is not numeric and can't be
-translated, the attempt to set the value will fail. Otherwise,
-if the C<desthost> parameter has a defined value, this causes the
-C<dstaddrlist> object parameter to be updated, in preparation for
-an invocation of the C<connect> method.
-
-=item lcladdr
-
-The local IP address stashed by the C<getsockinfo> method after a
-successful bind() or connect() call.
-
-=item lclhost
-
-The local hostname stashed by the C<getsockinfo> method after a
-successful bind() or connect(), as resolved from the C<lcladdr>
-object parameter.
-
-=item lclport
-
-The local port number stashed by the C<getsockinfo> method after a
-successful bind() or connect() call.
-
-=item lclservice
-
-The local service name stashed by the C<getsockinfo> method after
-a successful bind() or connect(), as resolved from the C<lclport>
-object parameter.
-
-=item remaddr
-
-The remote IP address stashed by the C<getsockinfo> method after a
-successful connect() call.
-
-=item remhost
-
-The remote hostname stashed by the C<getsockinfo> method after a
-successful connect() call, as resolved from the C<remaddr>
-object parameter.
-
-=item remport
-
-The remote port number stashed by the C<getsockinfo> method after a
-successful connect() call.
-
-=item remservice
-
-The remote service name stashed by the C<getsockinfo> method after
-a successful connect() call, as resolved from the C<remport>
-object parameter.
-
-=back
-
-=head2 Non-Method Subroutines
-
-=over 4
-
-=item inet_aton
-
-Usage:
-
- $in_addr = inet_aton('192.0.2.1');
-
-Returns the packed C<AF_INET> address in network order, if it is
-validly formed, or C<undef> on error. This used to be a separate
-implementation in this package, but is now inherited from the
-C<Socket> module.
-
-=item inet_addr
-
-A synonym for inet_aton() (for old fogeys like me who forget
-about the new name). (Yes, I know it's different in C, but in
-Perl there's no need to propagate the old inet_addr()
-braindamage of being unable to handle "255.255.255.255", so I didn't.)
-
-=item inet_ntoa
-
-Usage:
-
- $addr_string = inet_ntoa($in_addr);
-
-Returns the ASCII representation of the C<AF_INET> address
-provided (if possible), or C<undef> on error. This used to be a
-separate implementation in this package, but is now inherited
-from the C<Socket> module.
-
-=item htonl
-
-=item htons
-
-=item ntohl
-
-=item ntohs
-
-About as those who are used to them might expect, I think.
-However, these versions will return lists in list context, and will
-complain if given a multi-element list in scalar context.
-
-[For those who don't know what these are, and who don't have documentation
-on them in their existing system documentation, these functions convert data
-between 'host' and 'network' byte ordering, for 'short' or 'long' network
-data. (This should explain the 'h', 'n', 's', and 'l' letters in the
-names.) Long network data means 32-bit quantities, such as IP addresses, and
-short network data means 16-bit quantities, such as IP port numbers.
-You'd only need to use these functions if you're not using the methods from
-this package to build your packed 'sockaddr' structures or to unpack their
-data after a connect() or accept().]
-
-
-=item pack_sockaddr_in
-
-Usage:
-
- $connect_address = pack_sockaddr_in($family, $port, $in_addr);
- $connect_address = pack_sockaddr_in($port, $in_addr);
-
-Returns the packed C<struct sockaddr_in> corresponding to the
-provided $family, $port, and $in_addr arguments. The $family and
-$port arguments must be numbers, and the $in_addr argument must
-be a packed C<struct in_addr> such as the trailing elements from
-perl's gethostent() return list. This differs from the
-implementation in the C<Socket> module in that the C<$family>
-argument is available (though optional). The C<$family> argument
-defaults to C<AF_INET>.
-
-=item unpack_sockaddr_in
-
-Usage:
-
- ($family, $port, $in_addr) = unpack_sockaddr_in($connected_address);
-
-Returns the address family, port, and packed C<struct in_addr>
-from the supplied packed C<struct sockaddr_in>. This is the
-inverse of pack_sockaddr_in(). This differs from the
-implementation in the C<Socket> module in that the C<$family>
-value from the socket address is returned (and might not be C<AF_INET>).
-
-=item INADDR_UNSPEC_GROUP
-
-=item INADDR_ALLHOSTS_GROUP
-
-=item INADDR_ALLRTRS_GROUP
-
-=item INADDR_MAX_LOCAL_GROUP
-
-Constant routines returning the S<unspecified local>, S<all hosts>,
-S<all routers>, or the maximum possible local IP multicast group
-address, respectively. These routines return results in the form
-of a packed C<struct inaddr> much like the C<INADDR_ANY> result
-described in L<Socket/INADDR_ANY>.
-
-=item IN_CLASSA
-
-=item IN_CLASSB
-
-=item IN_CLASSC
-
-=item IN_CLASSD
-
-=item IN_MULTICAST
-
-=item IN_EXPERIMENTAL
-
-=item IN_BADCLASS
-
-Usage:
-
- $boolean = IN_EXPERIMENTAL(INADDR_ALLHOSTS_GROUP);
- $boolean = IN_CLASSA(0x7f000001);
-
-These routines return the I<network class> information for the
-supplied IP address. Of these, only IN_BADCLASS() and
-IN_MULTICAST() are really useful in today's Internet, since the
-advent of CIDR (classless Internet domain routing). In
-particular, IN_EXPERIMENTAL() is at the mercy of your vendor's
-definition. The first example above will be true only on older
-systems, which almost certainly don't support IP multicast
-anyway. The argument to any of these functions can be either a
-packed C<struct inaddr> such as that returned by inet_ntoa() or
-unpack_sockaddr_in(), or an integer (or integer expression)
-giving an IP address in I<host> byte order.
-
-=item IPOPT_CLASS
-
-=item IPOPT_COPIED
-
-=item IPOPT_NUMBER
-
-Usage:
-
- $optnum = IPOPT_NUMBER($option);
-
-These routines extract information from IP option numbers, as per
-the information on IP options in RFC 791.
-
-=item ...
-
-Other constants which relate to parts of IP or ICMP headers or
-vendor-defined socket options, as listed in L<"Exports"> below.
-
-=back
-
-=head2 Exports
-
-=over 4
-
-=item default
-
-C<INADDR_ALLHOSTS_GROUP> C<INADDR_ALLRTRS_GROUP> C<INADDR_ANY>
-C<INADDR_BROADCAST> C<INADDR_LOOPBACK> C<INADDR_MAX_LOCAL_GROUP>
-C<INADDR_NONE> C<INADDR_UNSPEC_GROUP> C<IPPORT_RESERVED>
-C<IPPORT_USERRESERVED>
-C<IPPORT_DYNAMIC>
-C<IPPROTO_EGP> C<IPPROTO_EON> C<IPPROTO_GGP>
-C<IPPROTO_HELLO> C<IPPROTO_ICMP> C<IPPROTO_IDP> C<IPPROTO_IGMP>
-C<IPPROTO_IP> C<IPPROTO_IPIP> C<IPPROTO_MAX> C<IPPROTO_PUP>
-C<IPPROTO_RAW> C<IPPROTO_RSVP> C<IPPROTO_TCP> C<IPPROTO_TP>
-C<IPPROTO_UDP> C<htonl> C<htons> C<inet_addr> C<inet_aton> C<inet_ntoa>
-C<ntohl> C<ntohs>
-
-=item exportable
-
-C<DEFTTL> C<ICMP_ADVLENMIN> C<ICMP_ECHO> C<ICMP_ECHOREPLY>
-C<ICMP_INFOTYPE> C<ICMP_IREQ> C<ICMP_IREQREPLY> C<ICMP_MASKLEN>
-C<ICMP_MASKREPLY> C<ICMP_MASKREQ> C<ICMP_MAXTYPE> C<ICMP_MINLEN>
-C<ICMP_PARAMPROB> C<ICMP_REDIRECT> C<ICMP_REDIRECT_HOST>
-C<ICMP_REDIRECT_NET> C<ICMP_REDIRECT_TOSHOST> C<ICMP_REDIRECT_TOSNET>
-C<ICMP_SOURCEQUENCH> C<ICMP_TIMXCEED> C<ICMP_TIMXCEED_INTRANS>
-C<ICMP_TIMXCEED_REASS> C<ICMP_TSLEN> C<ICMP_TSTAMP> C<ICMP_TSTAMPREPLY>
-C<ICMP_UNREACH> C<ICMP_UNREACH_HOST> C<ICMP_UNREACH_NEEDFRAG>
-C<ICMP_UNREACH_NET> C<ICMP_UNREACH_PORT> C<ICMP_UNREACH_PROTOCOL>
-C<ICMP_UNREACH_SRCFAIL> C<IN_BADCLASS> C<IN_CLASSA> C<IN_CLASSA_HOST>
-C<IN_CLASSA_MAX> C<IN_CLASSA_NET> C<IN_CLASSA_NSHIFT>
-C<IN_CLASSA_SUBHOST> C<IN_CLASSA_SUBNET> C<IN_CLASSA_SUBNSHIFT>
-C<IN_CLASSB> C<IN_CLASSB_HOST> C<IN_CLASSB_MAX> C<IN_CLASSB_NET>
-C<IN_CLASSB_NSHIFT> C<IN_CLASSB_SUBHOST> C<IN_CLASSB_SUBNET>
-C<IN_CLASSB_SUBNSHIFT> C<IN_CLASSC> C<IN_CLASSC_HOST> C<IN_CLASSC_MAX>
-C<IN_CLASSC_NET> C<IN_CLASSC_NSHIFT> C<IN_CLASSD> C<IN_CLASSD_HOST>
-C<IN_CLASSD_NET> C<IN_CLASSD_NSHIFT> C<IN_EXPERIMENTAL>
-C<IN_LOOPBACKNET> C<IN_MULTICAST> C<IPFRAGTTL> C<IPOPT_CIPSO>
-C<IPOPT_CLASS> C<IPOPT_CONTROL> C<IPOPT_COPIED> C<IPOPT_DEBMEAS>
-C<IPOPT_EOL> C<IPOPT_LSRR> C<IPOPT_MINOFF> C<IPOPT_NOP> C<IPOPT_NUMBER>
-C<IPOPT_OFFSET> C<IPOPT_OLEN> C<IPOPT_OPTVAL> C<IPOPT_RESERVED1>
-C<IPOPT_RESERVED2> C<IPOPT_RIPSO_AUX> C<IPOPT_RR> C<IPOPT_SATID>
-C<IPOPT_SECURITY> C<IPOPT_SECUR_CONFID> C<IPOPT_SECUR_EFTO>
-C<IPOPT_SECUR_MMMM> C<IPOPT_SECUR_RESTR> C<IPOPT_SECUR_SECRET>
-C<IPOPT_SECUR_TOPSECRET> C<IPOPT_SECUR_UNCLASS> C<IPOPT_SSRR>
-C<IPOPT_TS> C<IPOPT_TS_PRESPEC> C<IPOPT_TS_TSANDADDR>
-C<IPOPT_TS_TSONLY> C<IPPORT_TIMESERVER> C<IPTOS_LOWDELAY>
-C<IPTOS_PREC_CRITIC_ECP> C<IPTOS_PREC_FLASH>
-C<IPTOS_PREC_FLASHOVERRIDE> C<IPTOS_PREC_IMMEDIATE>
-C<IPTOS_PREC_INTERNETCONTROL> C<IPTOS_PREC_NETCONTROL>
-C<IPTOS_PREC_PRIORITY> C<IPTOS_PREC_ROUTINE> C<IPTOS_RELIABILITY>
-C<IPTOS_THROUGHPUT> C<IPTTLDEC> C<IPVERSION> C<IP_ADD_MEMBERSHIP>
-C<IP_DEFAULT_MULTICAST_LOOP> C<IP_DEFAULT_MULTICAST_TTL> C<IP_DF>
-C<IP_DROP_MEMBERSHIP> C<IP_HDRINCL> C<IP_MAXPACKET>
-C<IP_MAX_MEMBERSHIPS> C<IP_MF> C<IP_MSS> C<IP_MULTICAST_IF>
-C<IP_MULTICAST_LOOP> C<IP_MULTICAST_TTL> C<IP_OPTIONS>
-C<IP_RECVDSTADDR> C<IP_RECVOPTS> C<IP_RECVRETOPTS> C<IP_RETOPTS>
-C<IP_TOS> C<IP_TTL> C<MAXTTL> C<MAX_IPOPTLEN> C<MINTTL> C<SUBNETSHIFT>
-C<pack_sockaddr_in> C<unpack_sockaddr_in>
-
-=item tags
-
-The following :tags are in C<%EXPORT_TAGS>, with the associated exportable
-values as listed:
-
-=over 6
-
-=item :sockopts
-
-C<IP_HDRINCL> C<IP_RECVDSTADDR> C<IP_RECVOPTS> C<IP_RECVRETOPTS>
-C<IP_TOS> C<IP_TTL> C<IP_ADD_MEMBERSHIP> C<IP_DROP_MEMBERSHIP>
-C<IP_MULTICAST_IF> C<IP_MULTICAST_LOOP> C<IP_MULTICAST_TTL>
-C<IP_OPTIONS> C<IP_RETOPTS>
-
-=item :routines
-
-C<pack_sockaddr_in> C<unpack_sockaddr_in> C<inet_ntoa> C<inet_aton>
-C<inet_addr> C<htonl> C<ntohl> C<htons> C<ntohs> C<ICMP_INFOTYPE>
-C<IN_BADCLASS> C<IN_EXPERIMENTAL> C<IN_MULTICAST> C<IPOPT_CLASS>
-C<IPOPT_COPIED> C<IPOPT_NUMBER>
-
-=item :icmpvalues
-
-C<ICMP_ADVLENMIN> C<ICMP_ECHO> C<ICMP_ECHOREPLY> C<ICMP_IREQ>
-C<ICMP_IREQREPLY> C<ICMP_MASKLEN> C<ICMP_MASKREPLY> C<ICMP_MASKREQ>
-C<ICMP_MAXTYPE> C<ICMP_MINLEN> C<ICMP_PARAMPROB> C<ICMP_REDIRECT>
-C<ICMP_REDIRECT_HOST> C<ICMP_REDIRECT_NET> C<ICMP_REDIRECT_TOSHOST>
-C<ICMP_REDIRECT_TOSNET> C<ICMP_SOURCEQUENCH> C<ICMP_TIMXCEED>
-C<ICMP_TIMXCEED_INTRANS> C<ICMP_TIMXCEED_REASS> C<ICMP_TSLEN>
-C<ICMP_TSTAMP> C<ICMP_TSTAMPREPLY> C<ICMP_UNREACH> C<ICMP_UNREACH_HOST>
-C<ICMP_UNREACH_NEEDFRAG> C<ICMP_UNREACH_NET> C<ICMP_UNREACH_PORT>
-C<ICMP_UNREACH_PROTOCOL> C<ICMP_UNREACH_SRCFAIL>
-
-=item :ipoptions
-
-C<IPOPT_CIPSO> C<IPOPT_CONTROL> C<IPOPT_DEBMEAS> C<IPOPT_EOL>
-C<IPOPT_LSRR> C<IPOPT_MINOFF> C<IPOPT_NOP> C<IPOPT_OFFSET>
-C<IPOPT_OLEN> C<IPOPT_OPTVAL> C<IPOPT_RESERVED1> C<IPOPT_RESERVED2>
-C<IPOPT_RIPSO_AUX> C<IPOPT_RR> C<IPOPT_SATID> C<IPOPT_SECURITY>
-C<IPOPT_SECUR_CONFID> C<IPOPT_SECUR_EFTO> C<IPOPT_SECUR_MMMM>
-C<IPOPT_SECUR_RESTR> C<IPOPT_SECUR_SECRET> C<IPOPT_SECUR_TOPSECRET>
-C<IPOPT_SECUR_UNCLASS> C<IPOPT_SSRR> C<IPOPT_TS> C<IPOPT_TS_PRESPEC>
-C<IPOPT_TS_TSANDADDR> C<IPOPT_TS_TSONLY> C<MAX_IPOPTLEN>
-
-=item :iptosvalues
-
-C<IPTOS_LOWDELAY> C<IPTOS_PREC_CRITIC_ECP> C<IPTOS_PREC_FLASH>
-C<IPTOS_PREC_FLASHOVERRIDE> C<IPTOS_PREC_IMMEDIATE>
-C<IPTOS_PREC_INTERNETCONTROL> C<IPTOS_PREC_NETCONTROL>
-C<IPTOS_PREC_PRIORITY> C<IPTOS_PREC_ROUTINE> C<IPTOS_RELIABILITY>
-C<IPTOS_THROUGHPUT>
-
-=item :protocolvalues
-
-C<DEFTTL> C<INADDR_ALLHOSTS_GROUP> C<INADDR_ALLRTRS_GROUP>
-C<INADDR_ANY> C<INADDR_BROADCAST> C<INADDR_LOOPBACK>
-C<INADDR_MAX_LOCAL_GROUP> C<INADDR_NONE> C<INADDR_UNSPEC_GROUP>
-C<IN_LOOPBACKNET> C<IPPORT_RESERVED>
-C<IPPORT_USERRESERVED>
-C<IPPORT_DYNAMIC>
-C<IPPROTO_EGP> C<IPPROTO_EON> C<IPPROTO_GGP> C<IPPROTO_HELLO>
-C<IPPROTO_ICMP> C<IPPROTO_IDP> C<IPPROTO_IGMP> C<IPPROTO_IP>
-C<IPPROTO_IPIP> C<IPPROTO_MAX> C<IPPROTO_PUP> C<IPPROTO_RAW>
-C<IPPROTO_RSVP> C<IPPROTO_TCP> C<IPPROTO_TP> C<IPPROTO_UDP>
-C<IPFRAGTTL> C<IPTTLDEC> C<IPVERSION> C<IP_DF> C<IP_MAXPACKET> C<IP_MF>
-C<IP_MSS> C<MAXTTL> C<MAX_IPOPTLEN> C<MINTTL>
-
-=item :ipmulticast
-
-C<IP_ADD_MEMBERSHIP> C<IP_DEFAULT_MULTICAST_LOOP>
-C<IP_DEFAULT_MULTICAST_TTL> C<IP_DROP_MEMBERSHIP> C<IP_MAX_MEMBERSHIPS>
-C<IP_MULTICAST_IF> C<IP_MULTICAST_LOOP> C<IP_MULTICAST_TTL>
-
-=item :deprecated
-
-C<IN_CLASSA_HOST> C<IN_CLASSA_MAX> C<IN_CLASSA_NET> C<IN_CLASSA_NSHIFT>
-C<IN_CLASSA_SUBHOST> C<IN_CLASSA_SUBNET> C<IN_CLASSA_SUBNSHIFT>
-C<IN_CLASSB_HOST> C<IN_CLASSB_MAX> C<IN_CLASSB_NET> C<IN_CLASSB_NSHIFT>
-C<IN_CLASSB_SUBHOST> C<IN_CLASSB_SUBNET> C<IN_CLASSB_SUBNSHIFT>
-C<IN_CLASSC_HOST> C<IN_CLASSC_MAX> C<IN_CLASSC_NET> C<IN_CLASSC_NSHIFT>
-C<IN_CLASSD_HOST> C<IN_CLASSD_NET> C<IN_CLASSD_NSHIFT> C<IN_CLASSA>
-C<IN_CLASSB> C<IN_CLASSC> C<IN_CLASSD> C<IPPORT_TIMESERVER>
-C<SUBNETSHIFT>
-
-=item :ALL
-
-All of the above exportable items.
-
-=back
-
-Z<>
-
-=back
-
-=head1 NOTES
-
-Anywhere a I<service> or I<port> argument is used above, the
-allowed syntax is either a service name, a port number, or a
-service name with a caller-supplied default port number.
-Examples are C<'echo'>, C<7>, and C<'echo(7)'>, respectively.
-For a I<service> argument, a bare port number must be
-translatable into a service name with getservbyport() or an error
-will result. A service name must be translatable into a port
-with getservbyname() or an error will result. However, a service
-name with a default port number will succeed (by using the
-supplied default) even if the translation with getservbyname()
-fails.
-
-For example:
-
- $obj->setparam('destservice', 'http(80)');
-
-This always succeeds, although if your F</etc/services> file (or
-equivalent for non-UNIX systems) maps "http" to something other than
-port 80, you'll get that other port.
-
-For a contrasting example:
-
- $obj->setparam('destservice', 80);
-
-This will fail, despite the numeric value, if your F</etc/services> file
-(or equivalent) is behind the times and has no mapping to a service name
-for port 80.
-
-=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::Gen(3)|Net::Gen>,
-L<Net::TCP(3)|Net::TCP>,
-L<Net::UDP(3)|Net::UDP>
-
-=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
-
-
-#& setdebug($this, [bool, [norecurse]]) : oldvalue
-#+attrs locked
-sub setdebug
-{
- my $this = shift;
- $this->_debug($_[0]) .
- ((@_ > 1 && $_[1]) ? '' : $this->SUPER::setdebug(@_));
-}
-
-#& bind($self, [\]@([host],[port])) : boolean
-#+attrs locked method
-sub bind
-{
- my($self,@args) = @_;
- return undef if @args and not $self->_hostport('this',@args);
- $self->SUPER::bind;
-}
-
-#& unbind($self) : boolean
-#+attrs locked method
-sub unbind
-{
- my($self,@args) = @_;
- if (@args) {
- $whoami = $_[0]->_trace(\@_,0);
- carp "Excess args to ${whoami} ignored";
- }
- $self->delparams([qw(thishost thisport)]) || return undef;
- $self->SUPER::unbind;
-}
@@ -1,4 +1,4 @@
-# Copyright 1995,2002 Spider Boardman.
+# Copyright 1995,1999 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -11,10 +11,9 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-# rcsid: "@(#) $Id: Inet.dat,v 1.26 2002/03/30 10:10:39 spider Exp $"
package Net::Inet;
-use 5.004_04; # new minimum Perl version for this package
+use 5.004_05; # new minimum Perl version for this package
use strict;
# use Carp;
@@ -22,19 +21,22 @@ sub croak { require Carp; goto &Carp::croak; }
sub carp { require Carp; goto &Carp::carp; }
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+my $myclass;
BEGIN {
- $VERSION = '1.0';
- eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
+ $myclass = __PACKAGE__;
+ $VERSION = '0.90';
}
+sub Version () { "$myclass v$VERSION" }
+
use AutoLoader;
#use Exporter ();
-use Net::Gen 1.0 qw(:ALL);
-use Socket qw(/^inet_/);
+use Net::Gen 0.90 qw(:ALL);
+use Socket qw(!/^[a-z]/ /^inet_/ !SOMAXCONN);
BEGIN {
- @ISA = 'Net::Gen';
+ @ISA = qw(Net::Gen);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@@ -338,48 +340,43 @@ my %sockopts;
# out of known IP options
);
-__PACKAGE__->initsockopts( IPPROTO_IP(), \%sockopts );
+$myclass->initsockopts( IPPROTO_IP(), \%sockopts );
-#& htonl($number||@numbers) : $number || @numbers
-sub htonl
+sub htonl # number ; number // or array of same
{
return unless defined wantarray;
- carp "Wrong number of arguments ($#_) to " . __PACKAGE__ . "::htonl, called"
+ carp "Wrong number of arguments ($#_) to ${myclass}::htonl, called"
if @_ != 1 and !wantarray;
unpack('N*', pack('L*', @_));
}
-#& htons($number||@numbers) : $number || @numbers
-sub htons
+sub htons # number ; number // or array of same
{
return unless defined wantarray;
- carp "Wrong number of arguments ($#_) to " . __PACKAGE__ . "::htons, called"
+ carp "Wrong number of arguments ($#_) to ${myclass}::htons, called"
if @_ != 1 and !wantarray;
unpack('n*', pack('S*', @_));
}
-#& ntohl($number||@numbers) : $number || @numbers
-sub ntohl
+sub ntohl # number ; number // or array of same
{
return unless defined wantarray;
- carp "Wrong number of arguments ($#_) to " . __PACKAGE__ . "::ntohl, called"
+ carp "Wrong number of arguments ($#_) to ${myclass}::ntohl, called"
if @_ != 1 and !wantarray;
unpack('L*', pack('N*', @_));
}
-#& ntohs($number||@numbers) : $number || @numbers
-sub ntohs
+sub ntohs # number ; number // or array of same
{
return unless defined wantarray;
- carp "Wrong number of arguments ($#_) to " . __PACKAGE__ . "::ntohs, called"
+ carp "Wrong number of arguments ($#_) to ${myclass}::ntohs, called"
if @_ != 1 and !wantarray;
unpack('S*', pack('n*', @_));
}
# removed inet_ntoa that was here -- the one in Socket is (now) good enough
-#& pack_sockaddr_in([$family,] $port, $in_addr) : $packed_addr
-sub pack_sockaddr_in ($$;$)
+sub pack_sockaddr_in ($$;$) # [$family,] $port, $in_addr
{
unshift(@_,AF_INET) if @_ == 2;
_pack_sockaddr_in($_[0], $_[1], $_[2]);
@@ -399,9 +396,9 @@ sub inet_addr; # (helps with -w)
my $debug = 0;
-#& _debug($this, [$newval]) : oldval
-sub _debug : locked
+sub _debug # $this, [$newval] ; returns oldval
{
+ use attrs 'locked';
my ($this,$newval) = @_;
return $this->debug($newval) if ref $this;
my $prev = $debug;
@@ -423,8 +420,7 @@ my @Keys = qw(lclhost lcladdr lclservice lclport
# leave these to be init'ed on the first new() call
my (%Keys,%Sopts);
-#& new($class, [\%params]) : {$obj | undef}
-sub new
+sub new # $class, [\%params]
{
my $whoami = $_[0]->_trace(\@_,1);
my($class,@Args,$self) = @_;
@@ -434,30 +430,30 @@ sub new
(defined $self ? "=$self" : " undefined") .
" after sub-new");
if ($self) {
- CORE::dump if $debug > 1 and
+ dump if $debug > 1 and
ref $self ne $class || "$self" !~ /HASH/;
# init object debug level
$self->setparams({'debug'=>$debug},-1);
if (%Keys) {
- $ {*$self}{Keys} = { %Keys } ;
+ ${*$self}{Keys} = { %Keys } ;
}
else {
# register our keys and their handlers
- $self->register_param_keys(\@Keys);
- $self->register_param_handlers(\%keyhandlers);
- %Keys = %{ $ {*$self}{Keys} } ;
+ $self->registerParamKeys(\@Keys);
+ $self->registerParamHandlers(\%keyhandlers);
+ %Keys = %{ ${*$self}{Keys} } ;
}
if (%Sopts) {
- $ {*$self}{Sockopts} = { %Sopts } ;
+ ${*$self}{Sockopts} = { %Sopts } ;
}
else {
# register our socket options
- $self->register_options('IPPROTO_IP', IPPROTO_IP(), \%sockopts);
- %Sopts = %{ $ {*$self}{Sockopts} } ;
+ $self->registerOptions('IPPROTO_IP', IPPROTO_IP(), \%sockopts);
+ %Sopts = %{ ${*$self}{Sockopts} } ;
}
# set our expected parameters
$self->setparams({PF => PF_INET, AF => AF_INET},-1);
- if ($class eq __PACKAGE__) {
+ if ($class eq $myclass) {
unless ($self->init(@Args)) {
local $!; # protect returned errno value
undef $self; # against close problems inside perl
@@ -477,8 +473,7 @@ sub new
$self;
}
-#& _hostport($self, {'this'|'dest'}, [\]@list) : boolean
-sub _hostport
+sub _hostport # $self, {'this'|'dest'}, [\]@list
{
my($self,$which,@args,$aref) = @_;
$aref = \@args; # assume in-line list unless proved otherwise
@@ -501,9 +496,9 @@ sub _hostport
}
}
-#& init($self, [\%params || @speclist]) : {$self | undef}
-sub init : locked
-{
+sub init # $self, [\%params || @speclist]
+{ # returns updated $self
+ use attrs 'locked', 'method';
$_[0]->_trace(\@_,2);
my($self,@args) = @_;
return $self unless $self = $self->SUPER::init(@args);
@@ -531,20 +526,19 @@ sub init : locked
$self;
}
-#& connect($self, [\]@([host],[port])) : boolean
-sub connect : locked method
+sub connect # $self, [\]@([host],[port])
{
+ use attrs 'locked', 'method';
my($self,@args) = @_;
return undef if @args and not $self->_hostport('dest',@args);
$self->SUPER::connect;
}
-#& _sethost($self,$key,$newval) : {'' | "carp string"}
-sub _sethost
+sub _sethost # $self,$key,$newval
{
my($self,$key,$newval) = @_;
- return "Invalid args to " . __PACKAGE__ . "::_sethost(@_), called"
- if @_ != 3 or ref($ {*$self}{Keys}{$key}) ne 'CODE';
+ return "Invalid args to ${myclass}::_sethost(@_), called"
+ if @_ != 3 or ref(${*$self}{Keys}{$key}) ne 'CODE';
# check for call from delparams
if (!defined $newval) {
my @delkeys;
@@ -604,16 +598,13 @@ sub _sethost
}
}
# valid so far, get out if can't form addresses yet
- $port = $ {*$self}{Parms}{$pkey};
return '' unless
- defined $cport or
- defined $port or
- $pkey eq 'thisport'; # allow for 'bind'
+ ($port = ${*$self}{Parms}{$pkey}) =~ /^\d+$/s or defined($cport) or
+ !defined $port and $pkey eq 'thisport'; # allow for 'bind'
if (defined $cport) {
return $newval if $newval = &_setport($self,$pkey,$cport);
$port = $cport;
}
- $port = 0 unless defined $port;
my $af = $self->getparam('AF',AF_INET,1);
for (@addrs) {
$_ = pack_sockaddr_in($af, $port+0, $_);
@@ -622,9 +613,9 @@ sub _sethost
$self->setparams({$pkey => [@addrs]});
# finally, we have validation
$_[2] = $addr; # update the canonical representation to store
- print STDERR " - " . __PACKAGE__ . "::_sethost $self $key ",
+ print STDERR " - ${myclass}::_sethost $self $key ",
$self->format_addr($addr,1),"\n"
- if $ {*$self}{Parms}{'debug'};
+ if $self->debug;
''; # return nullstring for goodness
}
@@ -3553,9 +3544,8 @@ ap 47806
bacnet 47808
";
-#& _ianaport($servname,\%ports,\$ports) : {$portnum | undef}
-sub _ianaport ($\%\$)
-{
+sub _ianaport ($\%\$) # ($servname,\%ports,\$ports)
+{ # returns port number or undef
my ($svc,$defports,$rstr) = @_;
unless (%$defports) {
%$defports = split(' ', $$rstr);
@@ -3566,12 +3556,11 @@ sub _ianaport ($\%\$)
$defports->{$svc};
}
-#& _setport($self,$key,$newval) : {'' | "carp string"}
-sub _setport
+sub _setport # ($self,$key,$newval)
{
my($self,$key,$newval) = @_;
- return "Invalid arguments to " . __PACKAGE__ . "::_setport(@_), called"
- if @_ != 3 || !exists($ {*$self}{Keys}{$key});
+ return "Invalid arguments to ${myclass}::_setport(@_), called"
+ if @_ != 3 || !exists(${*$self}{Keys}{$key});
my $whoami = $self->_trace(\@_,1);
my($skey,$hkey,$pkey,$svc,$port,$proto,$type,$host,$reval);
my($pname,$defport,@serv);
@@ -3579,8 +3568,8 @@ sub _setport
($pkey = $key) =~ s/service$/port/; # and one for the port
($hkey = $pkey) =~ s/port$/host/; # another for calling _sethost
if (!defined $newval) { # deleting a service or port
- delete $ {*$self}{Parms}{$skey};
- delete $ {*$self}{Parms}{$pkey} unless $self->isconnected;
+ delete ${*$self}{Parms}{$skey};
+ delete ${*$self}{Parms}{$pkey} unless $self->isconnected;
my @delkeys;
if ($pkey eq 'thisport') {
@delkeys = qw(srcaddrlist srcaddr);
@@ -3621,8 +3610,8 @@ sub _setport
}
$reval = $newval; # make resetting $_[2] simple
- $svc = $ {*$self}{Parms}{$skey}; # preserve earlier values
- $port = $ {*$self}{Parms}{$pkey};
+ $svc = ${*$self}{Parms}{$skey}; # keep earlier values around (to preserve)
+ $port = ${*$self}{Parms}{$pkey};
$port = undef if
defined($port) and $port =~ /\D/; # but stored ports must be numeric
($newval,$defport) = ($1,$2+0)
@@ -3657,31 +3646,29 @@ sub _setport
return "Unknown service $newval, found";
}
$reval = (($key eq $skey) ? $svc : $port); # in case we get that far
- $ {*$self}{Parms}{$skey} = $svc if $svc; # in case no port change
+ ${*$self}{Parms}{$skey} = $svc if $svc; # in case no port change
$_[2] = $reval;
- print STDERR " - " . __PACKAGE__ . "::_setport $self $skey $svc\n" if
- $svc and $self->debug;
- print STDERR " - " . __PACKAGE__ . "::_setport $self $pkey $port\n" if
- defined $port and $self->debug;
-# Have to keep going here for implicit bind() from init().
-# return '' if defined($ {*$self}{Parms}{$pkey}) and
-# $ {*$self}{Parms}{$pkey} == $port; # not an update if same number
- $ {*$self}{Parms}{$pkey} = $port; # in case was service key
+ print STDERR " - ${myclass}::_setport $self $skey $svc\n" if
+ $self->debug and $svc;
+ print STDERR " - ${myclass}::_setport $self $pkey $port\n" if
+ $self->debug and defined $port;
+ return '' if defined(${*$self}{Parms}{$pkey}) and
+ ${*$self}{Parms}{$pkey} == $port; # nothing to update if same number
+ ${*$self}{Parms}{$pkey} = $port; # in case was service key
# check for whether we can ask _sethost to set {dst,src}addrlist now
return '' unless
- defined($host = $ {*$self}{Parms}{$hkey}) or $hkey eq 'thishost';
+ $host = ${*$self}{Parms}{$hkey} or $hkey eq 'thishost';
$host = '0' if !defined $host; # 'thishost' value was null
$self->setparams({$hkey => $host},0,1); # try it
''; # return goodness from here
}
-#& _setproto($this, $key, $newval) : {'' | "carp string"}
-sub _setproto
+sub _setproto # $this, $key, $newval
{
my($self,$key,$newval) = @_;
if (!defined $newval) { # delparams call?
- # make both go away at once
- delete @{ $ {*$self}{Parms} }{'IPproto','proto'};
+ delete ${*$self}{Parms}{IPproto}; # make both go away at once
+ delete ${*$self}{Parms}{proto};
return '';
}
my($pname,$proto);
@@ -3709,15 +3696,13 @@ sub _setproto
$pname = 'icmp';
}
}
- $ {*$self}{Parms}{IPproto} = $pname; # update our values
- $ {*$self}{Parms}{proto} = $proto;
- # make sure the right value gets set
- $_[2] = (($key eq 'proto') ? $proto : $pname);
+ ${*$self}{Parms}{IPproto} = $pname; # update our values
+ ${*$self}{Parms}{proto} = $proto;
+ $_[2] = ${*$self}{Parms}{$key}; # make sure the right value gets set
''; # return goodness
}
-#& _addrinfo($this, $sockaddr) : (name, addr, service, portnum)
-sub _addrinfo
+sub _addrinfo # $this, $sockaddr
{
my($this,$sockaddr) = @_;
my($fam,$port,$serv,$name,$addr,@hinfo);
@@ -3730,9 +3715,9 @@ sub _addrinfo
($name, $addr, $serv, $port);
}
-#& getsockinfo($this) : $remote_addr || ($local_addr, $rem_addr) | ()
-sub getsockinfo : locked method
+sub getsockinfo # $this
{
+ use attrs 'locked', 'method';
my($self) = @_;
my($rem,$lcl,$port,$serv,$name,$addr);
($lcl,$rem) = $self->SUPER::getsockinfo;
@@ -3750,8 +3735,7 @@ sub getsockinfo : locked method
: $rem;
}
-#& format_addr($this, $sockaddr, [numeric_only]) : $string
-sub format_addr
+sub format_addr # $this, $sockaddr, [numeric_only]
{
my($this,$sockaddr,$numeric) = @_;
my($name,$addr,$serv,$port) = $this->_addrinfo($sockaddr);
@@ -3783,16 +3767,12 @@ Net::Inet - Internet socket interface module
The C<Net::Inet> module provides basic services for handling
socket-based communications for the Internet protocol family. It
-inherits from
-L<C<Net::Gen>|Net::Gen>,
-and is a base for
-L<C<Net::TCP>|Net::TCP>
-and
-L<C<Net::UDP>|Net::UDP>.
+inherits from C<Net::Gen>, and is a base for C<Net::TCP> and
+C<Net::UDP>.
=head2 Public Methods
-=over 4
+=over
=item new
@@ -3821,7 +3801,7 @@ 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/perl-porters/1998-01/msg01674.html
+F<E<lt>URL:http://www.rosat.mpe-garching.mpg.de/mailing-lists/perl-porters/1998-01/msg01674.htmlE<gt>>
for details.
=item init
@@ -3908,7 +3888,7 @@ Usage:
Returns a formatted representation of the local socket address
associated with the object. A sugar-coated way of calling the
-C<format_addr> method for the C<srcaddr> object parameter.
+C<format_addr> method for the F<srcaddr> object parameter.
=item format_remote_addr
@@ -3918,12 +3898,11 @@ Usage:
Returns a formatted representation of the remote socket address
associated with the object. A sugar-coated way of calling the
-C<format_addr> method for the C<dstaddr> object parameter.
+C<format_addr> method for the F<dstaddr> object parameter.
=item getsockinfo
-An augmented form of
-L<C<Net::Gen::getsockinfo>|Net::Gen/getsockinfo>. Aside from
+An augmented form of C<Net::Gen::getsockinfo>. Aside from
updating more object parameters, it behaves the same as that in
the base class. The additional object parameters which get set
are C<lcladdr>, C<lclhost>, C<lclport>, C<lclservice>,
@@ -3933,8 +3912,7 @@ described in L<"Known Object Parameters"> below.)
=back
There are also various I<accessor> methods for the object parameters.
-See L<Net::Gen/"Public Methods"> (where it talks about C<Accessors>)
-for calling details.
+See L<Net::Gen/Accessors> for calling details.
See L<"Known Object Parameters"> below
for those defined by this class.
@@ -3950,7 +3928,7 @@ None.
These are the socket options known to the C<Net::Inet> module
itself:
-=over 4
+=over
=item Z<>
@@ -3966,7 +3944,7 @@ C<IP_OPTIONS> C<IP_RETOPTS>
These are the object parameters registered by the C<Net::Inet>
module itself:
-=over 4
+=over
=item IPproto
@@ -3976,8 +3954,7 @@ object parameter, and vice versa.
=item proto
-Used the same way as with L<C<Net::Gen>|Net::Gen/proto>,
-but has a handler attached
+Used the same way as with C<Net::Gen>, but has a handler attached
to keep it in sync with C<IPproto>.
=item thishost
@@ -4071,7 +4048,7 @@ successful bind() or connect() call.
=item lclhost
The local hostname stashed by the C<getsockinfo> method after a
-successful bind() or connect(), as resolved from the C<lcladdr>
+successful bind() or connect(), as resolved from the F<lcladdr>
object parameter.
=item lclport
@@ -4082,7 +4059,7 @@ successful bind() or connect() call.
=item lclservice
The local service name stashed by the C<getsockinfo> method after
-a successful bind() or connect(), as resolved from the C<lclport>
+a successful bind() or connect(), as resolved from the F<lclport>
object parameter.
=item remaddr
@@ -4093,7 +4070,7 @@ successful connect() call.
=item remhost
The remote hostname stashed by the C<getsockinfo> method after a
-successful connect() call, as resolved from the C<remaddr>
+successful connect() call, as resolved from the F<remaddr>
object parameter.
=item remport
@@ -4104,14 +4081,14 @@ successful connect() call.
=item remservice
The remote service name stashed by the C<getsockinfo> method after
-a successful connect() call, as resolved from the C<remport>
+a successful connect() call, as resolved from the F<remport>
object parameter.
=back
=head2 Non-Method Subroutines
-=over 4
+=over
=item inet_aton
@@ -4129,7 +4106,7 @@ C<Socket> module.
A synonym for inet_aton() (for old fogeys like me who forget
about the new name). (Yes, I know it's different in C, but in
Perl there's no need to propagate the old inet_addr()
-braindamage of being unable to handle "255.255.255.255", so I didn't.)
+braindamage, so I didn't.)
=item inet_ntoa
@@ -4150,20 +4127,7 @@ from the C<Socket> module.
=item ntohs
-About as those who are used to them might expect, I think.
-However, these versions will return lists in list context, and will
-complain if given a multi-element list in scalar context.
-
-[For those who don't know what these are, and who don't have documentation
-on them in their existing system documentation, these functions convert data
-between 'host' and 'network' byte ordering, for 'short' or 'long' network
-data. (This should explain the 'h', 'n', 's', and 'l' letters in the
-names.) Long network data means 32-bit quantities, such as IP addresses, and
-short network data means 16-bit quantities, such as IP port numbers.
-You'd only need to use these functions if you're not using the methods from
-this package to build your packed 'sockaddr' structures or to unpack their
-data after a connect() or accept().]
-
+As you'd expect, I think.
=item pack_sockaddr_in
@@ -4178,8 +4142,7 @@ $port arguments must be numbers, and the $in_addr argument must
be a packed C<struct in_addr> such as the trailing elements from
perl's gethostent() return list. This differs from the
implementation in the C<Socket> module in that the C<$family>
-argument is available (though optional). The C<$family> argument
-defaults to C<AF_INET>.
+argument is available (though optional).
=item unpack_sockaddr_in
@@ -4191,7 +4154,7 @@ Returns the address family, port, and packed C<struct in_addr>
from the supplied packed C<struct sockaddr_in>. This is the
inverse of pack_sockaddr_in(). This differs from the
implementation in the C<Socket> module in that the C<$family>
-value from the socket address is returned (and might not be C<AF_INET>).
+value from the socket address is returned (and might not be AF_INET).
=item INADDR_UNSPEC_GROUP
@@ -4201,10 +4164,10 @@ value from the socket address is returned (and might not be C<AF_INET>).
=item INADDR_MAX_LOCAL_GROUP
-Constant routines returning the S<unspecified local>, S<all hosts>,
-S<all routers>, or the maximum possible local IP multicast group
+Constant routines returning the F<unspecified local>, F<all hosts>,
+F<all routers>, or the maximum possible local IP multicast group
address, respectively. These routines return results in the form
-of a packed C<struct inaddr> much like the C<INADDR_ANY> result
+of a packed C<struct inaddr> much like C<INADDR_ANY> results
described in L<Socket/INADDR_ANY>.
=item IN_CLASSA
@@ -4260,7 +4223,7 @@ vendor-defined socket options, as listed in L<"Exports"> below.
=head2 Exports
-=over 4
+=over
=item default
@@ -4323,7 +4286,7 @@ C<pack_sockaddr_in> C<unpack_sockaddr_in>
The following :tags are in C<%EXPORT_TAGS>, with the associated exportable
values as listed:
-=over 6
+=over
=item :sockopts
@@ -4414,11 +4377,11 @@ Z<>
=head1 NOTES
-Anywhere a I<service> or I<port> argument is used above, the
+Anywhere a F<service> or F<port> argument is used above, the
allowed syntax is either a service name, a port number, or a
service name with a caller-supplied default port number.
Examples are C<'echo'>, C<7>, and C<'echo(7)'>, respectively.
-For a I<service> argument, a bare port number must be
+For a F<service> argument, a bare port number must be
translatable into a service name with getservbyport() or an error
will result. A service name must be translatable into a port
with getservbyname() or an error will result. However, a service
@@ -4426,38 +4389,29 @@ name with a default port number will succeed (by using the
supplied default) even if the translation with getservbyname()
fails.
-For example:
-
- $obj->setparam('destservice', 'http(80)');
-
-This always succeeds, although if your F</etc/services> file (or
-equivalent for non-UNIX systems) maps "http" to something other than
-port 80, you'll get that other port.
-
-For a contrasting example:
-
- $obj->setparam('destservice', 80);
-
-This will fail, despite the numeric value, if your F</etc/services> file
-(or equivalent) is behind the times and has no mapping to a service name
-for port 80.
+=head1 NYI
-=head1 THREADING STATUS
+This is still missing a way to pretty-print the connection
+information after a successful connect() or accept().
+[Not strictly still true, but the following yet holds.] This is
+largely because I'm not satisfied with any of the obvious ways to
+do it. Now taking suggestions. Proposals so far:
-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.
+ ($peerproto, $peername, $peeraddr, $peerport, $peerservice) =
+ $obj->getsockinfo;
+ @conninfo = $obj->getsockinfo($sockaddr_in);
+ # the above pair are a single proposal
-=head1 SEE ALSO
+ %conninfo = $obj->getsockinfo;
+ %conninfo = $obj->getsockinfo($sockaddr_in);
+ # for these, the keys would be qw(proto hostname address port service)
-L<Net::Gen(3)|Net::Gen>,
-L<Net::TCP(3)|Net::TCP>,
-L<Net::UDP(3)|Net::UDP>
+Of course, it's probably better to return references rather than actual
+arrays, but you get the idea.
=head1 AUTHOR
-Spider Boardman E<lt>spidb@cpan.orgE<gt>
+Spider Boardman F<E<lt>spider@Orb.Nashua.NH.USE<gt>>
=cut
@@ -4466,25 +4420,25 @@ Spider Boardman E<lt>spidb@cpan.orgE<gt>
#any real autoloaded methods go after this line
-#& setdebug($this, [bool, [norecurse]]) : oldvalue
-sub setdebug : locked
+sub setdebug # $this, [bool, [norecurse]]
{
+ use attrs 'locked';
my $this = shift;
$this->_debug($_[0]) .
((@_ > 1 && $_[1]) ? '' : $this->SUPER::setdebug(@_));
}
-#& bind($self, [\]@([host],[port])) : boolean
-sub bind : locked method
+sub bind # $self, [\]@([host],[port])
{
+ use attrs 'locked', 'method';
my($self,@args) = @_;
return undef if @args and not $self->_hostport('this',@args);
$self->SUPER::bind;
}
-#& unbind($self) : boolean
-sub unbind : locked method
+sub unbind # $self
{
+ use attrs 'locked', 'method';
my($self,@args) = @_;
if (@args) {
$whoami = $_[0]->_trace(\@_,0);
@@ -1,260 +0,0 @@
-# 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}
-#+attrs locked
-sub new
-{
- $_[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}
-#+attrs locked method
-sub init
-{
- 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__
-
-=head1 NAME
-
-Net::TCP::Server - TCP sockets interface module for listeners and servers
-
-=head1 SYNOPSIS
-
- use Net::Gen; # optional
- use Net::Inet; # optional
- use Net::TCP; # optional
- use Net::TCP::Server;
-
-=head1 DESCRIPTION
-
-The C<Net::TCP::Server> module provides services for TCP communications
-over sockets. It is layered atop the
-L<C<Net::TCP>|Net::TCP>,
-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::Server> module
-itself, rather than just being inherited from
-L<C<Net::TCP>|Net::TCP>,
-L<C<Net::Inet>|Net::Inet>,
-or
-L<C<Net::Gen>|Net::Gen>.
-
-=over 4
-
-=item new
-
-Usage:
-
- $obj = new Net::TCP::Server;
- $obj = new Net::TCP::Server $service;
- $obj = new Net::TCP::Server $service, \%parameters;
- $obj = new Net::TCP::Server $lcladdr, $service, \%parameters;
- $obj = 'Net::TCP::Server'->new();
- $obj = 'Net::TCP::Server'->new($service);
- $obj = 'Net::TCP::Server'->new($service, \%parameters);
- $obj = 'Net::TCP::Server'->new($lcladdr, $service, \%parameters);
-
-Returns a newly-initialised object of the given class. This is
-much like the regular C<new> method of the other modules
-in this distribution, except that it makes it easier
-to specify just a service name or port number, and it automatically
-does a setsockopt() call to set C<SO_REUSEADDR> to make the bind() more
-likely to succeed. The C<SO_REUSEADDR> is really done in a base class,
-but it's enabled by defaulting the C<reuseaddr> object parameter to 1 in
-this constructor.
-
-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.
-
-Simple example for server setup:
-
- $lh = 'Net::TCP::Server'->new(7788) or die;
- while ($sh = $lh->accept) {
- defined($pid=fork) or die "fork: $!\n";
- if ($pid) { # parent doesn't need client fh
- $sh->stopio;
- next;
- }
- # child doesn't need listener fh
- $lh->stopio;
- # do per-connection stuff here
- exit;
- }
-
-Note that signal-handling for the child processes is not included in
-this example. See L<perlipc/"Internet TCP Clients and Servers"> for
-related examples which manage subprocesses. However, on many operating
-systems, a simple C<$SIG{CHLD} = 'IGNORE';> will prevent the server
-process from collecting `zombie' subprocesses.
-
-=back
-
-=head2 Protected Methods
-
-none.
-
-=head2 Known Socket Options
-
-There are no socket options specific to the C<Net::TCP::Server> module.
-
-=head2 Known Object Parameters
-
-There are no object parameters registered by the C<Net::TCP::Server>
-module itself.
-
-=head2 Exports
-
-=over 4
-
-=item default
-
-none
-
-=item exportable
-
-none
-
-=item tags
-
-none
-
-=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::TCP(3)|Net::TCP>,
-L<Net::Inet(3)|Net::Inet>,
-L<Net::Gen(3)|Net::Gen>
-
-=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
@@ -1,4 +1,4 @@
-# Copyright 1997,2002 Spider Boardman.
+# Copyright 1997,1998 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -11,31 +11,32 @@
# 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 5.004_05;
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);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+my $myclass;
BEGIN {
- $VERSION = '1.0';
- eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
+ $myclass = __PACKAGE__;
+ $VERSION = '0.86';
}
+sub Version () { "$myclass 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;
+use Net::TCP 0.85;
BEGIN {
- @ISA = 'Net::TCP';
+ @ISA = qw(Net::TCP);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@@ -50,7 +51,6 @@ BEGIN {
%EXPORT_TAGS = (
ALL => [@EXPORT, @EXPORT_OK],
);
-# *AUTOLOAD = \$Net::Gen::AUTOLOAD;
}
# sub AUTOLOAD inherited from Net::Gen (via Net::TCP)
@@ -58,7 +58,7 @@ BEGIN {
# However, since 5.003_96 will make simple subroutines not inherit AUTOLOAD...
#sub AUTOLOAD
#{
-# #$Net::Gen::AUTOLOAD = $AUTOLOAD;
+# $Net::Gen::AUTOLOAD = $AUTOLOAD;
# goto &Net::Gen::AUTOLOAD;
#}
@@ -69,8 +69,7 @@ BEGIN {
# 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
+sub new # classname, [[hostspec,] service,] [\%params]
{
$_[0]->_trace(\@_,1);
my ($xclass, @Args) = @_;
@@ -92,21 +91,21 @@ sub new : locked
$self;
}
-#& init($self, [@stuff]) : {$self | undef}
-sub init : locked method
+sub init # $self, [@stuff] ; returns updated $self
{
+ use attrs '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;
+ return unless $self->_hostport('this',\@Args);
+ return unless $self->SUPER::init;
if ($self->getparam('srcaddrlist') && !$self->isbound) {
- return undef unless $self->bind;
+ return unless $self->bind;
}
if ($self->isbound && !$self->didlisten) {
- return undef unless $self->isconnected or $self->listen;
+ return unless $self->isconnected or $self->listen;
}
$self;
}
@@ -125,6 +124,7 @@ Net::TCP::Server - TCP sockets interface module for listeners and servers
=head1 SYNOPSIS
+ use Socket; # optional
use Net::Gen; # optional
use Net::Inet; # optional
use Net::TCP; # optional
@@ -133,23 +133,18 @@ Net::TCP::Server - TCP sockets interface module for listeners and servers
=head1 DESCRIPTION
The C<Net::TCP::Server> module provides services for TCP communications
-over sockets. It is layered atop the
-L<C<Net::TCP>|Net::TCP>,
-L<C<Net::Inet>|Net::Inet>,
-and
-L<C<Net::Gen>|Net::Gen>
+over sockets. It is layered atop the C<Net::TCP>, C<Net::Inet>,
+and C<Net::Gen>
modules, which are part of the same distribution.
=head2 Public Methods
The following methods are provided by the C<Net::TCP::Server> module
-itself, rather than just being inherited from
-L<C<Net::TCP>|Net::TCP>,
-L<C<Net::Inet>|Net::Inet>,
-or
-L<C<Net::Gen>|Net::Gen>.
+itself, rather than just being inherited from C<Net::TCP>,
+C<Net::Inet>, or
+C<Net::Gen>.
-=over 4
+=over
=item new
@@ -177,7 +172,7 @@ 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
+F<E<lt>URL:http://www.rosat.mpe-garching.mpg.de/mailing-lists/perl-porters/1998-01/msg01674.htmlE<gt>>
for details.
Simple example for server setup:
@@ -218,7 +213,7 @@ module itself.
=head2 Exports
-=over 4
+=over
=item default
@@ -234,22 +229,9 @@ none
=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::TCP(3)|Net::TCP>,
-L<Net::Inet(3)|Net::Inet>,
-L<Net::Gen(3)|Net::Gen>
-
=head1 AUTHOR
-Spider Boardman E<lt>spidb@cpan.orgE<gt>
+Spider Boardman F<E<lt>spider@Orb.Nashua.NH.USE<gt>>
=cut
@@ -1,351 +0,0 @@
-# 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
-#+attrs locked
-sub _debug
-{
- 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
-
-#+attrs locked
-sub new
-{
- 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
@@ -1,4 +1,4 @@
-# Copyright 1995,2002 Spider Boardman.
+# Copyright 1995,1999 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -11,30 +11,31 @@
# 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 5.004_05; # 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);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+my $myclass;
BEGIN {
- $VERSION = '1.0';
- eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
+ $myclass = __PACKAGE__;
+ $VERSION = '0.90';
}
+sub Version () { "$myclass 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';
+use Net::Inet 0.90;
+use Net::Gen 0.90;
+use Socket qw(!/^[a-z]/ !SOMAXCONN);
BEGIN {
- @ISA = 'Net::Inet';
- *AUTOLOAD = \$Net::Gen::AUTOLOAD;
+ @ISA = qw(Net::Inet);
# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)
@@ -76,7 +77,7 @@ BEGIN {
;# However, since 5.003_96 will make simple subroutines not inherit AUTOLOAD...
sub AUTOLOAD
{
- #$Net::Gen::AUTOLOAD = $AUTOLOAD;
+ $Net::Gen::AUTOLOAD = $AUTOLOAD;
goto &Net::Gen::AUTOLOAD;
}
@@ -103,13 +104,13 @@ my %sockopts;
# out of known TCP options
);
-__PACKAGE__->initsockopts( IPPROTO_TCP, \%sockopts );
+$myclass->initsockopts( IPPROTO_TCP, \%sockopts );
my $debug = 0;
-#& _debug($this, [$newval]) : oldval
-sub _debug : locked
+sub _debug # $this, [$newval] ; returns oldval
{
+ use attrs 'locked';
my ($this,$newval) = @_;
return $this->debug($newval) if ref $this;
my $prev = $debug;
@@ -119,7 +120,7 @@ sub _debug : locked
my %Sopts; # do a full register_options only once
-sub new : locked
+sub new
{
my $whoami = $_[0]->_trace(\@_,1);
my($class,@args) = @_;
@@ -132,17 +133,17 @@ sub new : locked
;# no new keys for TCP?
# register our socket options
if (%Sopts) {
- $ {*$self}{Sockopts} = { %Sopts } ;
+ ${*$self}{Sockopts} = { %Sopts } ;
}
else {
- $self->register_options('IPPROTO_TCP', IPPROTO_TCP(), \%sockopts);
- %Sopts = %{ $ {*$self}{Sockopts} } ;
+ $self->registerOptions('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__) {
+ if ($class eq $myclass) {
unless ($self->init(@args)) {
local $!; # protect returned errno value
undef $self; # against excess closes in perl core
@@ -155,12 +156,11 @@ sub new : locked
$self;
}
-#& _addrinfo($this, $sockaddr, [numeric_only]) : @list
-sub _addrinfo
+sub _addrinfo # $this, $sockaddr, [numeric_only]
{
my($this,@args,@r) = @_;
@r = $this->SUPER::_addrinfo(@args);
- unless (!@r or $args[1] or ref($this) or $r[2] ne $r[3]) {
+ unless (!@r or ref($this) or $r[2] ne $r[3]) {
$this = getservbyport(htons($r[3]), 'tcp');
$r[2] = $this if defined $this;
}
@@ -180,6 +180,7 @@ Net::TCP - TCP sockets interface module
=head1 SYNOPSIS
+ use Socket; # optional
use Net::Gen; # optional
use Net::Inet; # optional
use Net::TCP;
@@ -187,21 +188,16 @@ Net::TCP - TCP sockets interface module
=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>
+over sockets. It is layered atop the C<Net::Inet> and C<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>.
+itself, rather than just being inherited from C<Net::Inet> or
+C<Net::Gen>.
-=over 4
+=over
=item new
@@ -222,7 +218,7 @@ 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
+inherits from C<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).
@@ -231,7 +227,7 @@ 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
+F<E<lt>URL:http://www.rosat.mpe-garching.mpg.de/mailing-lists/perl-porters/1998-01/msg01674.htmlE<gt>>
for details.
=back
@@ -244,7 +240,7 @@ none.
These are the socket options known to the C<Net::TCP> module itself:
-=over 4
+=over
=item Z<>
@@ -259,8 +255,7 @@ 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
+from the C<TIESCALAR> method of C<Net::Gen>. 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.
@@ -272,7 +267,7 @@ Example:
print $y while defined($y = $x);
untie $x;
-This is an expensive re-implementation of S<finger -s> on many
+This is an expensive re-implementation of F<finger -s> on many
machines.
Each assignment to the tied scalar is really a call to the C<put>
@@ -282,7 +277,7 @@ C<FETCH> method).
=head2 Exports
-=over 4
+=over
=item default
@@ -300,7 +295,7 @@ C<TH_SYN> C<TH_URG>
The following I<:tags> are available for grouping related exportable
items:
-=over 6
+=over
=item :sockopts
@@ -325,22 +320,9 @@ 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>
+Spider Boardman F<E<lt>spider@Orb.Nashua.NH.USE<gt>>
=cut
@@ -1,386 +0,0 @@
-# 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: UDP.dat,v 1.21 2002/03/30 10:10:55 spider Exp $"
-
-package Net::UDP;
-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 *AUTOLOAD);
-
-BEGIN {
- $VERSION = '1.0';
- eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
-}
-
-use AutoLoader;
-
-use Net::Inet 1.0;
-use Net::Gen 1.0 ':sockvals', ':families';
-
-BEGIN {
- @ISA = 'Net::Inet';
- *AUTOLOAD = \$Net::Gen::AUTOLOAD;
-}
-
-# Cheat on AUTOLOAD inheritance.
-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.
-
-# No new socket options for UDP
-
-# Module-specific object options
-
-my @Keys = qw(unbuffered_input unbuffered_output);
-my @CodeKeys = qw(unbuffered_IO unbuffered_io);
-my %CodeKeys;
-@CodeKeys{@CodeKeys} = (\&_setbuf_unbuf) x @CodeKeys;
-
-my %Keys; # for only calling registration routines once
-
-#+attrs locked
-sub new
-{
- my($class,@args) = @_;
- my $self = $class->SUPER::new(@args);
- $class = ref $class if ref $class;
- if ($self) {
- if (%Keys) {
- $ {*$self}{Keys} = { %Keys } ;
- }
- else {
- $self->register_param_keys(\@Keys);
- $self->register_param_handlers(\%CodeKeys);
- %Keys = %{ $ {*$self}{Keys} } ;
- }
- # no new sockopts for UDP?
- # set our required parameters
- $self->setparams({type => SOCK_DGRAM,
- proto => IPPROTO_UDP,
- IPproto => 'udp',
- netgen_fakeconnect => 1,
- unbuffered_output => 0,
- unbuffered_input => 0}, -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;
-}
-
-#& _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]), 'udp');
- $r[2] = $this if defined $this;
- }
- @r;
-}
-
-# autoloaded methods go after the END token (& pod) below
-
-# hack to ensure that autoloading in Net::Gen doesn't override these...
-# not needed currently, but keep it in mind
-#sub PRINT { goto &_UDP_PRINT; }
-#sub READLINE { goto &_UDP_READLINE; }
-
-1;
-__END__
-
-=head1 NAME
-
-Net::UDP - UDP sockets interface module
-
-=head1 SYNOPSIS
-
- use Net::Gen; # optional
- use Net::Inet; # optional
- use Net::UDP;
-
-=head1 DESCRIPTION
-
-The C<Net::UDP> module provides services for UDP 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::UDP> 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::UDP;
- $obj = new Net::UDP $desthost, $destservice;
- $obj = new Net::UDP \%parameters;
- $obj = new Net::UDP $desthost, $destservice, \%parameters;
- $obj = 'Net::UDP'->new();
- $obj = 'Net::UDP'->new($desthost);
- $obj = 'Net::UDP'->new($desthost, $destservice);
- $obj = 'Net::UDP'->new(\%parameters);
- $obj = 'Net::UDP'->new($desthost, $destservice, \%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::UDP>
-inherits from
-L<C<Net::Inet>|Net::Inet/init>. In particular, this means that if
-both a host and a service are given, that an object will only be
-returned if a connect() call was successful.
-
-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.
-
-=item PRINT
-
-Usage:
-
- $ok = $obj->PRINT(@args);
- $ok = print $tied_fh @args;
-
-This method, intended to be used with tied filehandles, behaves like one
-of two inherited methods from the
-L<C<Net::Gen>|Net::Gen> class, depending on the
-setting of the object parameter C<unbuffered_output>. If that parameter
-is false (the default), then the normal print() builtin is used.
-If the C<unbuffered_output> parameter is true, then each print()
-operation will actually result in a call to the C<send> method,
-requiring that the object be connected or that its message is in
-response to its last normal recv() (with a C<flags> parameter of
-C<0>). The value of the $\ variable is ignored in that case, but
-the $, variable is still used if the C<@args> array has multiple
-elements.
-
-=item READLINE
-
-Usage:
-
- $line_or_datagram = $obj->READLINE;
- $line_or_datagram = <TIED_FH>;
- $line_or_datagram = readline(TIED_FH);
- @lines_or_datagrams = $obj->READLINE;
- @lines_or_datagrams = <TIED_FH>;
- @lines_or_datagrams = readline(TIED_FH);
-
-This method, intended to be used with tied filehandles, behaves
-like one of two inherited methods from the L<C<Net::Gen>|Net::Gen> class,
-depending on the setting of the object parameter
-C<unbuffered_input>. If that parameter is false (the default),
-then this method does line-buffering of its input as defined by
-the current setting of the $/ variable. If the
-<unbuffered_input> parameter is true, then the input records will
-be exact recv() datagrams, disregarding the setting of the $/
-variable. Note that invoking the C<READLINE> method in list
-context is likely to hang, since UDP sockets typically don't
-return EOF.
-
-=back
-
-=head2 Protected Methods
-
-none.
-
-=head2 Known Socket Options
-
-There are no object parameters registered by the C<Net::UDP> module itself.
-
-=head2 Known Object Parameters
-
-The following object parameters are registered by the C<Net::UDP> module
-(as distinct from being inherited from
-L<C<Net::Gen>|Net::Gen>
-or
-L<C<Net::Inet>|Net::Inet>):
-
-=over 4
-
-=item unbuffered_input
-
-If true, the C<READLINE> operation on tied filehandles will return each recv()
-buffer as though it were a single separate line, independently of the setting
-of the $/ variable. The default is false, which causes the C<READLINE>
-interface to return lines split at boundaries as appropriate for $/.
-(The C<READLINE> method for tied filehandles is the C<E<lt>FHE<gt>>
-operation.) Note that calling the C<READLINE> method
-in list context is likely to hang for UDP sockets.
-
-=item unbuffered_output
-
-If true, the C<PRINT> operation on tied filehandles will result in calls to
-the send() builtin rather than the print() builtin, as described in L</PRINT>
-above. The default is false, which causes the C<PRINT> method to use the
-print() builtin.
-
-=item unbuffered_IO
-
-This object parameter's value is unreliable on C<getparam> or C<getparams>
-method calls. It is provided as a handy way to set both the
-C<unbuffered_output> and C<unbuffered_input> object parameters to the same
-value at the same time during C<new> calls.
-
-=back
-
-=head2 TIESCALAR support
-
-Tieing of scalars to a UDP 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 regard to this module.
-
-Example:
-
- tie $x,'Net::UDP',0,'daytime' or die "tie to Net::UDP: $!";
- $x = "\n"; $x = "\n";
- print $y if defined($y = $x);
- untie $x;
-
-This is an expensive re-implementation of C<date> 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<READLINE> method (via the
-C<FETCH> method).
-
-=head2 TIEHANDLE support
-
-As inherited from
-L<C<Net::Inet>|Net::Inet>
-and
-L<C<Net::Gen>|Net::Gen/TIEHANDLE>,
-with the addition of
-unbuffered I/O options for the C<READLINE> and C<PRINT> methods.
-
-Example:
-
- tie *FH,'Net::UDP',{unbuffered_IO => 1, thisport => $n, thishost => 0}
- or die;
- while (<FH>) {
- last if is_shutdown_msg($_);
- print FH response($_);
- }
- untie *FH;
-
-This shows how to make a UDP-based filehandle return (and send) datagrams
-even when used in the usual perlish paradigm. For some applications,
-this can be helpful to avoid cluttering the message processing code with
-the details of handling datagrams. In particular, this example relies on
-the underlying support for replying to the last address in a recvfrom()
-for datagram sockets, thus hiding the details of tracking and using
-that information.
-
-=head2 Exports
-
-none
-
-=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>
-
-=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
-
-#& _setbuf_unbuf($self, $param, $newvalue) : {'' | "carp string"}
-sub _setbuf_unbuf
-{
- my ($self,$what,$newval) = @_;
- $self->setparams({unbuffered_input => $newval,
- unbuffered_output => $newval});
- '';
-}
-
-#& PRINT($self, @args) : OKness
-#+attrs locked method
-sub PRINT
-{
- my $self = shift;
- if ($self->getparam('unbuffered_output')) {
- $self->send(join $, , @_);
- }
- else {
- print {$self} @_;
- }
-}
-
-#& READLINE($self) : $line | undef || @lines
-#+attrs locked method
-sub READLINE
-{
- my $whoami = $_[0]->_trace(\@_,5);
- carp "Excess arguments to ${whoami}, ignored" if @_ > 1;
- my $self = shift;
- if ($self->getparam('unbuffered_input')) {
- if (wantarray) {
- my ($line,@lines);
- push @lines, $line while defined($line = $self->recv);
- @lines;
- }
- else {
- $self->recv;
- }
- }
- else {
- $self->SUPER::READLINE;
- }
-}
@@ -1,4 +1,4 @@
-# Copyright 1995,2002 Spider Boardman.
+# Copyright 1995,1996,1997,1998 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -11,36 +11,37 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-# rcsid: "@(#) $Id: UDP.dat,v 1.21 2002/03/30 10:10:55 spider Exp $"
package Net::UDP;
-use 5.004_04; # new minimum Perl version for this package
+use 5.004_05; # 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 *AUTOLOAD);
+use vars qw($VERSION @ISA $AUTOLOAD);
+my $myclass;
BEGIN {
- $VERSION = '1.0';
- eval "sub Version () { __PACKAGE__ . ' v$VERSION' }";
+ $myclass = __PACKAGE__;
+ $VERSION = '0.86';
}
+sub Version () { "$myclass v$VERSION" }
use AutoLoader;
-use Net::Inet 1.0;
-use Net::Gen 1.0 ':sockvals', ':families';
+use Net::Inet 0.85;
+use Net::Gen 0.85;
+use Socket qw(!/^[a-z]/ !SOMAXCONN);
BEGIN {
- @ISA = 'Net::Inet';
- *AUTOLOAD = \$Net::Gen::AUTOLOAD;
+ @ISA = qw(Net::Inet);
}
# Cheat on AUTOLOAD inheritance.
sub AUTOLOAD
{
- #$Net::Gen::AUTOLOAD = $AUTOLOAD;
+ $Net::Gen::AUTOLOAD = $AUTOLOAD;
goto &Net::Gen::AUTOLOAD;
}
@@ -58,29 +59,28 @@ my %CodeKeys;
my %Keys; # for only calling registration routines once
-sub new : locked
+sub new
{
my($class,@args) = @_;
my $self = $class->SUPER::new(@args);
$class = ref $class if ref $class;
if ($self) {
if (%Keys) {
- $ {*$self}{Keys} = { %Keys } ;
+ ${*$self}{Keys} = { %Keys } ;
}
else {
$self->register_param_keys(\@Keys);
$self->register_param_handlers(\%CodeKeys);
- %Keys = %{ $ {*$self}{Keys} } ;
+ %Keys = %{ ${*$self}{Keys} } ;
}
# no new sockopts for UDP?
# set our required parameters
$self->setparams({type => SOCK_DGRAM,
proto => IPPROTO_UDP,
IPproto => 'udp',
- netgen_fakeconnect => 1,
unbuffered_output => 0,
unbuffered_input => 0}, -1);
- if ($class eq __PACKAGE__) {
+ if ($class eq $myclass) {
unless ($self->init(@args)) {
local $!; # protect returned errno value
undef $self; # against excess closes in perl core
@@ -91,12 +91,11 @@ sub new : locked
$self;
}
-#& _addrinfo($this, $sockaddr, [numeric_only]) : @list
-sub _addrinfo
+sub _addrinfo # $this, $sockaddr, [numeric_only]
{
my($this,@args,@r) = @_;
@r = $this->SUPER::_addrinfo(@args);
- unless(!@r or $args[1] or ref($this) or $r[2] ne $r[3]) {
+ unless(!@r or ref($this) or $r[2] ne $r[3]) {
$this = getservbyport(htons($r[3]), 'udp');
$r[2] = $this if defined $this;
}
@@ -119,6 +118,7 @@ Net::UDP - UDP sockets interface module
=head1 SYNOPSIS
+ use Socket; # optional
use Net::Gen; # optional
use Net::Inet; # optional
use Net::UDP;
@@ -126,21 +126,16 @@ Net::UDP - UDP sockets interface module
=head1 DESCRIPTION
The C<Net::UDP> module provides services for UDP communications
-over sockets. It is layered atop the
-L<C<Net::Inet>|Net::Inet>
-and
-L<C<Net::Gen>|Net::Gen>
+over sockets. It is layered atop the C<Net::Inet> and C<Net::Gen>
modules, which are part of the same distribution.
=head2 Public Methods
The following methods are provided by the C<Net::UDP> module
-itself, rather than just being inherited from
-L<C<Net::Inet>|Net::Inet>
-or
-L<C<Net::Gen>|Net::Gen>.
+itself, rather than just being inherited from C<Net::Inet> or
+C<Net::Gen>.
-=over 4
+=over 6
=item new
@@ -162,8 +157,7 @@ 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::UDP>
-inherits from
-L<C<Net::Inet>|Net::Inet/init>. In particular, this means that if
+inherits from C<Net::Inet>. In particular, this means that if
both a host and a service are given, that an object will only be
returned if a connect() call was successful.
@@ -171,7 +165,7 @@ 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
+F<E<lt>URL:http://www.rosat.mpe-garching.mpg.de/mailing-lists/perl-porters/1998-01/msg01674.htmlE<gt>>
for details.
=item PRINT
@@ -182,8 +176,7 @@ Usage:
$ok = print $tied_fh @args;
This method, intended to be used with tied filehandles, behaves like one
-of two inherited methods from the
-L<C<Net::Gen>|Net::Gen> class, depending on the
+of two inherited methods from the C<Net::Gen> class, depending on the
setting of the object parameter C<unbuffered_output>. If that parameter
is false (the default), then the normal print() builtin is used.
If the C<unbuffered_output> parameter is true, then each print()
@@ -206,14 +199,14 @@ Usage:
@lines_or_datagrams = readline(TIED_FH);
This method, intended to be used with tied filehandles, behaves
-like one of two inherited methods from the L<C<Net::Gen>|Net::Gen> class,
+like one of two inherited methods from the C<Net::Gen> class,
depending on the setting of the object parameter
C<unbuffered_input>. If that parameter is false (the default),
then this method does line-buffering of its input as defined by
the current setting of the $/ variable. If the
<unbuffered_input> parameter is true, then the input records will
be exact recv() datagrams, disregarding the setting of the $/
-variable. Note that invoking the C<READLINE> method in list
+variable. Note that invoking the C<READLINE> method in array
context is likely to hang, since UDP sockets typically don't
return EOF.
@@ -230,10 +223,7 @@ There are no object parameters registered by the C<Net::UDP> module itself.
=head2 Known Object Parameters
The following object parameters are registered by the C<Net::UDP> module
-(as distinct from being inherited from
-L<C<Net::Gen>|Net::Gen>
-or
-L<C<Net::Inet>|Net::Inet>):
+(as distinct from being inherited from C<Net::Gen> or C<Net::Inet>):
=over 4
@@ -245,7 +235,7 @@ of the $/ variable. The default is false, which causes the C<READLINE>
interface to return lines split at boundaries as appropriate for $/.
(The C<READLINE> method for tied filehandles is the C<E<lt>FHE<gt>>
operation.) Note that calling the C<READLINE> method
-in list context is likely to hang for UDP sockets.
+in array context is likely to hang.
=item unbuffered_output
@@ -266,8 +256,7 @@ value at the same time during C<new> calls.
=head2 TIESCALAR support
Tieing of scalars to a UDP handle is supported by inheritance
-from the C<TIESCALAR> method of
-L<C<Net::Gen>|Net::Gen/TIESCALAR>. That method only
+from the C<TIESCALAR> method of C<Net::Gen>. 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 regard to this module.
@@ -284,55 +273,21 @@ 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<READLINE> method (via the
+scalar is really a call to the C<getline> method (via the
C<FETCH> method).
=head2 TIEHANDLE support
-As inherited from
-L<C<Net::Inet>|Net::Inet>
-and
-L<C<Net::Gen>|Net::Gen/TIEHANDLE>,
-with the addition of
+As inherited from C<Net::Inet> and C<Net::Gen>, with the additions of
unbuffered I/O options for the C<READLINE> and C<PRINT> methods.
-Example:
-
- tie *FH,'Net::UDP',{unbuffered_IO => 1, thisport => $n, thishost => 0}
- or die;
- while (<FH>) {
- last if is_shutdown_msg($_);
- print FH response($_);
- }
- untie *FH;
-
-This shows how to make a UDP-based filehandle return (and send) datagrams
-even when used in the usual perlish paradigm. For some applications,
-this can be helpful to avoid cluttering the message processing code with
-the details of handling datagrams. In particular, this example relies on
-the underlying support for replying to the last address in a recvfrom()
-for datagram sockets, thus hiding the details of tracking and using
-that information.
-
=head2 Exports
none
-=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>
-
=head1 AUTHOR
-Spider Boardman E<lt>spidb@cpan.orgE<gt>
+Spider Boardman F<E<lt>spider@Orb.Nashua.NH.USE<gt>>
=cut
@@ -340,18 +295,17 @@ Spider Boardman E<lt>spidb@cpan.orgE<gt>
#any real autoloaded methods go after this line
-#& _setbuf_unbuf($self, $param, $newvalue) : {'' | "carp string"}
-sub _setbuf_unbuf
-{
+sub _setbuf_unbuf # $self, $param, $newvalue;
+{ # returns '' or carp string
my ($self,$what,$newval) = @_;
$self->setparams({unbuffered_input => $newval,
unbuffered_output => $newval});
'';
}
-#& PRINT($self, @args) : OKness
-sub PRINT : locked method
+sub PRINT # $self, @args; returns boolean OKness
{
+ use attrs 'locked', 'method';
my $self = shift;
if ($self->getparam('unbuffered_output')) {
$self->send(join $, , @_);
@@ -361,9 +315,9 @@ sub PRINT : locked method
}
}
-#& READLINE($self) : $line | undef || @lines
-sub READLINE : locked method
-{
+sub READLINE # $self; returns buffer or array of buffers
+{ # barfs if called unbuffered in array context
+ use attrs 'locked', 'method';
my $whoami = $_[0]->_trace(\@_,5);
carp "Excess arguments to ${whoami}, ignored" if @_ > 1;
my $self = shift;
@@ -1,259 +0,0 @@
-# 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:24 spider Exp $"
-
-package Net::UNIX::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; # someday add back, along with AUTOLOAD, below
-#use Exporter ();
-use Net::UNIX 1.0;
-use Net::Gen 1.0 qw(/^SOCK_/);
-
-BEGIN {
- @ISA = 'Net::UNIX';
-
-# Items to export into callers namespace by default.
-# (Move infrequently used names to @EXPORT_OK below.)
-
- @EXPORT = qw(
- );
-
- @EXPORT_OK = qw(
- );
-
- %EXPORT_TAGS = (
- ALL => [@EXPORT, @EXPORT_OK],
- );
-# *AUTOLOAD = \$Net::Gen::AUTOLOAD;
-}
-
-# sub AUTOLOAD inherited from Net::Gen
-
-# since 5.003_96 will break simple subroutines with inherited autoload, cheat
-#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 new & init when Net::Gen has them non-autoloaded. Feh.
-
-# No additional sockopts for UNIX-domain sockets (?)
-
-#+attrs locked
-sub new
-{
- my $whoami = $_[0]->_trace(\@_,1);
- my($class,@Args,$self) = @_;
- $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) {
- $self->setparams({reuseaddr => 1}, -1);
- if ($class eq __PACKAGE__) {
- unless ($self->init(@Args)) {
- local $!; # preserve errno
- undef $self; # against the side-effects of this
- undef $self; # another statement needed for unwinding
- }
- }
- }
- ($self || $class)->_trace(0,1," returning " .
- (defined $self ? "self=$self" : "undefined"));
- $self;
-}
-
-#& init($self [, $thispath][, \%params]) : {$self | undef}
-sub init
-{
- my ($self,@args) = @_;
- return undef unless $self->_init('thispath',@args);
- if ($self->isbound) {
- return undef
- unless $self->getparam('type') == SOCK_DGRAM or
- $self->isconnected or $self->didlisten or $self->listen;
- }
- $self;
-}
-
-1;
-
-# autoloaded methods go after the END token (& pod) below
-
-__END__
-
-=head1 NAME
-
-Net::UNIX::Server - UNIX-domain sockets interface module for listeners
-
-=head1 SYNOPSIS
-
- use Net::Gen; # optional
- use Net::UNIX; # optional
- use Net::UNIX::Server;
-
-=head1 DESCRIPTION
-
-The C<Net::UNIX::Server> module provides additional
-services for UNIX-domain socket
-communication. It is layered atop the
-L<C<Net::UNIX>|Net::UNIX>
-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::UNIX::Server> module
-itself, rather than just being inherited from
-L<C<Net::UNIX>|Net::UNIX>
-or
-L<C<Net::Gen>|Net::Gen>.
-
-=over 4
-
-=item new
-
-Usage:
-
- $obj = new Net::UNIX::Server;
- $obj = new Net::UNIX::Server $pathname;
- $obj = new Net::UNIX::Server $pathname, \%parameters;
- $obj = 'Net::UNIX::Server'->new();
- $obj = 'Net::UNIX::Server'->new($pathname);
- $obj = 'Net::UNIX::Server'->new($pathname, \%parameters);
-
-Returns a newly-initialised object of the given class. This is
-much like the regular C<new> methods of other modules in this
-distribution, except that it does a
-C<bind> rather than a C<connect>, and it does a C<listen>. Unless
-specified otherwise with a C<type> object parameter, the underlying
-socket will be a datagram socket (C<SOCK_DGRAM>).
-
-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.
-
-See L<Net::TCP::Server> for an example of running a server. The
-differences are only in the module names and the fact that UNIX-domain
-sockets bind to a pathname rather than to a port number. Of course,
-that example is for stream (C<type = SOCK_STREAM>) sockets rather than
-for datagrams. UNIX-domain datagram sockets don't need to do an
-accept() (and can't where I've tested this code), and can't answer back
-to their clients unless those clients have also bound to a specific path
-name.
-
-=item init
-
-Usage:
-
- return undef unless $self = $self->init;
- return undef unless $self = $self->init(\%parameters);
- return undef unless $self = $self->init($pathname);
- return undef unless $self = $self->init($pathname, \%parameters);
-
-Verifies that all previous parameter assignments are valid (via
-C<checkparams>). Returns the incoming object on success, and
-C<undef> on failure. Usually called only via a derived class's
-C<init> method or its own C<new> call.
-
-=back
-
-=head2 Protected Methods
-
-[See the description in L<Net::Gen/"Protected Methods"> for my
-definition of protected methods in Perl.]
-
-None.
-
-=head2 Known Socket Options
-
-There are no socket options known to the C<Net::UNIX::Server> module itself.
-
-=head2 Known Object Parameters
-
-There are no object parameters registered by the C<Net::UNIX::Server> module
-itself.
-
-=head2 Exports
-
-=over 4
-
-=item default
-
-None.
-
-=item exportable
-
-None.
-
-=item tags
-
-The following I<:tags> are available for grouping exportable items:
-
-=over 6
-
-=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::UNIX(3)|Net::UNIX>,
-L<Net::Gen(3)|Net::Gen>
-
-=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
@@ -1,4 +1,4 @@
-# Copyright 1997,2002 Spider Boardman.
+# Copyright 1997,1998 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -11,29 +11,32 @@
# 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:24 spider Exp $"
package Net::UNIX::Server;
-use 5.004_04;
+use 5.004_05;
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);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+my $myclass;
BEGIN {
- $VERSION = '1.0';
- eval "sub Version { __PACKAGE__ . ' v$VERSION' }";
+ $myclass = __PACKAGE__;
+ $VERSION = '0.86';
}
+sub Version { "$myclass v$VERSION" }
#use AutoLoader; # someday add back, along with AUTOLOAD, below
#use Exporter ();
-use Net::UNIX 1.0;
-use Net::Gen 1.0 qw(/^SOCK_/);
+#use Net::Gen 0.85 qw(/pack_sockaddr$/);
+#use Socket qw(!pack_sockaddr_un !unpack_sockaddr_un);
+use Socket '/^SOCK_/';
+use Net::UNIX 0.85;
BEGIN {
- @ISA = 'Net::UNIX';
+ @ISA = qw(Net::UNIX);
# Items to export into callers namespace by default.
# (Move infrequently used names to @EXPORT_OK below.)
@@ -47,7 +50,6 @@ BEGIN {
%EXPORT_TAGS = (
ALL => [@EXPORT, @EXPORT_OK],
);
-# *AUTOLOAD = \$Net::Gen::AUTOLOAD;
}
# sub AUTOLOAD inherited from Net::Gen
@@ -55,7 +57,7 @@ BEGIN {
# since 5.003_96 will break simple subroutines with inherited autoload, cheat
#sub AUTOLOAD
#{
-# #$Net::Gen::AUTOLOAD = $AUTOLOAD;
+# $Net::Gen::AUTOLOAD = $AUTOLOAD;
# goto &Net::Gen::AUTOLOAD;
#}
@@ -67,7 +69,7 @@ BEGIN {
# No additional sockopts for UNIX-domain sockets (?)
-sub new : locked
+sub new
{
my $whoami = $_[0]->_trace(\@_,1);
my($class,@Args,$self) = @_;
@@ -91,8 +93,7 @@ sub new : locked
$self;
}
-#& init($self [, $thispath][, \%params]) : {$self | undef}
-sub init
+sub init # $self [, $thispath][, \%params]
{
my ($self,@args) = @_;
return undef unless $self->_init('thispath',@args);
@@ -116,6 +117,7 @@ Net::UNIX::Server - UNIX-domain sockets interface module for listeners
=head1 SYNOPSIS
+ use Socket; # optional
use Net::Gen; # optional
use Net::UNIX; # optional
use Net::UNIX::Server;
@@ -124,22 +126,15 @@ Net::UNIX::Server - UNIX-domain sockets interface module for listeners
The C<Net::UNIX::Server> module provides additional
services for UNIX-domain socket
-communication. It is layered atop the
-L<C<Net::UNIX>|Net::UNIX>
-and
-L<C<Net::Gen>|Net::Gen>
-modules,
+communication. It is layered atop the C<Net::UNIX> and C<Net::Gen> modules,
which are part of the same distribution.
=head2 Public Methods
The following methods are provided by the C<Net::UNIX::Server> module
-itself, rather than just being inherited from
-L<C<Net::UNIX>|Net::UNIX>
-or
-L<C<Net::Gen>|Net::Gen>.
+itself, rather than just being inherited from C<Net::UNIX> or C<Net::Gen>.
-=over 4
+=over
=item new
@@ -163,7 +158,7 @@ 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
+F<E<lt>URL:http://www.rosat.mpe-garching.mpg.de/mailing-lists/perl-porters/1998-01/msg01674.htmlE<gt>>
for details.
See L<Net::TCP::Server> for an example of running a server. The
@@ -209,7 +204,7 @@ itself.
=head2 Exports
-=over 4
+=over
=item default
@@ -223,7 +218,7 @@ None.
The following I<:tags> are available for grouping exportable items:
-=over 6
+=over
=item :ALL
@@ -235,21 +230,9 @@ 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::UNIX(3)|Net::UNIX>,
-L<Net::Gen(3)|Net::Gen>
-
=head1 AUTHOR
-Spider Boardman E<lt>spidb@cpan.orgE<gt>
+Spider Boardman F<E<lt>spider@Orb.Nashua.NH.USE<gt>>
=cut
@@ -1,718 +0,0 @@
-# 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: UNIX.dat,v 1.22 2002/03/30 10:11:08 spider Exp $"
-
-package Net::UNIX;
-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;
-#use Exporter ();
-use Net::Gen 1.0 qw(/pack_sockaddr$/ :sockvals :families);
-
-BEGIN {
- @ISA = 'Net::Gen';
-
-# Items to export into callers namespace by default.
-# (Move infrequently used names to @EXPORT_OK below.)
-
- @EXPORT = qw(
- );
-
- @EXPORT_OK = qw(
- pack_sockaddr_un
- unpack_sockaddr_un
- );
-
- %EXPORT_TAGS = (
- routines => [qw(pack_sockaddr_un unpack_sockaddr_un)],
- ALL => [@EXPORT, @EXPORT_OK],
- );
- *AUTOLOAD = \$Net::Gen::AUTOLOAD;
-}
-
-;# sub AUTOLOAD inherited from Net::Gen
-
-;# since 5.003_96 will break simple subroutines with inherited autoload, cheat
-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.
-
-;# No additional sockopts for UNIX-domain sockets (?)
-
-my $sun_path_len =
- length(Socket::unpack_sockaddr_un(Socket::pack_sockaddr_un('')));
-
-#& _canonpath($path) : returns NUL-padded $path for sun_addr
-sub _canonpath ($)
-{
- my $path = shift;
- my $ix;
- # extend to proper length
- $ix = index($path, "\0");
- if ($ix >= 0) {
- substr($path,$ix) = "\0" x ($sun_path_len - $ix)
- if $ix < $sun_path_len;
- }
- else {
- $ix = length($path);
- if ($ix < $sun_path_len) {
- $path .= "\0" x ($sun_path_len - $ix);
- }
- else {
- $path .= "\0";
- }
- }
- $path;
-}
-
-#& pack_sockaddr_un([$family,] $path) : $packed_addr
-sub pack_sockaddr_un ($;$)
-{
- my(@args) = @_;
- unshift(@args, AF_UNIX) if @args == 1;
- pack_sockaddr($args[0], _canonpath($args[1]));
-}
-
-#& unpack_sockaddr_un($sockaddr_un) : [$fam,] $path
-sub unpack_sockaddr_un ($)
-{
- my $addr = shift;
- my ($fam,$path) = unpack_sockaddr($addr);
- my $nul = index($path, "\0");
- if ($nul >= 0) {
- substr($path, $nul) = '';
- }
- $fam ||= AF_UNIX;
- wantarray ? ($fam, $path) : $path;
-}
-
-my $debug = 0;
-
-#& _debug($this, [$newval]) : oldval
-#+attrs locked
-sub _debug
-{
- my ($this,$newval) = @_;
- return $this->debug($newval) if ref $this;
- my $prev = $debug;
- $debug = 0+$newval if defined $newval;
- $prev;
-}
-
-
-my %keyhandlers = (thispath => \&_setbindpath,
- destpath => \&_setconnpath,
- unbuffered_IO => \&_setbuf_unbuf,
- unbuffered_io => \&_setbuf_unbuf,
-);
-
-my @Keys = qw(unbuffered_input unbuffered_output);
-
-my %Keys; # for storing the registrations
-
-
-#& new($class, [\%params]) : {$obj | undef}
-#+attrs locked
-sub new
-{
- my $whoami = $_[0]->_trace(\@_,1);
- my($class,@Args,$self) = @_;
- $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) {
- # register our keys and their handlers
- if (%Keys) {
- $ {*$self}{Keys} = { %Keys };
- }
- else {
- $self->register_param_keys(\@Keys) if @Keys;
- $self->register_param_handlers(\%keyhandlers);
- %Keys = %{ $ {*$self}{Keys} };
- }
- # register our socket options
- # none for AF_UNIX?
- # set our expected parameters
- $self->setparams({PF => PF_UNIX, AF => AF_UNIX,
- unbuffered_output => 0,
- unbuffered_input => 0,
- type => SOCK_DGRAM},
- -1);
- if ($class eq __PACKAGE__) {
- unless ($self->init(@Args)) {
- local $!; # protect errno
- undef $self; # from the side-effects of this
- undef $self; # another statement needed for unwinding
- }
- }
- }
- if ($debug) {
- if ($self) {
- print STDERR __PACKAGE__ . "::new returning self=$self\n";
- }
- else {
- print STDERR __PACKAGE__ . "::new returning undef\n";
- }
- }
- $self;
-}
-
-#& _setbindpath($self, 'thispath', $path) : {'' | "carp string"}
-sub _setbindpath
-{
- my($self,$what,$path) = @_;
- my $ix;
- if (!defined($path)) {
- # removing, so cooperate
- delete $ {*$self}{Parms}{srcaddrlist};
- return '';
- }
- # canonicalize the path to be of the right length, if possible
- $path = _canonpath($path);
- $ix = index($path, "\0"); # check for NUL-termination
- if (!$ix) { # empty path is not a bind
- delete $ {*$self}{Parms}{srcaddrlist};
- $_[2] = undef;
- }
- else {
- $ {*$self}{Parms}{srcaddrlist} =
- [pack_sockaddr_un($self->getparam('AF',AF_UNIX,1), $path)];
- }
- '';
-}
-
-#& _setconnpath($self, 'destpath', $path) : {'' | "carp string"}
-sub _setconnpath
-{
- my($self,$what,$path) = @_;
- my $ix;
- if (!defined($path)) {
- # removing, so cooperate
- delete $ {*$self}{Parms}{dstaddrlist};
- return '';
- }
- # canonicalize the path to be of the right length, if possible
- $path = _canonpath($path);
- $ix = index($path, "\0"); # check for NUL-termination
- if (!$ix) { # empty path?
- "$what parameter has no path: $path";
- }
- else { # just try it here
- $ {*$self}{Parms}{dstaddrlist} =
- [pack_sockaddr_un($self->getparam('AF',AF_UNIX,1), $path)];
- '';
- }
-}
-
-#& _init($self, whatpath[, $path][, \%params]) : {$self | undef}
-#+attrs locked method
-sub _init
-{
- my ($self,$what,@args,$path,$parms) = @_;
- if (@args == 1 or @args == 2) {
- $parms = $args[-1];
- $parms = undef
- unless $parms and ref($parms) eq 'HASH';
- $path = $args[0];
- $path = undef
- if defined($path) and ref($path);
- }
- croak("Invalid call to " . __PACKAGE__ . "::init(@_)")
- if @args == 2 and !$parms or @args > 2 or !$what;
- $parms ||= {};
- $$parms{$what} = $path if defined $path;
- return undef unless $self->SUPER::init($parms);
- if (scalar %$parms) {
- return undef unless $self->setparams($parms);
- }
- $self->setparams({netgen_fakeconnect=>1},-1) if
- $self->getparam('type') == SOCK_DGRAM;
- if ($self->getparams([qw(srcaddr srcaddrlist dstaddr dstaddrlist)],1) >0) {
- return undef unless $self->isopen or $self->open;
- if ($self->getparams([qw(srcaddr srcaddrlist)],1) > 0) {
- return undef unless $self->isbound or $self->bind;
- }
- if ($self->getparams([qw(dstaddr dstaddrlist)],1) > 0) {
- return undef unless $self->isconnected or $self->connect or
- $self->isconnecting and !$self->blocking;
- }
- }
- $self;
-}
-
-#& init($self [, $destpath][, \%params]) : {$self | undef}
-sub init
-{
- my ($self,@args) = @_;
- $self->_init('destpath',@args);
-}
-
-#& connect($self [, $destpath] [, \%newparams]) : boolean
-#+attrs locked method
-sub connect
-{
- my($self,$path,$parms) = @_;
- if (@_ > 3 or @_ == 3 and (!ref($parms) or ref($path))) {
- croak("Invalid arguments to " . __PACKAGE__ . "::connect(@_), called");
- }
- if (@_ == 2 and ref $path) {
- $parms = $path;
- undef $path;
- }
- else {
- $parms ||= {};
- }
- if (defined $path) {
- $$parms{destpath} = $path;
- }
- if (@_ > 1) {
- return unless $self->setparams($parms);
- }
- $self->SUPER::connect;
-}
-
-#& format_addr({$class|$obj} , $sockaddr) : $string
-sub format_addr
-{
- my ($this,$addr) = @_;
- my ($fam,$sdata) = unpack_sockaddr($addr);
- if ($fam == AF_UNIX) {
- $sdata = unpack_sockaddr_un($addr);
- }
- else {
- $sdata = $this->SUPER::format_addr($addr);
- }
- $sdata;
-}
-
-1;
-
-
-# autoloaded methods go after the END token (& pod) below
-
-__END__
-
-=head1 NAME
-
-Net::UNIX - UNIX-domain sockets interface module
-
-=head1 SYNOPSIS
-
- use Net::Gen; # optional
- use Net::UNIX;
-
-=head1 DESCRIPTION
-
-The C<Net::UNIX> module provides services for UNIX-domain socket
-communication. It is layered atop the
-L<C<Net::Gen>|Net::Gen>
-module, which
-is part of the same distribution.
-
-=head2 Public Methods
-
-The following methods are provided by the C<Net::UNIX> module
-itself, rather than just being inherited from
-L<C<Net::Gen>|Net::Gen>.
-
-=over 4
-
-=item new
-
-Usage:
-
- $obj = new Net::UNIX;
- $obj = new Net::UNIX $pathname;
- $obj = new Net::UNIX \%parameters;
- $obj = new Net::UNIX $pathname, \%parameters;
- $obj = 'Net::UNIX'->new();
- $obj = 'Net::UNIX'->new($pathname);
- $obj = 'Net::UNIX'->new(\%parameters);
- $obj = 'Net::UNIX'->new($pathname, \%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. In particular, this
-means that if a pathname is given, an object will be returned
-only if a connect() call was successful.
-
-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.
-
-=item init
-
-Usage:
-
- return undef unless $self = $self->init;
- return undef unless $self = $self->init(\%parameters);
- return undef unless $self = $self->init($pathname);
- return undef unless $self = $self->init($pathname, \%parameters);
-
-Verifies that all previous parameter assignments are valid (via
-C<checkparams>). Returns the incoming object on success, and
-C<undef> on failure. Usually called only via a derived class's
-C<init> method or its own C<new> call.
-
-=item bind
-
-Usage:
-
- $ok = $obj->bind;
- $ok = $obj->bind($pathname);
- $ok = $obj->bind($pathname,\%newparameters);
-
-Updates the object with the supplied new parameters (if
-supplied), then sets up the C<srcaddrlist> object parameter with
-the specified $pathname argument (if supplied), and then returns
-the value from the inherited C<bind> method.
-
-Example:
-
- $ok = $obj->bind('/tmp/.fnord'); # start a service on /tmp/.fnord
-
-=item connect
-
-Usage:
-
- $ok = $obj->connect;
- $ok = $obj->connect($pathname);
- $ok = $obj->connect($pathname,\%newparameters);
-
-Attempts to establish a connection for the object. If the
-C<newparams> argument is specified, it will be used to update the
-object parameters. Then, if the $pathname argument is specified,
-it will be used to set the C<dstaddrlist> object parameter.
-Finally, the result of a call to the inherited C<connect> method
-will be returned.
-
-=item format_addr
-
-Usage:
-
- $string = $obj->format_addr($sockaddr);
- $string = format_addr Module $sockaddr;
-
-Returns a formatted representation of the socket address. This
-is normally just a pathname, or the constant string C<''>.
-
-=item PRINT
-
-Usage:
-
- $ok = $obj->PRINT(@args);
- $ok = print $tied_fh @args;
-
-This method, intended to be used with tied filehandles, behaves like one
-of two inherited methods from the
-L<C<Net::Gen>|Net::Gen>
-class, depending on the
-setting of the object parameter C<unbuffered_output> and whether the
-socket is a SOCK_STREAM (stream) socket or a datagram socket (the
-default). If that parameter is false (the default) or the socket
-is a stream socket, then the normal print() builtin is used.
-If the C<unbuffered_output> parameter is true for a datagram socket,
-then each print()
-operation will actually result in a call to the C<send> method. The
-value of the $\ variable is ignored in that case, but
-the $, variable is still used if the C<@args> array has multiple
-elements.
-
-=item READLINE
-
-Usage:
-
- $line_or_datagram = $obj->READLINE;
- $line_or_datagram = <TIED_FH>;
- $line_or_datagram = readline(TIED_FH);
- @lines_or_datagrams = $obj->READLINE;
- @lines_or_datagrams = <TIED_FH>;
- @lines_or_datagrams = readline(TIED_FH);
-
-This method, intended to be used with tied filehandles, behaves
-like one of two inherited methods from the L<C<Net::Gen>|Net::Gen> class,
-depending on the setting of the object parameter
-C<unbuffered_input> and whether the socket is a SOCK_STREAM (stream) socket
-or a datagram socket (the default). If that parameter is false (the default)
-or the socket is a stream socket,
-then this method does line-buffering of its input as defined by
-the current setting of the $/ variable. If the
-C<unbuffered_input> parameter is true for a datagram socket,
-then the input records will
-be exact recv() datagrams, disregarding the setting of the $/
-variable.
-
-=back
-
-=head2 Protected Methods
-
-[See the description in L<Net::Gen/"Protected Methods"> for my
-definition of protected methods in Perl.]
-
-None.
-
-=head2 Known Socket Options
-
-There are no socket options known to the C<Net::UNIX> module itself.
-
-=head2 Known Object Parameters
-
-The following object parameters are registered by the C<Net::UNIX> module
-(as distinct from being inherited from
-L<C<Net::Gen>|Net::Gen>):
-
-=over 4
-
-=item unbuffered_input
-
-If true, the C<READLINE> operation on tied filehandles which
-are datagram sockets will return each recv()
-buffer as though it were a single separate line, independently of the setting
-of the $/ variable. The default is false, which causes the C<READLINE>
-interface to return lines split at boundaries as appropriate for $/.
-(The C<READLINE> method for tied filehandles is the C<E<lt>FHE<gt>>
-operation.)
-
-=item unbuffered_output
-
-If true, the C<PRINT> operation on tied filehandles which
-are datagram sockets will result in calls to
-the send() builtin rather than the print() builtin, as described in L</PRINT>
-above. The default is false, which causes the C<PRINT> method to use the
-print() builtin.
-
-=item unbuffered_IO
-
-This object parameter's value is unreliable on C<getparam> or C<getparams>
-method calls. It is provided as a handy way to set both the
-C<unbuffered_output> and C<unbuffered_input> object parameters to the same
-value at the same time during C<new> calls.
-
-=back
-
-=head2 TIESCALAR
-
-Tieing of scalars to a UNIX-domain 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 a true result.
-Thus, for C<Net::UNIX>, C<TIESCALAR> will not succeed unless the
-C<pathname> argument is given.
-
-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<READLINE> method (via the
-C<FETCH> method).
-
-=head2 TIEHANDLE support
-
-As inherited from
-L<C<Net::Gen>|Net::Gen/TIEHANDLE>, with the addition of
-unbuffered datagram I/O options for the C<FETCH>, C<READLINE>,
-and C<PRINT> methods.
-
-=head2 Non-Method Subroutines
-
-=over 4
-
-=item pack_sockaddr_un
-
-Usage:
-
- $connect_address = pack_sockaddr_un($family, $pathname);
- $connect_address = pack_sockaddr_un($pathname);
-
-Returns the packed C<struct sockaddr_un> corresponding to the
-provided $family and $pathname arguments. The $family argument
-as assumed to be C<AF_UNIX> if it is missing. This is otherwise
-the same as the pack_sockaddr_un() routine in the C<Socket>
-module.
-
-=item unpack_sockaddr_un
-
-Usage:
-
- ($family, $pathname) = unpack_sockaddr_un($connected_address);
- $pathname = unpack_sockaddr_un($connected_address);
-
-Returns the address family and pathname (if known) from the
-supplied packed C<struct sockaddr_un>. This is the inverse of
-pack_sockaddr_un(). It differs from the implementation in the
-C<Socket> module in its return of the C<$family> value, and in
-that it trims the returned pathname at the first null character.
-
-=back
-
-=head2 Exports
-
-=over 4
-
-=item default
-
-None.
-
-=item exportable
-
-C<pack_sockaddr_un> C<unpack_sockaddr_un>
-
-=item tags
-
-The following I<:tags> are available for grouping exportable items:
-
-=over 6
-
-=item :routines
-
-C<pack_sockaddr_un> C<unpack_sockaddr_un>
-
-=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::Gen(3)|Net::Gen>,
-L<Net::UNIX::Server(3)|Net::UNIX::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
-
-
-#& setdebug($this, [bool, [norecurse]]) : oldvalues
-#+attrs locked
-sub setdebug
-{
- my $this = shift;
- $this->_debug($_[0]) .
- ((@_ > 1 && $_[1]) ? '' : $this->SUPER::setdebug(@_));
-}
-
-#& bind($self [, $destpath] [, \%newparams]) : boolean
-#+attrs locked method
-sub bind
-{
- my($self,$path,$parms) = @_;
- if (@_ > 3 or @_ == 3 and (!ref($parms) or ref($path))) {
- my $whoami = $self->_trace;
- croak("Invalid arguments to ${whoami}(@_), called");
- }
- if (@_ == 2 and ref $path) {
- $parms = $path;
- undef $path;
- }
- else {
- $parms ||= {};
- }
- if (defined $path) {
- $$parms{thispath} = $path;
- }
- if (@_ > 1) {
- return undef unless $self->setparams($parms);
- }
- $self->SUPER::bind;
-}
-
-#& _setbuf_unbuf($self, $param, $newvalue) : {'' | "carp string"}
-sub _setbuf_unbuf
-{
- my ($self,$what,$newval) = @_;
- $self->setparams({unbuffered_input => $newval,
- unbuffered_output => $newval});
- '';
-}
-
-#& PRINT($self, @args) : boolean OKness
-#+attrs locked method
-sub PRINT
-{
- my $self = shift;
- if ($self->getparam('type',SOCK_DGRAM,1) != SOCK_STREAM and
- $self->getparam('unbuffered_output'))
- {
- $self->send(join $, , @_);
- }
- else {
- print {$self} @_;
- }
-}
-
-#& READLINE($self) : $line | undef || @lines
-#+attrs locked method
-sub READLINE
-{
- my $whoami = $_[0]->_trace(\@_,5);
- carp "Excess arguments to ${whoami}, ignored" if @_ > 1;
- my $self = shift;
- if ($self->getparam('type',SOCK_DGRAM,1) != SOCK_STREAM and
- $self->getparam('unbuffered_input'))
- {
- if (wantarray) {
- my ($line,@lines);
- push @lines, $line while defined($line = $self->recv);
- @lines;
- }
- else {
- $self->recv;
- }
- }
- else {
- $self->SUPER::READLINE;
- }
-}
@@ -1,4 +1,4 @@
-# Copyright 1995,2002 Spider Boardman.
+# Copyright 1995,1996,1997,1998 Spider Boardman.
# All rights reserved.
#
# Automatic licensing for this software is available. This software
@@ -11,28 +11,30 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-# rcsid: "@(#) $Id: UNIX.dat,v 1.22 2002/03/30 10:11:08 spider Exp $"
package Net::UNIX;
-use 5.004_04; # new minimum Perl version for this package
+use 5.004_05; # 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);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+my $myclass;
BEGIN {
- $VERSION = '1.0';
- eval "sub Version { __PACKAGE__ . ' v$VERSION' }";
+ $myclass = __PACKAGE__;
+ $VERSION = '0.86';
}
+sub Version { "$myclass v$VERSION" }
use AutoLoader;
#use Exporter ();
-use Net::Gen 1.0 qw(/pack_sockaddr$/ :sockvals :families);
+use Net::Gen 0.85 qw(/pack_sockaddr$/);
+use Socket qw(!pack_sockaddr_un !unpack_sockaddr_un !SOMAXCONN);
BEGIN {
- @ISA = 'Net::Gen';
+ @ISA = qw(Net::Gen);
# Items to export into callers namespace by default.
# (Move infrequently used names to @EXPORT_OK below.)
@@ -49,7 +51,6 @@ BEGIN {
routines => [qw(pack_sockaddr_un unpack_sockaddr_un)],
ALL => [@EXPORT, @EXPORT_OK],
);
- *AUTOLOAD = \$Net::Gen::AUTOLOAD;
}
;# sub AUTOLOAD inherited from Net::Gen
@@ -57,7 +58,7 @@ BEGIN {
;# since 5.003_96 will break simple subroutines with inherited autoload, cheat
sub AUTOLOAD
{
- #$Net::Gen::AUTOLOAD = $AUTOLOAD;
+ $Net::Gen::AUTOLOAD = $AUTOLOAD;
goto &Net::Gen::AUTOLOAD;
}
@@ -70,8 +71,7 @@ sub AUTOLOAD
my $sun_path_len =
length(Socket::unpack_sockaddr_un(Socket::pack_sockaddr_un('')));
-#& _canonpath($path) : returns NUL-padded $path for sun_addr
-sub _canonpath ($)
+sub _canonpath ($) # $path; returns NUL-padded $path for sun_addr
{
my $path = shift;
my $ix;
@@ -93,16 +93,14 @@ sub _canonpath ($)
$path;
}
-#& pack_sockaddr_un([$family,] $path) : $packed_addr
-sub pack_sockaddr_un ($;$)
+sub pack_sockaddr_un ($;$) # [$family,] $path
{
my(@args) = @_;
unshift(@args, AF_UNIX) if @args == 1;
pack_sockaddr($args[0], _canonpath($args[1]));
}
-#& unpack_sockaddr_un($sockaddr_un) : [$fam,] $path
-sub unpack_sockaddr_un ($)
+sub unpack_sockaddr_un ($) # $sockaddr_un; returns [$fam,] $path
{
my $addr = shift;
my ($fam,$path) = unpack_sockaddr($addr);
@@ -116,9 +114,9 @@ sub unpack_sockaddr_un ($)
my $debug = 0;
-#& _debug($this, [$newval]) : oldval
-sub _debug : locked
+sub _debug # $this, [$newval] ; returns oldval
{
+ use attrs 'locked';
my ($this,$newval) = @_;
return $this->debug($newval) if ref $this;
my $prev = $debug;
@@ -126,20 +124,13 @@ sub _debug : locked
$prev;
}
-
my %keyhandlers = (thispath => \&_setbindpath,
destpath => \&_setconnpath,
- unbuffered_IO => \&_setbuf_unbuf,
- unbuffered_io => \&_setbuf_unbuf,
);
-my @Keys = qw(unbuffered_input unbuffered_output);
-
-my %Keys; # for storing the registrations
+my @Keys = qw();
-
-#& new($class, [\%params]) : {$obj | undef}
-sub new : locked
+sub new # $class, [\%params]
{
my $whoami = $_[0]->_trace(\@_,1);
my($class,@Args,$self) = @_;
@@ -150,23 +141,15 @@ sub new : locked
" after sub-new");
if ($self) {
# register our keys and their handlers
- if (%Keys) {
- $ {*$self}{Keys} = { %Keys };
- }
- else {
- $self->register_param_keys(\@Keys) if @Keys;
- $self->register_param_handlers(\%keyhandlers);
- %Keys = %{ $ {*$self}{Keys} };
- }
+ $self->registerParamKeys(\@Keys) if @Keys;
+ $self->registerParamHandlers(\%keyhandlers);
# register our socket options
# none for AF_UNIX?
# set our expected parameters
$self->setparams({PF => PF_UNIX, AF => AF_UNIX,
- unbuffered_output => 0,
- unbuffered_input => 0,
type => SOCK_DGRAM},
-1);
- if ($class eq __PACKAGE__) {
+ if ($class eq $myclass) {
unless ($self->init(@Args)) {
local $!; # protect errno
undef $self; # from the side-effects of this
@@ -176,47 +159,45 @@ sub new : locked
}
if ($debug) {
if ($self) {
- print STDERR __PACKAGE__ . "::new returning self=$self\n";
+ print STDERR "${myclass}::new returning self=$self\n";
}
else {
- print STDERR __PACKAGE__ . "::new returning undef\n";
+ print STDERR "${myclass}::new returning undef\n";
}
}
$self;
}
-#& _setbindpath($self, 'thispath', $path) : {'' | "carp string"}
-sub _setbindpath
+sub _setbindpath # $self, 'thispath', $path
{
my($self,$what,$path) = @_;
my $ix;
if (!defined($path)) {
# removing, so cooperate
- delete $ {*$self}{Parms}{srcaddrlist};
+ delete ${*$self}{Parms}{srcaddrlist};
return '';
}
# canonicalize the path to be of the right length, if possible
$path = _canonpath($path);
$ix = index($path, "\0"); # check for NUL-termination
if (!$ix) { # empty path is not a bind
- delete $ {*$self}{Parms}{srcaddrlist};
+ delete ${*$self}{Parms}{srcaddrlist};
$_[2] = undef;
}
else {
- $ {*$self}{Parms}{srcaddrlist} =
+ ${*$self}{Parms}{srcaddrlist} =
[pack_sockaddr_un($self->getparam('AF',AF_UNIX,1), $path)];
}
'';
}
-#& _setconnpath($self, 'destpath', $path) : {'' | "carp string"}
-sub _setconnpath
+sub _setconnpath # $self, 'destpath', $path
{
my($self,$what,$path) = @_;
my $ix;
if (!defined($path)) {
# removing, so cooperate
- delete $ {*$self}{Parms}{dstaddrlist};
+ delete ${*$self}{Parms}{dstaddrlist};
return '';
}
# canonicalize the path to be of the right length, if possible
@@ -226,15 +207,15 @@ sub _setconnpath
"$what parameter has no path: $path";
}
else { # just try it here
- $ {*$self}{Parms}{dstaddrlist} =
+ ${*$self}{Parms}{dstaddrlist} =
[pack_sockaddr_un($self->getparam('AF',AF_UNIX,1), $path)];
'';
}
}
-#& _init($self, whatpath[, $path][, \%params]) : {$self | undef}
-sub _init : locked method
+sub _init # $self, whatpath[, $path][, \%params]
{
+ use attrs 'locked', 'method';
my ($self,$what,@args,$path,$parms) = @_;
if (@args == 1 or @args == 2) {
$parms = $args[-1];
@@ -244,7 +225,7 @@ sub _init : locked method
$path = undef
if defined($path) and ref($path);
}
- croak("Invalid call to " . __PACKAGE__ . "::init(@_)")
+ croak("Invalid call to ${myclass}::init(@_)")
if @args == 2 and !$parms or @args > 2 or !$what;
$parms ||= {};
$$parms{$what} = $path if defined $path;
@@ -252,8 +233,6 @@ sub _init : locked method
if (scalar %$parms) {
return undef unless $self->setparams($parms);
}
- $self->setparams({netgen_fakeconnect=>1},-1) if
- $self->getparam('type') == SOCK_DGRAM;
if ($self->getparams([qw(srcaddr srcaddrlist dstaddr dstaddrlist)],1) >0) {
return undef unless $self->isopen or $self->open;
if ($self->getparams([qw(srcaddr srcaddrlist)],1) > 0) {
@@ -267,19 +246,18 @@ sub _init : locked method
$self;
}
-#& init($self [, $destpath][, \%params]) : {$self | undef}
-sub init
+sub init # $self [, $destpath][, \%params]
{
my ($self,@args) = @_;
$self->_init('destpath',@args);
}
-#& connect($self [, $destpath] [, \%newparams]) : boolean
-sub connect : locked method
+sub connect # $self [, $destpath] [, \%newparams]
{
+ use attrs 'locked', 'method';
my($self,$path,$parms) = @_;
if (@_ > 3 or @_ == 3 and (!ref($parms) or ref($path))) {
- croak("Invalid arguments to " . __PACKAGE__ . "::connect(@_), called");
+ croak("Invalid arguments to ${myclass}::connect(@_), called");
}
if (@_ == 2 and ref $path) {
$parms = $path;
@@ -297,8 +275,7 @@ sub connect : locked method
$self->SUPER::connect;
}
-#& format_addr({$class|$obj} , $sockaddr) : $string
-sub format_addr
+sub format_addr # ($class|$obj) , $sockaddr
{
my ($this,$addr) = @_;
my ($fam,$sdata) = unpack_sockaddr($addr);
@@ -324,24 +301,22 @@ Net::UNIX - UNIX-domain sockets interface module
=head1 SYNOPSIS
+ use Socket; # optional
use Net::Gen; # optional
use Net::UNIX;
=head1 DESCRIPTION
The C<Net::UNIX> module provides services for UNIX-domain socket
-communication. It is layered atop the
-L<C<Net::Gen>|Net::Gen>
-module, which
+communication. It is layered atop the C<Net::Gen> module, which
is part of the same distribution.
=head2 Public Methods
The following methods are provided by the C<Net::UNIX> module
-itself, rather than just being inherited from
-L<C<Net::Gen>|Net::Gen>.
+itself, rather than just being inherited from C<Net::Gen>.
-=over 4
+=over
=item new
@@ -369,7 +344,7 @@ 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
+F<E<lt>URL:http://www.rosat.mpe-garching.mpg.de/mailing-lists/perl-porters/1998-01/msg01674.htmlE<gt>>
for details.
=item init
@@ -428,52 +403,6 @@ Usage:
Returns a formatted representation of the socket address. This
is normally just a pathname, or the constant string C<''>.
-=item PRINT
-
-Usage:
-
- $ok = $obj->PRINT(@args);
- $ok = print $tied_fh @args;
-
-This method, intended to be used with tied filehandles, behaves like one
-of two inherited methods from the
-L<C<Net::Gen>|Net::Gen>
-class, depending on the
-setting of the object parameter C<unbuffered_output> and whether the
-socket is a SOCK_STREAM (stream) socket or a datagram socket (the
-default). If that parameter is false (the default) or the socket
-is a stream socket, then the normal print() builtin is used.
-If the C<unbuffered_output> parameter is true for a datagram socket,
-then each print()
-operation will actually result in a call to the C<send> method. The
-value of the $\ variable is ignored in that case, but
-the $, variable is still used if the C<@args> array has multiple
-elements.
-
-=item READLINE
-
-Usage:
-
- $line_or_datagram = $obj->READLINE;
- $line_or_datagram = <TIED_FH>;
- $line_or_datagram = readline(TIED_FH);
- @lines_or_datagrams = $obj->READLINE;
- @lines_or_datagrams = <TIED_FH>;
- @lines_or_datagrams = readline(TIED_FH);
-
-This method, intended to be used with tied filehandles, behaves
-like one of two inherited methods from the L<C<Net::Gen>|Net::Gen> class,
-depending on the setting of the object parameter
-C<unbuffered_input> and whether the socket is a SOCK_STREAM (stream) socket
-or a datagram socket (the default). If that parameter is false (the default)
-or the socket is a stream socket,
-then this method does line-buffering of its input as defined by
-the current setting of the $/ variable. If the
-C<unbuffered_input> parameter is true for a datagram socket,
-then the input records will
-be exact recv() datagrams, disregarding the setting of the $/
-variable.
-
=back
=head2 Protected Methods
@@ -489,44 +418,13 @@ There are no socket options known to the C<Net::UNIX> module itself.
=head2 Known Object Parameters
-The following object parameters are registered by the C<Net::UNIX> module
-(as distinct from being inherited from
-L<C<Net::Gen>|Net::Gen>):
-
-=over 4
-
-=item unbuffered_input
-
-If true, the C<READLINE> operation on tied filehandles which
-are datagram sockets will return each recv()
-buffer as though it were a single separate line, independently of the setting
-of the $/ variable. The default is false, which causes the C<READLINE>
-interface to return lines split at boundaries as appropriate for $/.
-(The C<READLINE> method for tied filehandles is the C<E<lt>FHE<gt>>
-operation.)
-
-=item unbuffered_output
-
-If true, the C<PRINT> operation on tied filehandles which
-are datagram sockets will result in calls to
-the send() builtin rather than the print() builtin, as described in L</PRINT>
-above. The default is false, which causes the C<PRINT> method to use the
-print() builtin.
-
-=item unbuffered_IO
-
-This object parameter's value is unreliable on C<getparam> or C<getparams>
-method calls. It is provided as a handy way to set both the
-C<unbuffered_output> and C<unbuffered_input> object parameters to the same
-value at the same time during C<new> calls.
-
-=back
+There are no object parameters registered by the C<Net::UNIX> module
+itself.
=head2 TIESCALAR
Tieing of scalars to a UNIX-domain handle is supported by
-inheritance from the C<TIESCALAR> method of
-L<C<Net::Gen>|Net::Gen/TIESCALAR>. That
+inheritance from the C<TIESCALAR> method of C<Net::Gen>. That
method only succeeds if a call to a C<new> method results in an
object for which the C<isconnected> method returns a true result.
Thus, for C<Net::UNIX>, C<TIESCALAR> will not succeed unless the
@@ -534,19 +432,12 @@ C<pathname> argument is given.
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<READLINE> method (via the
+scalar is really a call to the C<getline> method (via the
C<FETCH> method).
-=head2 TIEHANDLE support
-
-As inherited from
-L<C<Net::Gen>|Net::Gen/TIEHANDLE>, with the addition of
-unbuffered datagram I/O options for the C<FETCH>, C<READLINE>,
-and C<PRINT> methods.
-
=head2 Non-Method Subroutines
-=over 4
+=over
=item pack_sockaddr_un
@@ -578,7 +469,7 @@ that it trims the returned pathname at the first null character.
=head2 Exports
-=over 4
+=over
=item default
@@ -592,7 +483,7 @@ C<pack_sockaddr_un> C<unpack_sockaddr_un>
The following I<:tags> are available for grouping exportable items:
-=over 6
+=over
=item :routines
@@ -608,21 +499,9 @@ 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::Gen(3)|Net::Gen>,
-L<Net::UNIX::Server(3)|Net::UNIX::Server>
-
=head1 AUTHOR
-Spider Boardman E<lt>spidb@cpan.orgE<gt>
+Spider Boardman F<E<lt>spider@Orb.Nashua.NH.USE<gt>>
=cut
@@ -631,17 +510,17 @@ Spider Boardman E<lt>spidb@cpan.orgE<gt>
#any real autoloaded methods go after this line
-#& setdebug($this, [bool, [norecurse]]) : oldvalues
-sub setdebug : locked
+sub setdebug # $this, [bool, [norecurse]]
{
+ use attrs 'locked';
my $this = shift;
$this->_debug($_[0]) .
((@_ > 1 && $_[1]) ? '' : $this->SUPER::setdebug(@_));
}
-#& bind($self [, $destpath] [, \%newparams]) : boolean
-sub bind : locked method
+sub bind # $self [, $destpath] [, \%newparams]
{
+ use attrs 'locked', 'method';
my($self,$path,$parms) = @_;
if (@_ > 3 or @_ == 3 and (!ref($parms) or ref($path))) {
my $whoami = $self->_trace;
@@ -658,53 +537,7 @@ sub bind : locked method
$$parms{thispath} = $path;
}
if (@_ > 1) {
- return undef unless $self->setparams($parms);
+ return unless $self->setparams($parms);
}
$self->SUPER::bind;
}
-
-#& _setbuf_unbuf($self, $param, $newvalue) : {'' | "carp string"}
-sub _setbuf_unbuf
-{
- my ($self,$what,$newval) = @_;
- $self->setparams({unbuffered_input => $newval,
- unbuffered_output => $newval});
- '';
-}
-
-#& PRINT($self, @args) : boolean OKness
-sub PRINT : locked method
-{
- my $self = shift;
- if ($self->getparam('type',SOCK_DGRAM,1) != SOCK_STREAM and
- $self->getparam('unbuffered_output'))
- {
- $self->send(join $, , @_);
- }
- else {
- print {$self} @_;
- }
-}
-
-#& READLINE($self) : $line | undef || @lines
-sub READLINE : locked method
-{
- my $whoami = $_[0]->_trace(\@_,5);
- carp "Excess arguments to ${whoami}, ignored" if @_ > 1;
- my $self = shift;
- if ($self->getparam('type',SOCK_DGRAM,1) != SOCK_STREAM and
- $self->getparam('unbuffered_input'))
- {
- if (wantarray) {
- my ($line,@lines);
- push @lines, $line while defined($line = $self->recv);
- @lines;
- }
- else {
- $self->recv;
- }
- }
- else {
- $self->SUPER::READLINE;
- }
-}
@@ -1,28 +0,0 @@
-package attrs;
-
-use vars qw($VERSION);
-$VERSION = "0.1";
-
-1;
-
-=head1 NAME
-
-attrs - set/get attributes of a subroutine
-
-=head1 SYNOPSIS
-
- sub foo {
- use attrs qw(locked method);
- ...
- }
-
- @a = attrs::get(\&foo);
-
-=head1 DESCRIPTION
-
-This module lets you set and get attributes for subroutines.
-
-For 5.004_xx this is an empty stub provided for backwards
-compatibility for scripts and modules written for 5.005.
-
-=cut
@@ -1,21 +0,0 @@
-ChangeLog
-Gen.xs
-MANIFEST
-MANIFEST.SKIP
-Makefile.PL
-README
-hints/linux.pl
-lib/Net/Gen.dat
-lib/Net/Inet.dat
-lib/Net/TCP.dat
-lib/Net/UDP.dat
-lib/Net/UNIX.dat
-lib/Net/TCP/Server.dat
-lib/Net/UNIX/Server.dat
-lib/attrs.dat
-manifake
-t/00basic.t
-t/01unix.t
-typemap
-xlib/Test.pm
-xlib/Test/Harness.pm
@@ -1,11 +1,5 @@
#!perl -w
-# rcsid: "@(#) $Id: 00basic.t,v 1.12 1999/08/04 04:59:16 spider Exp $"
-
-BEGIN {
- unshift @INC, './xlib','../xlib' if $] < 5.004_05;
-}
-
use Test;
#use Config ();
use strict;
@@ -42,16 +36,14 @@ END { for my $endcv (@endav) { $endcv->() } }
# test driver, which will `remember' it in %testvals.
my $ok; # continuation flag
-my $failures = 0;
sub tdriver () # run the code refs in @testvec
{
for my $cv (@testvec) {
$ok = $cv->();
$testvals{"$cv"} = $ok;
- $ok || $failures++;
}
- !$failures;
+ $ok;
}
sub ptest () # print out the test name
@@ -1,19 +1,14 @@
#!perl -w
-# rcsid: "@(#) $Id: 01unix.t,v 1.12 1999/08/04 04:59:29 spider Exp $"
-
-BEGIN {
- unshift @INC, './xlib','../xlib' if $] < 5.004_05;
-}
-
use Test;
use Config ();
use strict;
# Special-case the constants we need later
+use Socket 'SOCK_STREAM';
sub Net::Gen::SOMAXCONN () ;
-sub Net::Gen::SOCK_STREAM () ;
-BEGIN { package Net::Gen; *::SOCK_STREAM = \&SOCK_STREAM;}
+
+# Pre-declarations a la `sub SOCK_STREAM' would also have done.
# Just in case, because of problems with some OSes, don't die on SIGPIPE.
$SIG{PIPE} = 'IGNORE';
@@ -49,14 +44,12 @@ END { for my $endcv (@endav) { $endcv->() } }
# test driver, which will `remember' it in %testvals.
my $ok; # continuation flag
-my $failures = 0;
sub tdriver () # run the code refs in @testvec
{
for my $cv (@testvec) {
$ok = $cv->();
$testvals{"$cv"} = $ok;
- $ok || $failures++;
}
}
@@ -136,7 +129,7 @@ push @testvec, \&t_send_hello_dgram;
# check receipt
sub t_chk_hello_dgram {
ptest;
- my $gotmsg = ($ok ? $srvr->recv(40) : "<error>");
+ my $gotmsg = $srvr->recv(40);
ok $gotmsg, $sentmsg;
}
push @testvec, \&t_chk_hello_dgram;
@@ -290,5 +283,5 @@ use Net::Gen;
tdriver;
-exit($failures ? 1 : 0);
+exit 0;
@@ -1,483 +0,0 @@
-package Test::Harness;
-
-BEGIN {require 5.002;}
-use Exporter;
-use Benchmark;
-use Config;
-use FileHandle;
-use strict;
-
-use vars qw($VERSION $verbose $switches $have_devel_corestack $curtest
- @ISA @EXPORT @EXPORT_OK);
-$have_devel_corestack = 0;
-
-$VERSION = "1.1602";
-
-# Some experimental versions of OS/2 build have broken $?
-my $ignore_exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
-
-my $files_in_dir = $ENV{HARNESS_FILELEAK_IN_DIR};
-
-my $tests_skipped = 0;
-my $subtests_skipped = 0;
-
-@ISA=('Exporter');
-@EXPORT= qw(&runtests);
-@EXPORT_OK= qw($verbose $switches);
-
-format STDOUT_TOP =
-Failed Test Status Wstat Total Fail Failed List of failed
--------------------------------------------------------------------------------
-.
-
-format STDOUT =
-@<<<<<<<<<<<<<< @>> @>>>> @>>>> @>>> ^##.##% ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-{ $curtest->{name},
- $curtest->{estat},
- $curtest->{wstat},
- $curtest->{max},
- $curtest->{failed},
- $curtest->{percent},
- $curtest->{canon}
-}
-~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
- $curtest->{canon}
-.
-
-
-$verbose = 0;
-$switches = "-w";
-
-sub globdir { opendir DIRH, shift; my @f = readdir DIRH; closedir DIRH; @f }
-
-sub runtests {
- my(@tests) = @_;
- local($|) = 1;
- my($test,$te,$ok,$next,$max,$pct,$totok,$totbonus,@failed,%failedtests);
- my $totmax = 0;
- my $files = 0;
- my $bad = 0;
- my $good = 0;
- my $total = @tests;
-
- # pass -I flags to children
- my $old5lib = $ENV{PERL5LIB};
- local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC);
-
- if ($^O eq 'VMS') { $switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g }
-
- my @dir_files = globdir $files_in_dir if defined $files_in_dir;
- my $t_start = new Benchmark;
- while ($test = shift(@tests)) {
- $te = $test;
- chop($te);
- if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./; }
- print "$te" . '.' x (20 - length($te));
- my $fh = new FileHandle;
- $fh->open($test) or print "can't open $test. $!\n";
- my $first = <$fh>;
- my $s = $switches;
- $s .= q[ "-T"] if $first =~ /^#!.*\bperl.*-\w*T/;
- $fh->close or print "can't close $test. $!\n";
- my $cmd = ($ENV{'COMPILE_TEST'})?
-"./perl -I../lib ../utils/perlcc $test -run -verbose dcf -log ./compilelog |"
- : "$^X $s $test|";
- $cmd = "MCR $cmd" if $^O eq 'VMS';
- $fh->open($cmd) or print "can't run $test. $!\n";
- $ok = $next = $max = 0;
- @failed = ();
- my %todo = ();
- my $bonus = 0;
- my $skipped = 0;
- while (<$fh>) {
- if( $verbose ){
- print $_;
- }
- if (/^1\.\.([0-9]+) todo([\d\s]+)\;/) {
- $max = $1;
- for (split(/\s+/, $2)) { $todo{$_} = 1; }
- $totmax += $max;
- $files++;
- $next = 1;
- } elsif (/^1\.\.([0-9]+)/) {
- $max = $1;
- $totmax += $max;
- $files++;
- $next = 1;
- } elsif ($max && /^(not\s+)?ok\b/) {
- my $this = $next;
- if (/^not ok\s*(\d*)/){
- $this = $1 if $1 > 0;
- if (!$todo{$this}) {
- push @failed, $this;
- } else {
- $ok++;
- $totok++;
- }
- } elsif (/^ok\s*(\d*)(\s*\#\s*[Ss]kip)?/) {
- $this = $1 if $1 > 0;
- $ok++;
- $totok++;
- $skipped++ if defined $2;
- $bonus++, $totbonus++ if $todo{$this};
- }
- if ($this > $next) {
- # warn "Test output counter mismatch [test $this]\n";
- # no need to warn probably
- push @failed, $next..$this-1;
- } elsif ($this < $next) {
- #we have seen more "ok" lines than the number suggests
- warn "Confused test output: test $this answered after test ", $next-1, "\n";
- $next = $this;
- }
- $next = $this + 1;
- }
- }
- $fh->close; # must close to reap child resource values
- my $wstatus = $ignore_exitcode ? 0 : $?; # Can trust $? ?
- my $estatus;
- $estatus = ($^O eq 'VMS'
- ? eval 'use vmsish "status"; $estatus = $?'
- : $wstatus >> 8);
- if ($wstatus) {
- my ($failed, $canon, $percent) = ('??', '??');
- printf "dubious\n\tTest returned status $estatus (wstat %d, 0x%x)\n",
- $wstatus,$wstatus;
- print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
- if (corestatus($wstatus)) { # until we have a wait module
- if ($have_devel_corestack) {
- Devel::CoreStack::stack($^X);
- } else {
- print "\ttest program seems to have generated a core\n";
- }
- }
- $bad++;
- if ($max) {
- if ($next == $max + 1 and not @failed) {
- print "\tafter all the subtests completed successfully\n";
- $percent = 0;
- $failed = 0; # But we do not set $canon!
- } else {
- push @failed, $next..$max;
- $failed = @failed;
- (my $txt, $canon) = canonfailed($max,$skipped,@failed);
- $percent = 100*(scalar @failed)/$max;
- print "DIED. ",$txt;
- }
- }
- $failedtests{$test} = { canon => $canon, max => $max || '??',
- failed => $failed,
- name => $test, percent => $percent,
- estat => $estatus, wstat => $wstatus,
- };
- } elsif ($ok == $max && $next == $max+1) {
- if ($max and $skipped + $bonus) {
- my @msg;
- push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped")
- if $skipped;
- push(@msg, "$bonus subtest".($bonus>1?'s':'').
- " unexpectedly succeeded")
- if $bonus;
- print "ok, ".join(', ', @msg)."\n";
- } elsif ($max) {
- print "ok\n";
- } else {
- print "skipping test on this platform\n";
- $tests_skipped++;
- }
- $good++;
- } elsif ($max) {
- if ($next <= $max) {
- push @failed, $next..$max;
- }
- if (@failed) {
- my ($txt, $canon) = canonfailed($max,$skipped,@failed);
- print $txt;
- $failedtests{$test} = { canon => $canon, max => $max,
- failed => scalar @failed,
- name => $test, percent => 100*(scalar @failed)/$max,
- estat => '', wstat => '',
- };
- } else {
- print "Don't know which tests failed: got $ok ok, expected $max\n";
- $failedtests{$test} = { canon => '??', max => $max,
- failed => '??',
- name => $test, percent => undef,
- estat => '', wstat => '',
- };
- }
- $bad++;
- } elsif ($next == 0) {
- print "FAILED before any test output arrived\n";
- $bad++;
- $failedtests{$test} = { canon => '??', max => '??',
- failed => '??',
- name => $test, percent => undef,
- estat => '', wstat => '',
- };
- }
- $subtests_skipped += $skipped;
- if (defined $files_in_dir) {
- my @new_dir_files = globdir $files_in_dir;
- if (@new_dir_files != @dir_files) {
- my %f;
- @f{@new_dir_files} = (1) x @new_dir_files;
- delete @f{@dir_files};
- my @f = sort keys %f;
- print "LEAKED FILES: @f\n";
- @dir_files = @new_dir_files;
- }
- }
- }
- my $t_total = timediff(new Benchmark, $t_start);
-
- if ($^O eq 'VMS') {
- if (defined $old5lib) {
- $ENV{PERL5LIB} = $old5lib;
- } else {
- delete $ENV{PERL5LIB};
- }
- }
- my $bonusmsg = '';
- $bonusmsg = (" ($totbonus subtest".($totbonus>1?'s':'').
- " UNEXPECTEDLY SUCCEEDED)")
- if $totbonus;
- if ($tests_skipped) {
- $bonusmsg .= ", $tests_skipped test" . ($tests_skipped != 1 ? 's' : '') .
- ' skipped';
- }
- if ($subtests_skipped) {
- $bonusmsg .= ($tests_skipped ? ', plus ' : ', ').
- "$subtests_skipped subtest"
- . ($subtests_skipped != 1 ? 's' : '') .
- " skipped";
- }
- if ($bad == 0 && $totmax) {
- print "All tests successful$bonusmsg.\n";
- } elsif ($total==0){
- die "FAILED--no tests were run for some reason.\n";
- } elsif ($totmax==0) {
- my $blurb = $total==1 ? "script" : "scripts";
- die "FAILED--$total test $blurb could be run, alas--no output ever seen\n";
- } else {
- $pct = sprintf("%.2f", $good / $total * 100);
- my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
- $totmax - $totok, $totmax, 100*$totok/$totmax;
- my $script;
- for $script (sort keys %failedtests) {
- $curtest = $failedtests{$script};
- write;
- }
- if ($bad) {
- $bonusmsg =~ s/^,\s*//;
- print "$bonusmsg.\n" if $bonusmsg;
- die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
- }
- }
- printf("Files=%d, Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop'));
-
- return ($bad == 0 && $totmax) ;
-}
-
-my $tried_devel_corestack;
-sub corestatus {
- my($st) = @_;
- my($ret);
-
- # The require 'wait.ph' may generate warnings (depending on how
- # well p2ph dealt with the original wait.h file).
- # These warnings can confuse people doing a "make test" on an
- # extension they're trying to build. We should probably use
- # __WARN__ here to catch them and give a useful context message.
- eval {require 'wait.ph'};
- if ($@ || !defined(&WCOREDUMP)) {
- SWITCH: {
- $ret = ($st & 0200); # Tim says, this is for 90%
- }
- } else {
- $ret = WCOREDUMP($st);
- }
-
- eval { require Devel::CoreStack; $have_devel_corestack++ }
- unless $tried_devel_corestack++;
-
- $ret;
-}
-
-sub canonfailed ($@) {
- my($max,$skipped,@failed) = @_;
- my %seen;
- @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
- my $failed = @failed;
- my @result = ();
- my @canon = ();
- my $min;
- my $last = $min = shift @failed;
- my $canon;
- if (@failed) {
- for (@failed, $failed[-1]) { # don't forget the last one
- if ($_ > $last+1 || $_ == $last) {
- if ($min == $last) {
- push @canon, $last;
- } else {
- push @canon, "$min-$last";
- }
- $min = $_;
- }
- $last = $_;
- }
- local $" = ", ";
- push @result, "FAILED tests @canon\n";
- $canon = "@canon";
- } else {
- push @result, "FAILED test $last\n";
- $canon = $last;
- }
-
- push @result, "\tFailed $failed/$max tests, ";
- push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
- my $ender = 's' x ($skipped > 1);
- my $good = $max - $failed - $skipped;
- my $goodper = sprintf("%.2f",100*($good/$max));
- push @result, " (-$skipped skipped test$ender: $good okay, $goodper%)" if $skipped;
- push @result, "\n";
- my $txt = join "", @result;
- ($txt, $canon);
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Test::Harness - run perl standard test scripts with statistics
-
-=head1 SYNOPSIS
-
-use Test::Harness;
-
-runtests(@tests);
-
-=head1 DESCRIPTION
-
-(By using the L<Test> module, you can write test scripts without
-knowing the exact output this module expects. However, if you need to
-know the specifics, read on!)
-
-Perl test scripts print to standard output C<"ok N"> for each single
-test, where C<N> is an increasing sequence of integers. The first line
-output by a standard test script is C<"1..M"> with C<M> being the
-number of tests that should be run within the test
-script. Test::Harness::runtests(@tests) runs all the testscripts
-named as arguments and checks standard output for the expected
-C<"ok N"> strings.
-
-After all tests have been performed, runtests() prints some
-performance statistics that are computed by the Benchmark module.
-
-=head2 The test script output
-
-Any output from the testscript to standard error is ignored and
-bypassed, thus will be seen by the user. Lines written to standard
-output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
-runtests(). All other lines are discarded.
-
-It is tolerated if the test numbers after C<ok> are omitted. In this
-case Test::Harness maintains temporarily its own counter until the
-script supplies test numbers again. So the following test script
-
- print <<END;
- 1..6
- not ok
- ok
- not ok
- ok
- ok
- END
-
-will generate
-
- FAILED tests 1, 3, 6
- Failed 3/6 tests, 50.00% okay
-
-The global variable $Test::Harness::verbose is exportable and can be
-used to let runtests() display the standard output of the script
-without altering the behavior otherwise.
-
-The global variable $Test::Harness::switches is exportable and can be
-used to set perl command line options used for running the test
-script(s). The default value is C<-w>.
-
-If the standard output line contains substring C< # Skip> (with
-variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
-counted as a skipped test. If the whole testscript succeeds, the
-count of skipped tests is included in the generated output.
-
-=head1 EXPORT
-
-C<&runtests> is exported by Test::Harness per default.
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item C<All tests successful.\nFiles=%d, Tests=%d, %s>
-
-If all tests are successful some statistics about the performance are
-printed.
-
-=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
-
-For any single script that has failing subtests statistics like the
-above are printed.
-
-=item C<Test returned status %d (wstat %d)>
-
-Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8> and C<$?> are
-printed in a message similar to the above.
-
-=item C<Failed 1 test, %.2f%% okay. %s>
-
-=item C<Failed %d/%d tests, %.2f%% okay. %s>
-
-If not all tests were successful, the script dies with one of the
-above messages.
-
-=back
-
-=head1 ENVIRONMENT
-
-Setting C<HARNESS_IGNORE_EXITCODE> makes harness ignore the exit status
-of child processes.
-
-If C<HARNESS_FILELEAK_IN_DIR> is set to the name of a directory, harness
-will check after each test whether new files appeared in that directory,
-and report them as
-
- LEAKED FILES: scr.tmp 0 my.db
-
-If relative, directory name is with respect to the current directory at
-the moment runtests() was called. Putting absolute path into
-C<HARNESS_FILELEAK_IN_DIR> may give more predicatable results.
-
-=head1 SEE ALSO
-
-L<Test> for writing test scripts and also L<Benchmark> for the
-underlying timing routines.
-
-=head1 AUTHORS
-
-Either Tim Bunce or Andreas Koenig, we don't know. What we know for
-sure is, that it was inspired by Larry Wall's TEST script that came
-with perl distributions for ages. Numerous anonymous contributors
-exist. Current maintainer is Andreas Koenig.
-
-=head1 BUGS
-
-Test::Harness uses $^X to determine the perl binary to run the tests
-with. Test scripts running via the shebang (C<#!>) line may not be
-portable because $^X is not consistent for shebang scripts across
-platforms. This is no problem when Test::Harness is run with an
-absolute path to the perl binary or when $^X can be found in the path.
-
-=cut
@@ -1,235 +0,0 @@
-use strict;
-package Test;
-use Test::Harness 1.1601 ();
-use Carp;
-use vars (qw($VERSION @ISA @EXPORT $ntest $TestLevel), #public-ish
- qw($ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish
-$VERSION = '1.04';
-require Exporter;
-@ISA=('Exporter');
-@EXPORT= qw(&plan &ok &skip $ntest);
-
-$TestLevel = 0; # how many extra stack frames to skip
-$|=1;
-#$^W=1; ?
-$ntest=1;
-
-# Use of this variable is strongly discouraged. It is set mainly to
-# help test coverage analyzers know which test is running.
-$ENV{REGRESSION_TEST} = $0;
-
-sub plan {
- croak "Test::plan(%args): odd number of arguments" if @_ & 1;
- croak "Test::plan(): should not be called more than once" if $planned;
- my $max=0;
- for (my $x=0; $x < @_; $x+=2) {
- my ($k,$v) = @_[$x,$x+1];
- if ($k =~ /^test(s)?$/) { $max = $v; }
- elsif ($k eq 'todo' or
- $k eq 'failok') { for (@$v) { $todo{$_}=1; }; }
- elsif ($k eq 'onfail') {
- ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE";
- $ONFAIL = $v;
- }
- else { carp "Test::plan(): skipping unrecognized directive '$k'" }
- }
- my @todo = sort { $a <=> $b } keys %todo;
- if (@todo) {
- print "1..$max todo ".join(' ', @todo).";\n";
- } else {
- print "1..$max\n";
- }
- ++$planned;
-}
-
-sub to_value {
- my ($v) = @_;
- (ref $v or '') eq 'CODE' ? $v->() : $v;
-}
-
-# STDERR is NOT used for diagnostic output which should have been
-# fixed before release. Is this appropriate?
-
-sub ok ($;$$) {
- croak "ok: plan before you test!" if !$planned;
- my ($pkg,$file,$line) = caller($TestLevel);
- my $repetition = ++$history{"$file:$line"};
- my $context = ("$file at line $line".
- ($repetition > 1 ? " fail \#$repetition" : ''));
- my $ok=0;
- my $result = to_value(shift);
- my ($expected,$diag);
- if (@_ == 0) {
- $ok = $result;
- } else {
- $expected = to_value(shift);
- # until regex can be manipulated like objects...
- my ($regex,$ignore);
- if (($regex) = ($expected =~ m,^ / (.+) / $,sx) or
- ($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) {
- $ok = $result =~ /$regex/;
- } else {
- $ok = $result eq $expected;
- }
- }
- if ($todo{$ntest}) {
- if ($ok) {
- print "ok $ntest # Wow! ($context)\n";
- } else {
- $diag = to_value(shift) if @_;
- if (!$diag) {
- print "not ok $ntest # (failure expected in $context)\n";
- } else {
- print "not ok $ntest # (failure expected: $diag)\n";
- }
- }
- } else {
- print "not " if !$ok;
- print "ok $ntest\n";
-
- if (!$ok) {
- my $detail = { 'repetition' => $repetition, 'package' => $pkg,
- 'result' => $result };
- $$detail{expected} = $expected if defined $expected;
- $diag = $$detail{diagnostic} = to_value(shift) if @_;
- if (!defined $expected) {
- if (!$diag) {
- print STDERR "# Failed test $ntest in $context\n";
- } else {
- print STDERR "# Failed test $ntest in $context: $diag\n";
- }
- } else {
- my $prefix = "Test $ntest";
- print STDERR "# $prefix got: '$result' ($context)\n";
- $prefix = ' ' x (length($prefix) - 5);
- if (!$diag) {
- print STDERR "# $prefix Expected: '$expected'\n";
- } else {
- print STDERR "# $prefix Expected: '$expected' ($diag)\n";
- }
- }
- push @FAILDETAIL, $detail;
- }
- }
- ++ $ntest;
- $ok;
-}
-
-sub skip ($$;$$) {
- if (to_value(shift)) {
- print "ok $ntest # skip\n";
- ++ $ntest;
- 1;
- } else {
- local($TestLevel) = $TestLevel+1; #ignore this stack frame
- &ok;
- }
-}
-
-END {
- $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL;
-}
-
-1;
-__END__
-
-=head1 NAME
-
- Test - provides a simple framework for writing test scripts
-
-=head1 SYNOPSIS
-
- use strict;
- use Test;
- BEGIN { plan tests => 13, todo => [3,4] }
-
- ok(0); # failure
- ok(1); # success
-
- ok(0); # ok, expected failure (see todo list, above)
- ok(1); # surprise success!
-
- ok(0,1); # failure: '0' ne '1'
- ok('broke','fixed'); # failure: 'broke' ne 'fixed'
- ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
-
- ok(sub { 1+1 }, 2); # success: '2' eq '2'
- ok(sub { 1+1 }, 3); # failure: '2' ne '3'
- ok(0, int(rand(2)); # (just kidding! :-)
-
- my @list = (0,0);
- ok @list, 3, "\@list=".join(',',@list); #extra diagnostics
- ok 'segmentation fault', '/(?i)success/'; #regex match
-
- skip($feature_is_missing, ...); #do platform specific test
-
-=head1 DESCRIPTION
-
-Test::Harness expects to see particular output when it executes tests.
-This module aims to make writing proper test scripts just a little bit
-easier (and less error prone :-).
-
-=head1 TEST TYPES
-
-=over 4
-
-=item * NORMAL TESTS
-
-These tests are expected to succeed. If they don't, something's
-screwed up!
-
-=item * SKIPPED TESTS
-
-Skip tests need a platform specific feature that might or might not be
-available. The first argument should evaluate to true if the required
-feature is NOT available. After the first argument, skip tests work
-exactly the same way as do normal tests.
-
-=item * TODO TESTS
-
-TODO tests are designed for maintaining an executable TODO list.
-These tests are expected NOT to succeed (otherwise the feature they
-test would be on the new feature list, not the TODO list).
-
-Packages should NOT be released with successful TODO tests. As soon
-as a TODO test starts working, it should be promoted to a normal test
-and the newly minted feature should be documented in the release
-notes.
-
-=back
-
-=head1 ONFAIL
-
- BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } }
-
-The test failures can trigger extra diagnostics at the end of the test
-run. C<onfail> is passed an array ref of hash refs that describe each
-test failure. Each hash will contain at least the following fields:
-package, repetition, and result. (The file, line, and test number are
-not included because their correspondance to a particular test is
-fairly weak.) If the test had an expected value or a diagnostic
-string, these will also be included.
-
-This optional feature might be used simply to print out the version of
-your package and/or how to report problems. It might also be used to
-generate extremely sophisticated diagnostics for a particular test
-failure. It's not a panacea, however. Core dumps or other
-unrecoverable errors will prevent the C<onfail> hook from running.
-(It is run inside an END block.) Besides, C<onfail> is probably
-over-kill in the majority of cases. (Your test code should be simpler
-than the code it is testing, yes?)
-
-=head1 SEE ALSO
-
-L<Test::Harness> and various test coverage analysis tools.
-
-=head1 AUTHOR
-
-Copyright (C) 1998 Joshua Nathaniel Pritikin. All rights reserved.
-
-This package is free software and is provided "as is" without express
-or implied warranty. It may be used, redistributed and/or modified
-under the terms of the Perl Artistic License (see
-http://www.perl.com/perl/misc/Artistic.html)
-
-=cut