SYN SYN
[p5sagit/p5-mst-13.2.git] / ext / IO / lib / IO / Socket.pm
index be81d9a..b8da092 100644 (file)
@@ -1,82 +1,29 @@
+# IO::Socket.pm
 #
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
 
 package IO::Socket;
 
-=head1 NAME
-
-IO::Socket - supply object methods for sockets
-
-=head1 SYNOPSIS
-
-    use IO::Socket;
-
-=head1 DESCRIPTION
-
-C<IO::Socket> provides an object interface to creating and using sockets. It
-is built upon the L<IO::Handle> interface and inherits all the methods defined
-by L<IO::Handle>.
-
-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>
-
-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:
-
-    socket
-    socketpair
-    bind
-    listen
-    accept
-    send
-    recv
-    peername (getpeername)
-    sockname (getsockname)
-
-Some methods take slightly different arguments to those defined in L<perlfunc>
-in attempt to make the interface more flexible. These are
-
-=item accept([PKG])
-
-perform the system call C<accept> on the socket and return a new object. The
-new object will be created in the same class as the listen socket, unless
-C<PKG> is specified. This object can be used to communicate with the client
-that was trying to connect. In a scalar context the new socket is returned,
-or undef upon failure. In an array context a two-element array is returned
-containing the new socket and the peer address, the list will
-be empty upon failure.
-
-Additional methods that are provided are
-
-=item timeout([VAL])
-
-Set or get the timeout value associated with this socket. If called without
-any arguments then the current setting is returned. If called with an argument
-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
+require 5.005_64;
 
-=cut
-
-
-require 5.000;
-
-use Config;
 use IO::Handle;
 use Socket 1.3;
 use Carp;
 use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION);
+our(@ISA, $VERSION);
 use Exporter;
+use Errno;
+
+# legacy
+
+require IO::Socket::INET;
+require IO::Socket::UNIX if ($^O ne 'epoc');
 
 @ISA = qw(IO::Handle);
 
