SYN SYN

[p5sagit/p5-mst-13.2.git] / ext / IO / lib / IO / Socket.pm

diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index 46205a6..b8da092 100644 (file)
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -6,23 +6,24 @@
 
 package IO::Socket;
 
-require 5.000;
+require 5.005_64;
 
 use IO::Handle;
 use Socket 1.3;
 use Carp;
 use strict;
-use vars qw(@ISA $VERSION);
+our(@ISA, $VERSION);
 use Exporter;
+use Errno;
 
 # legacy
 
 require IO::Socket::INET;
-require IO::Socket::UNIX;
+require IO::Socket::UNIX if ($^O ne 'epoc');
 
 @ISA = qw(IO::Handle);
 
-$VERSION = "1.252";
+$VERSION = "1.26";
 
 sub import {
     my $pkg = shift;
@@ -100,35 +101,38 @@ sub connect {
     my $sock = shift;
     my $addr = shift;
     my $timeout = ${*$sock}{'io_socket_timeout'};
-
+    my $err;
     my $blocking;
     $blocking = $sock->blocking(0) if $timeout;
 
-    eval {
-       croak 'connect: Bad address'
-           if(@_ == 2 && !defined $_[1]);
-
-       unless(connect($sock, $addr)) {
-           if($timeout && ($! == &IO::EINPROGRESS)) {
-               require IO::Select;
+    if (!connect($sock, $addr)) {
+       if ($timeout && $!{EINPROGRESS}) {
+           require IO::Select;
 
-               my $sel = new IO::Select $sock;
+           my $sel = new IO::Select $sock;
 
-               unless($sel->can_write($timeout) && defined($sock->peername)) {
-                   croak "connect: timeout";
-               }
+           if (!$sel->can_write($timeout)) {
+               $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+               $@ = "connect: timeout";
            }
-           else {
-               croak "connect: $!";
+           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: $!";
+       }
+    }
 
-    my $ret = $@ ? undef : $sock;
+    $sock->blocking(1) if $blocking;
 
-    $sock->blocking($blocking) if $timeout;
+    $! = $err if $err;
 
-    $ret;
+    $err ? undef : $sock;
 }
 
 sub bind {
@@ -158,22 +162,23 @@ sub accept {
     my $new = $pkg->new(Timeout => $timeout);
     my $peer = undef;
 
-    eval {
-       if($timeout) {
-           require IO::Select;
+    if($timeout) {
+       require IO::Select;
 
-           my $sel = new IO::Select $sock;
+       my $sel = new IO::Select $sock;
 
-           croak "accept: timeout"
-               unless $sel->can_read($timeout);
-       }
-       $peer = accept($new,$sock) || undef;
-    };
+       unless ($sel->can_read($timeout)) {
+           $@ = 'accept: timeout';
+           $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+           return;
+       }
+    }
 
-    return wantarray ? defined $peer ? ($new, $peer)
-                                    : () 
-                    : defined $peer ? $new
-                                    : undef;
+    $peer = accept($new,$sock)
+       or return;
+
+    return wantarray ? ($new, $peer)
+                    : $new;
 }
 
 sub sockname {
@@ -279,7 +284,7 @@ sub socktype {
 sub protocol {
     @_ == 1 or croak 'usage: $sock->protocol()';
     my($sock) = @_;
-    ${*$sock}{'io_socket_protocol'};
+    ${*$sock}{'io_socket_proto'};
 }
 
 1;
@@ -320,7 +325,7 @@ the socket will be in. All other arguments will be passed to the
 configuration method of the package for that domain, See below.
 
  NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
- 
+
 As of VERSION 1.18 all IO::Socket objects have autoflush turned on
 by default. This was not the case with earlier releases.
 
@@ -356,7 +361,7 @@ 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
+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.