From: Yves Orton <demerphq@gmail.com>
Date: Mon, 18 Jun 2007 18:43:17 +0000 (+0200)
Subject: Re: Net::SMTP can't send large messages with bleadperl
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=757754a6231584cc746ffd4510e6d8b8f2691824;p=p5sagit%2Fp5-mst-13.2.git

Re: Net::SMTP can't send large messages with bleadperl
Message-ID: <9b18b3110706180943y22c0eaa7yf34565d87689dd9e@mail.gmail.com>
Date: Mon, 18 Jun 2007 18:43:17 +0200

p4raw-id: //depot/perl@31423
---

diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index 9095093..f1fcdde 100644
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -145,6 +145,11 @@ sub connect {
     $err ? undef : $sock;
 }
 
+# Enable/disable blocking IO on sockets.
+# Without args return the current status of blocking,
+# with args change the mode as appropriate, returning the
+# old setting, or in case of error during the mode change
+# undef.
 
 sub blocking {
     my $sock = shift;
@@ -154,22 +159,32 @@ sub blocking {
 
     # 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
+    # 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 @_;
+    #
+    # which is used to set blocking behaviour.
 
-    my $block = shift;
+    # NOTE: 
+    # This is a little confusing, the perl keyword for this is
+    # 'blocking' but the OS level behaviour is 'non-blocking', probably
+    # because sockets are blocking by default.
+    # Therefore internally we have to reverse the semantics.
 
-    ${*$sock}{io_sock_nonblocking} = $block ? "0" : "1";
+    my $orig= !${*$sock}{io_sock_nonblocking};
+        
+    return $orig unless @_;
 
-    return ioctl($sock, 0x8004667e, \${*$sock}{io_sock_nonblocking});
+    my $block = shift;
+    
+    if ( !$block != !$orig ) {
+        ${*$sock}{io_sock_nonblocking} = $block ? 0 : 1;
+        ioctl($sock, 0x8004667e, pack("L!",${*$sock}{io_sock_nonblocking}))
+            or return undef;
+    }
+    
+    return $orig;        
 }