-# This one will turn 1.2 => 1.02 and 1.2.3 => 1.0203 and so on ...
-$VERSION = do{my @r=(q$Revision: 1.8$=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
+$VERSION = "1.26";
 
 sub import {
     my $pkg = shift;
@@ -86,150 +33,195 @@ sub import {
 
 sub new {
     my($class,%arg) = @_;
-    my $fh = $class->SUPER::new();
+    my $sock = $class->SUPER::new();
 
-    ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
+    $sock->autoflush(1);
 
-    return scalar(%arg) ? $fh->configure(\%arg)
-                       : $fh;
+    ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
+
+    return scalar(%arg) ? $sock->configure(\%arg)
+                       : $sock;
+}
+
+my @domain2pkg;
+
+sub register_domain {
+    my($p,$d) = @_;
+    $domain2pkg[$d] = $p;
 }
 
 sub configure {
-    croak 'IO::Socket: Cannot configure a generic socket';
+    my($sock,$arg) = @_;
+    my $domain = delete $arg->{Domain};
+
+    croak 'IO::Socket: Cannot configure a generic socket'
+       unless defined $domain;
+
+    croak "IO::Socket: Unsupported socket domain"
+       unless defined $domain2pkg[$domain];
+
+    croak "IO::Socket: Cannot configure socket in domain '$domain'"
+       unless ref($sock) eq "IO::Socket";
+
+    bless($sock, $domain2pkg[$domain]);
+    $sock->configure($arg);
 }
 
 sub socket {
-    @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
-    my($fh,$domain,$type,$protocol) = @_;
+    @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
+    my($sock,$domain,$type,$protocol) = @_;
 
-    socket($fh,$domain,$type,$protocol) or
+    socket($sock,$domain,$type,$protocol) or
        return undef;
 
-    ${*$fh}{'io_socket_type'} = $type;
-    $fh;
+    ${*$sock}{'io_socket_domain'} = $domain;
+    ${*$sock}{'io_socket_type'}   = $type;
+    ${*$sock}{'io_socket_proto'}  = $protocol;
+
+    $sock;
 }
 
 sub socketpair {
-    @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
+    @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
     my($class,$domain,$type,$protocol) = @_;
-    my $fh1 = $class->new();
-    my $fh2 = $class->new();
+    my $sock1 = $class->new();
+    my $sock2 = $class->new();
 
-    socketpair($fh1,$fh1,$domain,$type,$protocol) or
+    socketpair($sock1,$sock2,$domain,$type,$protocol) or
        return ();
 
-    ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type;
+    ${*$sock1}{'io_socket_type'}  = ${*$sock2}{'io_socket_type'}  = $type;
+    ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
 
-    ($fh1,$fh2);
+    ($sock1,$sock2);
 }
 
 sub connect {
-    @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)';
-    my $fh = shift;
-    my $addr = @_ == 1 ? shift : sockaddr_in(@_);
-    my $timeout = ${*$fh}{'io_socket_timeout'};
-    local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
-                                : $SIG{ALRM} || 'DEFAULT';
-
-    eval {
-       croak 'connect: Bad address'
-           if(@_ == 2 && !defined $_[1]);
-
-       if($timeout) {
-           defined $Config{d_alarm} && defined alarm($timeout) or
-               $timeout = 0;
-       }
-
-       my $ok = eval { connect($fh, $addr) };
-
-       alarm(0)
-           if($timeout);
+    @_ == 2 or croak 'usage: $sock->connect(NAME)';
+    my $sock = shift;
+    my $addr = shift;
+    my $timeout = ${*$sock}{'io_socket_timeout'};
+    my $err;
+    my $blocking;
+    $blocking = $sock->blocking(0) if $timeout;
+
+    if (!connect($sock, $addr)) {
+       if ($timeout && $!{EINPROGRESS}) {
+           require IO::Select;
+
+           my $sel = new IO::Select $sock;
+
+           if (!$sel->can_write($timeout)) {
+               $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+               $@ = "connect: timeout";
+           }
+           elsif(!connect($sock,$addr) && not $!{EISCONN}) {
+               # Some systems refuse to re-connect() to
+               # an already open socket and set errno to EISCONN.
+               $err = $!;
+               $@ = "connect: $!";
+           }
+       }
+       else {
+           $err = $!;
+           $@ = "connect: $!";
+       }
+    }
 
-       croak "connect: timeout"
-           unless defined $fh;
+    $sock->blocking(1) if $blocking;
 
-       undef $fh unless $ok;
+    $! = $err if $err;
 
-    };
-    $fh;
+    $err ? undef : $sock;
 }
 
 sub bind {
-    @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)';
-    my $fh = shift;
-    my $addr = @_ == 1 ? shift : sockaddr_in(@_);
+    @_ == 2 or croak 'usage: $sock->bind(NAME)';
+    my $sock = shift;
+    my $addr = shift;
 
-    return bind($fh, $addr) ? $fh
-                           : undef;
+    return bind($sock, $addr) ? $sock
+                             : undef;
 }
 
 sub listen {
-    @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])';
-    my($fh,$queue) = @_;
+    @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
+    my($sock,$queue) = @_;
     $queue = 5
        unless $queue && $queue > 0;
 
-    return listen($fh, $queue) ? $fh
-                              : undef;
+    return listen($sock, $queue) ? $sock
+                                : undef;
 }
 
 sub accept {
-    @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])';
-    my $fh = shift;
-    my $pkg = shift || $fh;
-    my $timeout = ${*$fh}{'io_socket_timeout'};
+    @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
+    my $sock = shift;
+    my $pkg = shift || $sock;
+    my $timeout = ${*$sock}{'io_socket_timeout'};
     my $new = $pkg->new(Timeout => $timeout);
     my $peer = undef;
 
-    eval {
-       if($timeout) {
-           my $fdset = "";
-           vec($fdset, $fh->fileno,1) = 1;
-           croak "accept: timeout"
-               unless select($fdset,undef,undef,$timeout);
-       }
-       $peer = accept($new,$fh);
-    };
-
-    return wantarray ? defined $peer ? ($new, $peer)
-                                    : () 
-                    : defined $peer ? $new
-                                    : undef;
+    if($timeout) {
+       require IO::Select;
+
+       my $sel = new IO::Select $sock;
+
+       unless ($sel->can_read($timeout)) {
+           $@ = 'accept: timeout';
+           $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+           return;
+       }
+    }
+
+    $peer = accept($new,$sock)
+       or return;
+
+    return wantarray ? ($new, $peer)
+                    : $new;
 }
 
 sub sockname {
-    @_ == 1 or croak 'usage: $fh->sockname()';
+    @_ == 1 or croak 'usage: $sock->sockname()';
     getsockname($_[0]);
 }
 
 sub peername {
-    @_ == 1 or croak 'usage: $fh->peername()';
-    my($fh) = @_;
-    getpeername($fh)
-      || ${*$fh}{'io_socket_peername'}
+    @_ == 1 or croak 'usage: $sock->peername()';
+    my($sock) = @_;
+    getpeername($sock)
+      || ${*$sock}{'io_socket_peername'}
       || undef;
 }
 
