Added __can_read_sock(): attempts to read from Redis server, non-blocking

Signed-off-by: Pedro Melo <melo@simplicidade.org>

diff --git a/Makefile.PL b/Makefile.PL
index 231c034..94fb37f 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,7 +9,7 @@ WriteMakefile(
     ABSTRACT_FROM       => 'lib/Redis.pm',
     PL_FILES            => {},
     PREREQ_PM => {
-        'Test::More' => 0,
+        'Test::More' => 0.92,
         'Test::Exception' => 0,
                'IO::Socket::INET' => 0,
                'Data::Dumper' => 0,

diff --git a/lib/Redis.pm b/lib/Redis.pm
index 346b995..4306153 100644 (file)
--- a/lib/Redis.pm
+++ b/lib/Redis.pm
@@ -4,6 +4,7 @@ use warnings;
 use strict;
 
 use IO::Socket::INET;
+use Fcntl qw( O_NONBLOCK F_SETFL );
 use Data::Dumper;
 use Carp qw/confess/;
 use Encode;
@@ -229,6 +230,27 @@ sub __read_sock {
   return $data;
 }
 
+sub __can_read_sock {
+  my ($self) = @_;
+  my $sock   = $self->{sock};
+  my $rbuf   = \($self->{rbuf});
+
+  return 1 if $$rbuf;
+  __fh_nonblocking($sock, 1);
+  my $bytes = sysread $sock, $$rbuf, 8192, length $$rbuf;
+  __fh_nonblocking($sock, 0);
+  return 1 if $bytes;
+  return 0;
+}
+
+
+### Copied from AnyEvent::Util
+BEGIN {
+  *__fh_nonblocking = ($^O eq 'MSWin32')
+    ? sub($$) { ioctl $_[0], 0x8004667e, pack "L", $_[1]; }    # FIONBIO
+    : sub($$) { fcntl $_[0], F_SETFL, $_[1] ? O_NONBLOCK : 0; };
+}
+
 
 1;
 

diff --git a/t/30-nonblock.t b/t/30-nonblock.t
new file mode 100644 (file)
index 0000000..5788fa2
--- /dev/null
+++ b/t/30-nonblock.t
@@ -0,0 +1,17 @@
+#!perl
+
+use strict;
+use warnings;
+use Test::More;
+use Redis;
+
+my $r = Redis->new;
+
+## Try to read from server (nothing sent, so nothing to read)
+## But kill if we block
+local $SIG{ALRM} = sub { kill 9, $$ };
+alarm(2);
+ok(!$r->__can_read_sock, "Nothing to read, didn't block");
+alarm(0);
+
+done_testing();