ActivePerl 5.16 で Cache::Memcahed を使う

cpanm を使って ActivePerl 5.16 環境にインストールした Cache::Memcached 1.30 が動かなかったので、参考サイトに倣ってパッチを当てたときの作業メモ。

動作環境

Windows 7 Home Premium SP1 (64bit)
ActivePerl 5.16.1 (MSWin32-x64-multi-hread)
Cache::Memcached 1.30

修正パッチ

\Perl\site\lib\Cache\Memcached.pm に以下のパッチを当てることで動作可能になりました。
修正後、Cache::Memcached に付属していたテストコードがすべてパスしたのを確認しました。

--- Memcached_orig.pm	Sun May 20 08:28:36 2012
+++ Memcached.pm	Tue Feb 25 01:02:10 2014
@@ -61,6 +61,8 @@
 
 my $PROTO_TCP;
 
+my $WINDOWS = ($^O =~ /MSWin32/);
+
 our $SOCK_TIMEOUT = 2.6; # default timeout in seconds
 
 sub new {
@@ -203,6 +205,18 @@
     return 1;
 }
 
+# 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
+# and IO::Socket
+
+sub _blocking {
+    my ($sock, $block) = @_;
+	return IO::Handle::blocking($sock, $block) unless $WINDOWS;
+
+    #0x8004667e is FIONBIO
+    return ioctl($sock, 0x8004667e, pack("L!", $block ? 0 : 1));
+}
+
 sub _connect_sock { # sock, sin, timeout
     my ($sock, $sin, $timeout) = @_;
     $timeout = 0.25 if not defined $timeout;
@@ -213,14 +227,15 @@
     # non-blocking at the end of this function
 
     if ($timeout) {
-        IO::Handle::blocking($sock, 0);
+        _blocking($sock, 0);
     } else {
-        IO::Handle::blocking($sock, 1);
+        _blocking($sock, 1);
     }
 
     my $ret = connect($sock, $sin);
 
-    if (!$ret && $timeout && $!==EINPROGRESS) {
+    if (!$ret && $timeout &&
+        ($!==EINPROGRESS || ($WINDOWS && $!==EWOULDBLOCK))) {
 
         my $win='';
         vec($win, fileno($sock), 1) = 1;
@@ -228,12 +243,13 @@
         if (select(undef, $win, undef, $timeout) > 0) {
             $ret = connect($sock, $sin);
             # EISCONN means connected & won't re-connect, so success
-            $ret = 1 if !$ret && $!==EISCONN;
+            # Windows sets errno to WSAEINVAL (10022)
+            $ret = 1 if !$ret && ($!==EISCONN || ($WINDOWS && $!==10022));
         }
     }
 
     unless ($timeout) { # socket was temporarily blocking, now revert
-        IO::Handle::blocking($sock, 0);
+        _blocking($sock, 0);
     }
 
     # from here on, we use non-blocking (async) IO for the duration