+sub connected {
+    @_ == 1 or croak 'usage: $sock->connected()';
+    my($sock) = @_;
+    getpeername($sock);
+}
+
 sub send {
-    @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])';
-    my $fh    = $_[0];
+    @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
+    my $sock  = $_[0];
     my $flags = $_[2] || 0;
-    my $peer  = $_[3] || $fh->peername;
+    my $peer  = $_[3] || $sock->peername;
 
     croak 'send: Cannot determine peer address'
         unless($peer);
 
-    my $r = send($fh, $_[1], $flags, $peer);
+    my $r = defined(getpeername($sock))
+       ? send($sock, $_[1], $flags)
+       : send($sock, $_[1], $flags, $peer);
 
     # remember who we send to, if it was sucessful
-    ${*$fh}{'io_socket_peername'} = $peer
+    ${*$sock}{'io_socket_peername'} = $peer
        if(@_ == 4 && defined $r);
 
     $r;
 }
 
 sub recv {
-    @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])';
+    @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
     my $sock  = $_[0];
     my $len   = $_[2];
     my $flags = $_[3] || 0;
@@ -238,16 +230,21 @@ sub recv {
     ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
 }
 
+sub shutdown {
+    @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
+    my($sock, $how) = @_;
+    shutdown($sock, $how);
+}
 
 sub setsockopt {
-    @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)';
+    @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
     setsockopt($_[0],$_[1],$_[2],$_[3]);
 }
 
 my $intsize = length(pack("i",0));
 
 sub getsockopt {
-    @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)';
+    @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
     my $r = getsockopt($_[0],$_[1],$_[2]);
     # Just a guess
     $r = unpack("i", $r)
@@ -256,308 +253,176 @@ sub getsockopt {
 }
 
 sub sockopt {
-    my $fh = shift;
-    @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_)
-           : $fh->setsockopt(SOL_SOCKET,@_);
+    my $sock = shift;
+    @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
+           : $sock->setsockopt(SOL_SOCKET,@_);
 }
 
 sub timeout {
-    @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])';
-    my($fh,$val) = @_;
-    my $r = ${*$fh}{'io_socket_timeout'} || undef;
+    @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
+    my($sock,$val) = @_;
+    my $r = ${*$sock}{'io_socket_timeout'} || undef;
 
-    ${*$fh}{'io_socket_timeout'} = 0 + $val
+    ${*$sock}{'io_socket_timeout'} = 0 + $val
        if(@_ == 2);
 
     $r;
 }
 
-sub socktype {
-    @_ == 1 or croak '$fh->socktype()';
-    ${*{$_[0]}}{'io_socket_type'} || undef;
+sub sockdomain {
+    @_ == 1 or croak 'usage: $sock->sockdomain()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_domain'};
 }
 
