diff options
author | Joseph S. Myers <jsm28@hermes.cam.ac.uk> | 1996-09-20 15:08:33 +0100 |
---|---|---|
committer | Andy Dougherty <doughera@lafcol.lafayette.edu> | 1996-09-20 15:08:33 +0100 |
commit | 27d4819aa2398f978c433f7367bcf083183444c9 (patch) | |
tree | 7177d47c29e07696ea2ce3a9ff48c2ed5b499fb1 | |
parent | 2a0cf7534305b208c8a33f74a84757c0894c6439 (diff) | |
download | perl-27d4819aa2398f978c433f7367bcf083183444c9.tar.gz |
Pod typos, pod2man bugs, and miscellaneous installation comments
Here is a patch for various typos and other defects in the Perl
5.003_05 pods, including the pods embedded in library modules.
Updated to IO-1.12.
-rw-r--r-- | ext/IO/lib/IO/File.pm | 48 | ||||
-rw-r--r-- | ext/IO/lib/IO/Handle.pm | 152 | ||||
-rw-r--r-- | ext/IO/lib/IO/Pipe.pm | 39 | ||||
-rw-r--r-- | ext/IO/lib/IO/Seekable.pm | 16 | ||||
-rw-r--r-- | ext/IO/lib/IO/Select.pm | 26 | ||||
-rw-r--r-- | ext/IO/lib/IO/Socket.pm | 224 |
6 files changed, 364 insertions, 141 deletions
diff --git a/ext/IO/lib/IO/File.pm b/ext/IO/lib/IO/File.pm index 49439a5646..ef9d510f91 100644 --- a/ext/IO/lib/IO/File.pm +++ b/ext/IO/lib/IO/File.pm @@ -43,19 +43,34 @@ IO::File - supply object methods for filehandles =head1 DESCRIPTION -C<IO::File::new> creates a C<IO::File>, which is a reference to a -newly created symbol (see the C<Symbol> package). If it receives any -parameters, they are passed to C<IO::File::open>; if the open fails, -the C<IO::File> object is destroyed. Otherwise, it is returned to -the caller. +C<IO::File> is inherits from C<IO::Handle> ans C<IO::Seekable>. It extends +these classes with methods that are specific to file handles. -C<IO::File::open> accepts one parameter or two. With one parameter, +=head1 CONSTRUCTOR + +=over 4 + +=item new ([ ARGS ] ) + +Creates a C<IO::File>. If it receives any parameters, they are passed to +the method C<open>; if the open fails, the object is destroyed. Otherwise, +it is returned to the caller. + +=back + +=head1 METHODS + +=over 4 + +=item open( FILENAME [,MODE [,PERMS]] ) + +C<open> accepts one, two or three parameters. With one parameter, it is just a front end for the built-in C<open> function. With two parameters, the first parameter is a filename that may include whitespace or other special characters, and the second parameter is the open mode, optionally followed by a file permission value. -If C<IO::File::open> receives a Perl mode string (">", "+<", etc.) +If C<IO::File::open> receives a Perl mode string ("E<gt>", "+E<lt>", etc.) or a POSIX fopen() mode string ("w", "r+", etc.), it uses the basic Perl C<open> operator. @@ -65,20 +80,22 @@ For convenience, C<IO::File::import> tries to import the O_XXX constants from the Fcntl module. If dynamic loading is not available, this may fail, but the rest of IO::File will still work. +=back + =head1 SEE ALSO L<perlfunc>, L<perlop/"I/O Operators">, -L<"IO::Handle"> -L<"IO::Seekable"> +L<IO::Handle> +L<IO::Seekable> =head1 HISTORY -Derived from FileHandle.pm by Graham Barr <bodg@tiuk.ti.com> +Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>. =head1 REVISION -$Revision: 1.3 $ +$Revision: 1.5 $ =cut @@ -96,7 +113,7 @@ require DynaLoader; @ISA = qw(IO::Handle IO::Seekable Exporter DynaLoader); -$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); +$VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/); @EXPORT = @IO::Seekable::EXPORT; @@ -121,9 +138,10 @@ sub import { ## sub new { - @_ >= 1 && @_ <= 4 - or croak 'usage: new IO::File [FILENAME [,MODE [,PERMS]]]'; - my $class = shift; + my $type = shift; + my $class = ref($type) || $type || "IO::File"; + @_ >= 0 && @_ <= 3 + or croak "usage: new $class [FILENAME [,MODE [,PERMS]]]"; my $fh = $class->SUPER::new(); if (@_) { $fh->open(@_) diff --git a/ext/IO/lib/IO/Handle.pm b/ext/IO/lib/IO/Handle.pm index f2086049cf..54b32f4a64 100644 --- a/ext/IO/lib/IO/Handle.pm +++ b/ext/IO/lib/IO/Handle.pm @@ -4,7 +4,7 @@ package IO::Handle; =head1 NAME -IO::Handle - supply object methods for filehandles +IO::Handle - supply object methods for I/O handles =head1 SYNOPSIS @@ -43,39 +43,27 @@ IO::Handle - supply object methods for filehandles =head1 DESCRIPTION -C<IO::Handle::new> creates a C<IO::Handle>, which is a reference to a -newly created symbol (see the C<Symbol> package). If it receives any -parameters, they are passed to C<IO::Handle::open>; if the open fails, -the C<IO::Handle> object is destroyed. Otherwise, it is returned to -the caller. - -C<IO::Handle::new_from_fd> creates a C<IO::Handle> like C<new> does. -It requires two parameters, which are passed to C<IO::Handle::fdopen>; -if the fdopen fails, the C<IO::Handle> object is destroyed. -Otherwise, it is returned to the caller. - -C<IO::Handle::open> accepts one parameter or two. With one parameter, -it is just a front end for the built-in C<open> function. With two -parameters, the first parameter is a filename that may include -whitespace or other special characters, and the second parameter is -the open mode in either Perl form (">", "+<", etc.) or POSIX form -("w", "r+", etc.). - -C<IO::Handle::fdopen> is like C<open> except that its first parameter -is not a filename but rather a file handle name, a IO::Handle object, -or a file descriptor number. +C<IO::Handle> is the base class for all other IO handle classes. +A C<IO::Handle> object is a reference to a symbol (see the C<Symbol> package) -C<IO::Handle::write> is like C<write> found in C, that is it is the -opposite of read. The wrapper for the perl C<write> function is -called C<format_write>. +=head1 CONSTRUCTOR + +=over 4 + +=item new () -C<IO::Handle::opened> returns true if the object is currently a valid -file descriptor. +Creates a new C<IO::Handle> object. -If the C functions fgetpos() and fsetpos() are available, then -C<IO::Handle::getpos> returns an opaque value that represents the -current position of the IO::Handle, and C<IO::Handle::setpos> uses -that value to return to a previously visited position. +=item new_from_fd ( FD, MODE ) + +Creates a C<IO::Handle> like C<new> does. +It requires two parameters, which are passed to the method C<fdopen>; +if the fdopen fails, the object is destroyed. Otherwise, it is returned +to the caller. + +=back + +=head1 METHODS If the C function setvbuf() is available, then C<IO::Handle::setvbuf> sets the buffering policy for the IO::Handle. The calling sequence @@ -99,6 +87,10 @@ corresponding built-in functions: read truncate stat + print + printf + sysread + syswrite See L<perlvar> for complete descriptions of each of the following supported C<IO::Handle> methods: @@ -121,14 +113,6 @@ Furthermore, for doing normal I/O you might need these: =over -=item $fh->print - -See L<perlfunc/print>. - -=item $fh->printf - -See L<perlfunc/printf>. - =item $fh->getline This works like <$fh> described in L<perlop/"I/O Operators"> @@ -141,11 +125,27 @@ This works like <$fh> when called in an array context to read all the remaining lines in a file, except that it's more readable. It will also croak() if accidentally called in a scalar context. +=item $fh->fdopen ( FD, MODE ) + +C<fdopen> is like an ordinary C<open> except that its first parameter +is not a filename but rather a file handle name, a IO::Handle object, +or a file descriptor number. + +=item $fh->write ( BUF, LEN [, OFFSET }\] ) + +C<write> is like C<write> found in C, that is it is the +opposite of read. The wrapper for the perl C<write> function is +called C<format_write>. + +=item $fh->opened + +Returns true if the object is currently a valid file descriptor. + =back -=head1 +=head1 NOTE -The reference returned from new is a GLOB reference. Some modules that +A C<IO::Handle> object is a GLOB reference. Some modules that inherit from C<IO::Handle> may want to keep object related variables in the hash table part of the GLOB. In an attempt to prevent modules trampling on each other I propose the that any such module should prefix @@ -167,12 +167,12 @@ class from C<IO::Handle> and inherit those methods. =head1 HISTORY -Derived from FileHandle.pm by Graham Barr <bodg@tiuk.ti.com> +Derived from FileHandle.pm by Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt> =cut require 5.000; -use vars qw($VERSION @EXPORT_OK $AUTOLOAD); +use vars qw($RCS $VERSION @EXPORT_OK $AUTOLOAD); use Carp; use Symbol; use SelectSaver; @@ -185,8 +185,8 @@ require Exporter; ## @FileHandle::ISA = qw(IO::Handle); - -$VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/); +$VERSION = "1.12"; +$RCS = sprintf("%s", q$Revision: 1.15 $ =~ /([\d\.]+)/); @EXPORT_OK = qw( autoflush @@ -246,28 +246,39 @@ sub AUTOLOAD { ## sub new { - @_ == 1 or croak 'usage: new IO::Handle'; - my $class = ref($_[0]) || $_[0]; + my $class = ref($_[0]) || $_[0] || "IO::Handle"; + @_ == 1 or croak "usage: new $class"; my $fh = gensym; bless $fh, $class; } sub new_from_fd { - @_ == 3 or croak 'usage: new_from_fd IO::Handle FD, MODE'; - my $class = shift; + my $class = ref($_[0]) || $_[0] || "IO::Handle"; + @_ == 3 or croak "usage: new_from_fd $class FD, MODE"; my $fh = gensym; IO::Handle::fdopen($fh, @_) or return undef; bless $fh, $class; } -# FileHandle::DESTROY use to call close(). This creates a problem -# if 2 Handle objects have the same fd. sv_clear will call io close -# when the refcount in the xpvio becomes zero. -# -# It is defined as empty to stop AUTOLOAD being called :-) +sub DESTROY { + my ($fh) = @_; + + # During global object destruction, this function may be called + # on FILEHANDLEs as well as on the GLOBs that contains them. + # Thus the following trickery. If only the CORE file operators + # could deal with FILEHANDLEs, it wouldn't be necessary... -sub DESTROY { } + if ($fh =~ /=FILEHANDLE\(/) { + local *TMP = $fh; + close(TMP) + if defined fileno(TMP); + } + else { + close($fh) + if defined fileno($fh); + } +} ################################################ ## Open and close. @@ -319,12 +330,8 @@ sub close { ## Normal I/O functions. ## -# fcntl # flock -# ioctl # select -# sysread -# syswrite sub opened { @_ == 1 or croak 'usage: $fh->opened()'; @@ -372,9 +379,9 @@ sub getline { sub getlines { @_ == 1 or croak 'usage: $fh->getline()'; - my $this = shift; wantarray or - croak "Can't call IO::Handle::getlines in a scalar context, use IO::Handle::getline"; + croak 'Can\'t call $fh->getlines in a scalar context, use $fh->getline'; + my $this = shift; return <$this>; } @@ -388,12 +395,22 @@ sub read { read($_[0], $_[1], $_[2], $_[3] || 0); } +sub sysread { + @_ == 3 || @_ == 4 or croak '$fh->sysread(BUF, LEN [, OFFSET])'; + sysread($_[0], $_[1], $_[2], $_[3] || 0); +} + sub write { @_ == 3 || @_ == 4 or croak '$fh->write(BUF, LEN [, OFFSET])'; local($\) = ""; print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); } +sub syswrite { + @_ == 3 || @_ == 4 or croak '$fh->syswrite(BUF, LEN [, OFFSET])'; + sysread($_[0], $_[1], $_[2], $_[3] || 0); +} + sub stat { @_ == 1 or croak 'usage: $fh->stat()'; stat($_[0]); @@ -508,5 +525,18 @@ sub format_write { } } +sub fcntl { + @_ == 3 || croak 'usage: $fh->fcntl( OP, VALUE );'; + my ($fh, $op, $val) = @_; + my $r = fcntl($fh, $op, $val); + defined $r && $r eq "0 but true" ? 0 : $r; +} + +sub ioctl { + @_ == 3 || croak 'usage: $fh->ioctl( OP, VALUE );'; + my ($fh, $op, $val) = @_; + my $r = ioctl($fh, $op, $val); + defined $r && $r eq "0 but true" ? 0 : $r; +} 1; diff --git a/ext/IO/lib/IO/Pipe.pm b/ext/IO/lib/IO/Pipe.pm index 33d7219aef..27fe7f1aa2 100644 --- a/ext/IO/lib/IO/Pipe.pm +++ b/ext/IO/lib/IO/Pipe.pm @@ -38,31 +38,44 @@ IO::pipe - supply object methods for pipes =head1 DESCRIPTION -C<IO::Pipe::new> creates a C<IO::Pipe>, which is a reference to a +C<IO::Pipe> provides an interface to createing pipes between +processes. + +=head1 CONSTRCUTOR + +=over 4 + +=item new ( [READER, WRITER] ) + +Creates a C<IO::Pipe>, which is a reference to a newly created symbol (see the C<Symbol> package). C<IO::Pipe::new> optionally takes two arguments, which should be objects blessed into C<IO::Handle>, or a subclass thereof. These two objects will be used for the system call to C<pipe>. If no arguments are given then then method C<handles> is called on the new C<IO::Pipe> object. -These two handles are held in the array part of the GLOB untill either +These two handles are held in the array part of the GLOB until either C<reader> or C<writer> is called. -=over +=back + +=head1 METHODS + +=over 4 -=item $fh->reader([ARGS]) +=item reader ([ARGS]) The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a handle at the reading end of the pipe. If C<ARGS> are given then C<fork> is called and C<ARGS> are passed to exec. -=item $fh->writer([ARGS]) +=item writer ([ARGS]) The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a handle at the writing end of the pipe. If C<ARGS> are given then C<fork> is called and C<ARGS> are passed to exec. -=item $fh->handles +=item handles () This method is called during construction by C<IO::Pipe::new> on the newly created C<IO::Pipe> object. It returns an array of two objects @@ -76,11 +89,11 @@ L<IO::Handle> =head1 AUTHOR -Graham Barr <bodg@tiuk.ti.com> +Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt> =head1 REVISION -$Revision: 1.4 $ +$Revision: 1.7 $ =head1 COPYRIGHT @@ -96,12 +109,14 @@ use Carp; use Symbol; require IO::Handle; -$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/); +$VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/); sub new { - @_ == 1 || @_ == 3 or croak 'usage: new IO::Pipe([$READFH, $WRITEFH])'; + my $type = shift; + my $class = ref($type) || $type || "IO::Pipe"; + @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]"; - my $me = bless gensym(), shift; + my $me = bless gensym(), $class; my($readfh,$writefh) = @_ ? @_ : $me->handles; @@ -152,6 +167,7 @@ sub reader { bless $me, ref($fh); *{*$me} = *{*$fh}; # Alias self to handle + bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; @@ -167,6 +183,7 @@ sub writer { bless $me, ref($fh); *{*$me} = *{*$fh}; # Alias self to handle + bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; diff --git a/ext/IO/lib/IO/Seekable.pm b/ext/IO/lib/IO/Seekable.pm index 045e4d5d19..8e0f87ac18 100644 --- a/ext/IO/lib/IO/Seekable.pm +++ b/ext/IO/lib/IO/Seekable.pm @@ -8,9 +8,9 @@ IO::Seekable - supply seek based methods for I/O objects =head1 SYNOPSIS - use IO::Seekable; - package IO::Something; - @ISA = qw(IO::Seekable); + use IO::Seekable; + package IO::Something; + @ISA = qw(IO::Seekable); =head1 DESCRIPTION @@ -35,16 +35,16 @@ corresponding built-in functions: L<perlfunc>, L<perlop/"I/O Operators">, -L<"IO::Handle"> -L<"IO::File"> +L<IO::Handle> +L<IO::File> =head1 HISTORY -Derived from FileHandle.pm by Graham Barr <bodg@tiuk.ti.com> +Derived from FileHandle.pm by Graham Barr E<lt>bodg@tiuk.ti.comE<gt> =head1 REVISION -$Revision: 1.4 $ +$Revision: 1.5 $ =cut @@ -57,7 +57,7 @@ require Exporter; @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END); @ISA = qw(Exporter); -$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/); +$VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/); sub clearerr { @_ == 1 or croak 'usage: $fh->clearerr()'; diff --git a/ext/IO/lib/IO/Select.pm b/ext/IO/lib/IO/Select.pm index 113b2b4e5c..845d6b25a4 100644 --- a/ext/IO/lib/IO/Select.pm +++ b/ext/IO/lib/IO/Select.pm @@ -4,7 +4,7 @@ package IO::Select; =head1 NAME -IO::Select - OO interface to the system select call +IO::Select - OO interface to the select system call =head1 SYNOPSIS @@ -31,7 +31,7 @@ are ready for reading, writing or have an error condition pending. =item new ( [ HANDLES ] ) -The constructor create a new object and optionally initialises it with a set +The constructor creates a new object and optionally initialises it with a set of handles. =back @@ -118,11 +118,11 @@ listening for more connections on a listen socket =head1 AUTHOR -Graham Barr <Graham.Barr@tiuk.ti.com> +Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt> =head1 REVISION -$Revision: 1.2 $ +$Revision: 1.9 $ =head1 COPYRIGHT @@ -136,7 +136,7 @@ use strict; use vars qw($VERSION @ISA); require Exporter; -$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/); +$VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/); @ISA = qw(Exporter); # This is only so we can do version checking @@ -198,10 +198,9 @@ sub can_read { my $vec = shift; my $timeout = shift; + my $r = $vec->[VEC_BITS]; - my $r = $vec->[VEC_BITS] or return (); - - select($r,undef,undef,$timeout) > 0 + defined($r) && (select($r,undef,undef,$timeout) > 0) ? _handles($vec, $r) : (); } @@ -210,10 +209,9 @@ sub can_write { my $vec = shift; my $timeout = shift; + my $w = $vec->[VEC_BITS]; - my $w = $vec->[VEC_BITS] or return (); - - select(undef,$w,undef,$timeout) > 0 + defined($w) && (select(undef,$w,undef,$timeout) > 0) ? _handles($vec, $w) : (); } @@ -222,10 +220,9 @@ sub has_error { my $vec = shift; my $timeout = shift; + my $e = $vec->[VEC_BITS]; - my $e = $vec->[VEC_BITS] or return (); - - select(undef,undef,$e,$timeout) > 0 + defined($e) && (select(undef,undef,$e,$timeout) > 0) ? _handles($vec, $e) : (); } @@ -303,4 +300,3 @@ sub _handles } 1; - diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm index 5f2a8ef76a..94ae88a536 100644 --- a/ext/IO/lib/IO/Socket.pm +++ b/ext/IO/lib/IO/Socket.pm @@ -4,7 +4,7 @@ package IO::Socket; =head1 NAME -IO::Socket - supply object methods for sockets +IO::Socket - Object interface to socket communications =head1 SYNOPSIS @@ -20,6 +20,23 @@ C<IO::Socket> only defines methods for those operations which are common to all types of socket. Operations which are specified to a socket in a particular domain have methods defined in sub classes of C<IO::Socket> +=head1 CONSTRUCTOR + +=over 4 + +=item new ( [ARGS] ) + +Creates a C<IO::Pipe>, which is a reference to a +newly created symbol (see the C<Symbol> package). C<new> +optionally takes arguments, these arguments are in key-value pairs. +C<new> only looks for one key C<Domain> which tells new which domain +the socket it will be. All other arguments will be passed to the +configuration method of the package for that domain, See below. + +=back + +=head1 METHODS + See L<perlfunc> for complete descriptions of each of the following supported C<IO::Seekable> methods, which are just front ends for the corresponding built-in functions: @@ -37,6 +54,8 @@ corresponding built-in functions: Some methods take slightly different arguments to those defined in L<perlfunc> in attempt to make the interface more flexible. These are +=over 4 + =item accept([PKG]) perform the system call C<accept> on the socket and return a new object. The @@ -58,7 +77,25 @@ the current setting is changed and the previous value returned. =item sockopt(OPT [, VAL]) Unified method to both set and get options in the SOL_SOCKET level. If called -with one argument then getsockopt is called, otherwise setsockopt is called +with one argument then getsockopt is called, otherwise setsockopt is called. + +=item sockdomain + +Returns the numerical number for the socket domain type. For example, fir +a AF_INET socket the value of &AF_INET will be returned. + +=item socktype + +Returns the numerical number for the socket type. For example, fir +a SOCK_STREAM socket the value of &SOCK_STREAM will be returned. + +=item protocol + +Returns the numerical number for the protocol being used on the socket, if +known. If the protocol is unknown, as with an AF_UNIX socket, zero +is returned. + +=back =cut @@ -77,7 +114,7 @@ use Exporter; # This one will turn 1.2 => 1.02 and 1.2.3 => 1.0203 and so on ... -$VERSION = do{my @r=(q$Revision: 1.9 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r}; +$VERSION = do{my @r=(q$Revision: 1.13 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r}; sub import { my $pkg = shift; @@ -95,18 +132,53 @@ sub new { : $fh; } +my @domain2pkg = (); + +sub register_domain { + my($p,$d) = @_; + $domain2pkg[$d] = bless \$d, $p; +} + +sub _domain2pkg { + my $domain = shift; + + croak "Unsupported socket domain" + unless defined $domain2pkg[$domain]; + + $domain2pkg[$domain] +} + sub configure { - croak 'IO::Socket: Cannot configure a generic socket'; + my($fh,$arg) = @_; + my $domain = delete $arg->{Domain}; + + croak 'IO::Socket: Cannot configure a generic socket' + unless defined $domain; + + my $sub = ref(_domain2pkg($domain)) . "::configure"; + + goto &{$sub} + if(defined &{$sub}); + + croak "IO::Socket: Cannot configure socket in domain '$domain' $sub"; } sub socket { @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)'; my($fh,$domain,$type,$protocol) = @_; + if(!defined ${*$fh}{'io_socket_domain'} + || !ref(${*$fh}{'io_socket_domain'}) + || ${${*$fh}{'io_socket_domain'}} != $domain) { + my $pkg = + ${*$fh}{'io_socket_domain'} = _domain2pkg($domain); + } + socket($fh,$domain,$type,$protocol) or return undef; - ${*$fh}{'io_socket_type'} = $type; + ${*$fh}{'io_socket_type'} = $type; + ${*$fh}{'io_socket_proto'} = $protocol; $fh; } @@ -119,7 +191,8 @@ sub socketpair { socketpair($fh1,$fh1,$domain,$type,$protocol) or return (); - ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type; + ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type; + ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol; ($fh1,$fh2); } @@ -220,7 +293,9 @@ sub send { croak 'send: Cannot determine peer address' unless($peer); - my $r = send($fh, $_[1], $flags, $peer); + my $r = defined(getpeername($fh)) + ? send($fh, $_[1], $flags) + : send($fh, $_[1], $flags, $peer); # remember who we send to, if it was sucessful ${*$fh}{'io_socket_peername'} = $peer @@ -273,11 +348,45 @@ sub timeout { $r; } +sub sockdomain { + @_ == 1 or croak 'usage: $fh->sockdomain()'; + my $fh = shift; + ${${*$fh}{'io_socket_domain'}} +} + sub socktype { - @_ == 1 or croak '$fh->socktype()'; - ${*{$_[0]}}{'io_socket_type'} || undef; + @_ == 1 or croak 'usage: $fh->socktype()'; + my $fh = shift; + ${*$fh}{'io_socket_type'} } +sub protocol { + @_ == 1 or croak 'usage: $fh->protocol()'; + my($fh) = @_; + ${*$fh}{'io_socket_protocol'}; +} + +sub _addmethod { + my $self = shift; + my $name; + + foreach $name (@_) { + my $n = $name; + + no strict qw(refs); + + *{$n} = sub { + my $pkg = ref(${*{$_[0]}}{'io_socket_domain'}); + my $sub = "${pkg}::${n}"; + goto &{$sub} if defined &{$sub}; + croak qq{Can't locate object method "$n" via package "$pkg"}; + } + unless defined &{$n}; + } + +} + + =head1 SUB-CLASSES =cut @@ -296,6 +405,9 @@ use Exporter; @ISA = qw(IO::Socket); +IO::Socket::INET->_addmethod( qw(sockaddr sockport sockhost peeraddr peerport peerhost)); +IO::Socket::INET->register_domain( AF_INET ); + my %socket_type = ( tcp => SOCK_STREAM, udp => SOCK_DGRAM, ); @@ -314,32 +426,46 @@ and some related methods. The constructor can take the following options Listen Queue size for listen Timeout Timeout value for various operations + If Listen is defined then a listen socket is created, else if the socket type, which is derived from the protocol, is SOCK_STREAM then a connect -is called +is called. Only one of C<Type> or C<Proto> needs to be specified, one will be assumed from the other. =head2 METHODS -=item sockaddr() +=over 4 + +=item sockaddr () Return the address part of the sockaddr structure for the socket -=item sockport() +=item sockport () Return the port number that the socket is using on the local host -=item sockhost() +=item sockhost () Return the address part of the sockaddr structure for the socket in a text form xx.xx.xx.xx -=item peeraddr(), peerport(), peerhost() +=item peeraddr () + +Return the address part of the sockaddr structure for the socket on +the peer host + +=item peerport () + +Return the port number for the socket on the peer host. -Same as for the sock* functions, but returns the data about the peer -host instead of the local host. +=item peerhost () + +Return the address part of the sockaddr structure for the socket on the +peer host in a text form xx.xx.xx.xx + +=back =cut @@ -380,6 +506,14 @@ sub _sock_info { ); } +sub _error { + my $fh = shift; + carp join("",ref($fh),": ",@_) if @_; + close($fh) + if(defined fileno($fh)); + return undef; +} + sub configure { my($fh,$arg) = @_; my($lport,$rport,$laddr,$raddr,$proto,$type); @@ -392,38 +526,50 @@ sub configure { $laddr = defined $laddr ? inet_aton($laddr) : INADDR_ANY; + return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'") + unless(defined $laddr); + unless(exists $arg->{Listen}) { ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr}, $arg->{PeerPort}, $proto); } - croak 'IO::Socket: Cannot determine protocol' + if(defined $raddr) { + $raddr = inet_aton($raddr); + return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'") + unless(defined $raddr); + } + + return _error($fh,'Cannot determine protocol') unless($proto); my $pname = (getprotobynumber($proto))[0]; $type = $arg->{Type} || $socket_type{$pname}; + my $domain = AF_INET; + ${*$fh}{'io_socket_domain'} = bless \$domain; + $fh->socket(AF_INET, $type, $proto) or - return undef; + return _error($fh); $fh->bind($lport || 0, $laddr) or - return undef; + return _error($fh); if(exists $arg->{Listen}) { $fh->listen($arg->{Listen} || 5) or - return undef; + return _error($fh); } else { - croak "IO::Socket: Cannot determine remote port" + return _error($fh,'Cannot determine remote port') unless($rport || $type == SOCK_DGRAM); if($type == SOCK_STREAM || defined $raddr) { - croak "IO::Socket: Bad peer address" - unless defined $raddr; + return _error($fh,'Bad peer address') + unless(defined $raddr); - $fh->connect($rport,inet_aton($raddr)) or - return undef; + $fh->connect($rport,$raddr) or + return _error($fh); } } @@ -480,6 +626,9 @@ use Exporter; @ISA = qw(IO::Socket); +IO::Socket::UNIX->_addmethod(qw(hostpath peerpath)); +IO::Socket::UNIX->register_domain( AF_UNIX ); + =head2 IO::Socket::UNIX C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket @@ -492,13 +641,17 @@ and some related methods. The constructor can take the following options =head2 METHODS +=over 4 + =item hostpath() -Returns the pathname to the fifo at the local end +Returns the pathname to the fifo at the local end. =item peerpath() -Returns the pathanme to the fifo at the peer end +Returns the pathanme to the fifo at the peer end. + +=back =cut @@ -508,6 +661,9 @@ sub configure { my $type = $arg->{Type} || SOCK_STREAM; + my $domain = AF_UNIX; + ${*$fh}{'io_socket_domain'} = bless \$domain; + $fh->socket(AF_UNIX, $type, 0) or return undef; @@ -531,21 +687,27 @@ sub configure { sub hostpath { @_ == 1 or croak 'usage: $fh->hostpath()'; - (sockaddr_un($_[0]->hostname))[0]; + my $n = $_[0]->sockname || return undef; +warn length($n); + (sockaddr_un($n))[0]; } sub peerpath { @_ == 1 or croak 'usage: $fh->peerpath()'; - (sockaddr_un($_[0]->peername))[0]; + my $n = $_[0]->peername || return undef; +warn length($n); +my @n = sockaddr_un($n); +warn join(",",@n); + (sockaddr_un($n))[0]; } =head1 AUTHOR -Graham Barr <Graham.Barr@tiuk.ti.com> +Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt> =head1 REVISION -$Revision: 1.9 $ +$Revision: 1.13 $ The VERSION is derived from the revision turning each number after the first dot into a 2 digit number so |