=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.
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
@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;
##
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(@_)
=head1 NAME
-IO::Handle - supply object methods for filehandles
+IO::Handle - supply object methods for I/O handles
=head1 SYNOPSIS
=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
read
truncate
stat
+ print
+ printf
+ sysread
+ syswrite
See L<perlvar> for complete descriptions of each of the following
supported C<IO::Handle> methods:
=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">
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
=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;
##
@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
##
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.
## Normal I/O functions.
##
-# fcntl
# flock
-# ioctl
# select
-# sysread
-# syswrite
sub opened {
@_ == 1 or croak 'usage: $fh->opened()';
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>;
}
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]);
}
}
+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;
=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
=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
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;
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;
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;
=head1 SYNOPSIS
- use IO::Seekable;
- package IO::Something;
- @ISA = qw(IO::Seekable);
+ use IO::Seekable;
+ package IO::Something;
+ @ISA = qw(IO::Seekable);
=head1 DESCRIPTION
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
@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()';
=head1 NAME
-IO::Select - OO interface to the system select call
+IO::Select - OO interface to the select system call
=head1 SYNOPSIS
=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
=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
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
{
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)
: ();
}
{
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)
: ();
}
{
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)
: ();
}
}
1;
-
=head1 NAME
-IO::Socket - supply object methods for sockets
+IO::Socket - Object interface to socket communications
=head1 SYNOPSIS
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:
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
=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
# 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;
: $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;
}
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);
}
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
$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
@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,
);
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
);
}
+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);
$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);
}
}
@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
=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
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;
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
projects / p5sagit/p5-mst-13.2.git / commitdiff