-=head1 SUB-CLASSES
-
-=cut
-
-##
-## AF_INET
-##
-
-package IO::Socket::INET;
-
-use strict;
-use vars qw(@ISA $VERSION);
-use Socket;
-use Carp;
-use Exporter;
-
-@ISA = qw(IO::Socket);
-
-my %socket_type = ( tcp => SOCK_STREAM,
-                   udp => SOCK_DGRAM,
-                 );
-
-=head2 IO::Socket::INET
-
-C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
-and some related methods. The constructor can take the following options
-
-    PeerAddr   Remote host address
-    PeerPort   Remote port or service
-    LocalPort  Local host bind port
-    LocalAddr  Local host bind address
-    Proto      Protocol name (eg tcp udp etc)
-    Type       Socket type (SOCK_STREAM etc)
-    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
-
-Only one of C<Type> or C<Proto> needs to be specified, one will be assumed
-from the other.
-
-=head2 METHODS
-
-=item sockaddr()
-
-Return the address part of the sockaddr structure for the socket
-
-=item sockport()
-
-Return the port number that the socket is using on the local host
-
-=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()
-
-Same as for the sock* functions, but returns the data about the peer
-host instead of the local host.
-
-=cut
-
-
-sub _sock_info {
-  my($addr,$port,$proto) = @_;
-  my @proto = ();
-  my @serv = ();
-
-  $port = $1
-       if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
-
-  if(defined $proto) {
-    @proto = $proto =~ m,\D, ? getprotobyname($proto)
-                            : getprotobynumber($proto);
+sub socktype {
+    @_ == 1 or croak 'usage: $sock->socktype()';
+    my $sock = shift;
+    ${*$sock}{'io_socket_type'}
+}
 
-    $proto = $proto[2] || undef;
-  }
+sub protocol {
+    @_ == 1 or croak 'usage: $sock->protocol()';
+    my($sock) = @_;
+    ${*$sock}{'io_socket_proto'};
+}
 
-  if(defined $port) {
-    $port =~ s,\((\d+)\)$,,;
+1;
 
-    my $defport = $1 || undef;
-    my $pnum = ($port =~ m,^(\d+)$,)[0];
+__END__
 
-    @serv= getservbyname($port, $proto[0] || "")
-       if($port =~ m,\D,);
+=head1 NAME
 
-    $port = $pnum || $serv[2] || $defport || undef;
+IO::Socket - Object interface to socket communications
 
-    $proto = (getprotobyname($serv[3]))[2] || undef
-       if @serv && !$proto;
-  }
+=head1 SYNOPSIS
 
- return ($addr || undef,
-        $port || undef,
-        $proto || undef
-       );
-}
+    use IO::Socket;
 
-sub configure {
-    my($fh,$arg) = @_;
-    my($lport,$rport,$laddr,$raddr,$proto,$type);
+=head1 DESCRIPTION
 
+C<IO::Socket> provides an object interface to creating and using sockets. It
+is built upon the L<IO::Handle> interface and inherits all the methods defined
+by L<IO::Handle>.
 
-    ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
-                                       $arg->{LocalPort},
-                                       $arg->{Proto});
+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>
 
-    $laddr = defined $laddr ? inet_aton($laddr)
-                           : INADDR_ANY;
+C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
 
-    unless(exists $arg->{Listen}) {
-       ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
-                                           $arg->{PeerPort},
-                                           $proto);
-    }
+=head1 CONSTRUCTOR
 
-    croak 'IO::Socket: Cannot determine protocol'
-       unless($proto);
+=over 4
 
-    my $pname = (getprotobynumber($proto))[0];
-    $type = $arg->{Type} || $socket_type{$pname};
+=item new ( [ARGS] )
 
-    $fh->socket(AF_INET, $type, $proto) or
-       return undef;
+Creates an C<IO::Socket>, 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 will be in. All other arguments will be passed to the
+configuration method of the package for that domain, See below.
 
-    $fh->bind($lport || 0, $laddr) or
-       return undef;
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
 
-    if(exists $arg->{Listen}) {
-       $fh->listen($arg->{Listen} || 5) or
-           return undef;
-    }
-    else {
-       croak "IO::Socket: Cannot determine remote port"
-               unless($rport || $type == SOCK_DGRAM);
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
 
-       if($type == SOCK_STREAM || defined $raddr) {
-           croak "IO::Socket: Bad peer address"
-               unless defined $raddr;
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
 
-           $fh->connect($rport,inet_aton($raddr)) or
-               return undef;
-       }
-    }
+=back
 
-    $fh;
-}
+=head1 METHODS
 
-sub sockaddr {
-    @_ == 1 or croak 'usage: $fh->sockaddr()';
-    my($fh) = @_;
-    (sockaddr_in($fh->sockname))[1];
-}
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Socket> methods, which are just front ends for the
+corresponding built-in functions:
 
-sub sockport {
-    @_ == 1 or croak 'usage: $fh->sockport()';
-    my($fh) = @_;
-    (sockaddr_in($fh->sockname))[0];
-}
+    socket
+    socketpair
+    bind
+    listen
+    accept
+    send
+    recv
+    peername (getpeername)
+    sockname (getsockname)
+    shutdown
 
