Re: Making IO::Socket pass test on Win32

Message-ID: <9b18b3110604020107o6a0b594cwfc2344a172c360b0@mail.gmail.com>

plus extra $Config{d_fork} changes to io_pipe.t and io_multihomed.t

p4raw-id: //depot/perl@27710

1 files changed, 35 insertions, 4 deletions

diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index 1d7437b03c..fe887d491b 100644
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -23,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
 
 @ISA = qw(IO::Handle);
 
-$VERSION = "1.30";
+$VERSION = "1.30_01";
 
 @EXPORT_OK = qw(sockatmark);
 
@@ -112,7 +112,7 @@ sub connect {
 
     $blocking = $sock->blocking(0) if $timeout;
     if (!connect($sock, $addr)) {
-	if (defined $timeout && $!{EINPROGRESS}) {
+	if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
 	    require IO::Select;
 
 	    my $sel = new IO::Select $sock;
@@ -121,14 +121,17 @@ sub connect {
 		$err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
 		$@ = "connect: timeout";
 	    }
-	    elsif (!connect($sock,$addr) && not $!{EISCONN}) {
+	    elsif (!connect($sock,$addr) &&
+                not ($!{EISCONN} || ($! == 10022 && $^O eq 'MSWin32'))
+            ) {
 		# Some systems refuse to re-connect() to
 		# an already open socket and set errno to EISCONN.
+		# Windows sets errno to WSAEINVAL (10022)
 		$err = $!;
 		$@ = "connect: $!";
 	    }
 	}
-        elsif ($blocking || !$!{EINPROGRESS})  {
+        elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK}))  {
 	    $err = $!;
 	    $@ = "connect: $!";
 	}
@@ -141,6 +144,34 @@ sub connect {
     $err ? undef : $sock;
 }
 
+
+sub blocking {
+    my $sock = shift;
+
+    return $sock->SUPER::blocking(@_)
+        if $^O ne 'MSWin32';
+
+    # Windows handles blocking differently
+    #
+    # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/
+    #   thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f
+    # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/
+    #   winsock/winsock/ioctlsocket_2.asp
+    #
+    # 0x8004667e is FIONBIO
+    # By default all sockets are blocking
+
+    return !${*$sock}{io_sock_nonblocking}
+        unless @_;
+
+    my $block = shift;
+
+    ${*$sock}{io_sock_nonblocking} = $block ? "0" : "1";
+
+    return ioctl($sock, 0x8004667e, \${*$sock}{io_sock_nonblocking});
+}
+
+
 sub close {
     @_ == 1 or croak 'usage: $sock->close()';
     my $sock = shift;