-sub sockhost {
-    @_ == 1 or croak 'usage: $fh->sockhost()';
-    my($fh) = @_;
-    inet_ntoa($fh->sockaddr);
-}
+Some methods take slightly different arguments to those defined in L<perlfunc>
+in attempt to make the interface more flexible. These are
 
-sub peeraddr {
-    @_ == 1 or croak 'usage: $fh->peeraddr()';
-    my($fh) = @_;
-    (sockaddr_in($fh->peername))[1];
-}
+=over 4
 
-sub peerport {
-    @_ == 1 or croak 'usage: $fh->peerport()';
-    my($fh) = @_;
-    (sockaddr_in($fh->peername))[0];
-}
+=item accept([PKG])
 
-sub peerhost {
-    @_ == 1 or croak 'usage: $fh->peerhost()';
-    my($fh) = @_;
-    inet_ntoa($fh->peeraddr);
-}
+perform the system call C<accept> on the socket and return a new object. The
+new object will be created in the same class as the listen socket, unless
+C<PKG> is specified. This object can be used to communicate with the client
+that was trying to connect. In a scalar context the new socket is returned,
+or undef upon failure. In a list context a two-element array is returned
+containing the new socket and the peer address; the list will
+be empty upon failure.
 
-##
-## AF_UNIX
-##
+=item socketpair(DOMAIN, TYPE, PROTOCOL)
 
-package IO::Socket::UNIX;
+Call C<socketpair> and return a list of two sockets created, or an
+empty list on failure.
 
-use strict;
-use vars qw(@ISA $VERSION);
-use Socket;
-use Carp;
-use Exporter;
+=back
 
-@ISA = qw(IO::Socket);
+Additional methods that are provided are:
 
-=head2 IO::Socket::UNIX
+=over 4
 
-C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
-and some related methods. The constructor can take the following options
+=item timeout([VAL])
 
-    Type       Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
-    Local      Path to local fifo
-    Peer       Path to peer fifo
-    Listen     Create a listen socket
+Set or get the timeout value associated with this socket. If called without
+any arguments then the current setting is returned. If called with an argument
+the current setting is changed and the previous value returned.
 
-=head2 METHODS
+=item sockopt(OPT [, VAL])
 
-=item hostpath()
+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.
 
-Returns the pathname to the fifo at the local end
+=item sockdomain
 
-=item peerpath()
+Returns the numerical number for the socket domain type. For example, for
+a AF_INET socket the value of &AF_INET will be returned.
 
-Returns the pathanme to the fifo at the peer end
+=item socktype
 
-=cut
+Returns the numerical number for the socket type. For example, for
+a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
 
-sub configure {
-    my($fh,$arg) = @_;
-    my($bport,$cport);
+=item protocol
 
-    my $type = $arg->{Type} || SOCK_STREAM;
+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.
 
-    $fh->socket(AF_UNIX, $type, 0) or
-       return undef;
+=item connected
 
-    if(exists $arg->{Local}) {
-       my $addr = sockaddr_un($arg->{Local});
-       $fh->bind($addr) or
-           return undef;
-    }
-    if(exists $arg->{Listen}) {
-       $fh->listen($arg->{Listen} || 5) or
-           return undef;
-    }
-    elsif(exists $arg->{Peer}) {
-       my $addr = sockaddr_un($arg->{Peer});
-       $fh->connect($addr) or
-           return undef;
-    }
+If the socket is in a connected state the the peer address is returned.
+If the socket is not in a connected state then undef will be returned.
 
-    $fh;
-}
+=back
 
-sub hostpath {
-    @_ == 1 or croak 'usage: $fh->hostpath()';
-    (sockaddr_un($_[0]->hostname))[0];
-}
+=head1 SEE ALSO
 
-sub peerpath {
-    @_ == 1 or croak 'usage: $fh->peerpath()';
-    (sockaddr_un($_[0]->peername))[0];
-}
+L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
 
 =head1 AUTHOR
 
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 1.8 $
+Graham Barr. Currently maintained by the Perl Porters.  Please report all
+bugs to <perl5-porters@perl.org>.
 
-The VERSION is derived from the revision turning each number after the
-first dot into a 2 digit number so
-
-       Revision 1.8   => VERSION 1.08
-       Revision 1.2.3 => VERSION 1.0203
 =head1 COPYRIGHT
 
-Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
+Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
 
 =cut
-
-1; # Keep require happy