Hello community, here is the log from the commit of package perl-Redis for openSUSE:Factory checked in at 2014-07-26 09:42:06 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Redis (Old) and /work/SRC/openSUSE:Factory/.perl-Redis.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Redis" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Redis/perl-Redis.changes 2014-03-21 12:15:14.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.perl-Redis.new/perl-Redis.changes 2014-07-26 09:42:17.000000000 +0200 @@ -1,0 +2,21 @@ +Fri Jul 25 09:32:01 UTC 2014 - [email protected] + +- updated to 1.974 + * release again, last one was screwed up. + * fix #85 (PR #86) reconnect during transaction + + 1.973_03 2014-05-12 22:49:07 Europe/Amsterdam + + * fix #85 (PR #86) reconnect during transaction + + 1.973_02 2014-04-30 12:04:29 Europe/Amsterdam + + * merge PR #84 optimize try read sock + + 1.973_01 2014-04-26 18:00:31 Europe/Amsterdam + + * use new network code from Ivan Kruglov + * fix sentinel tests + * fix #81: doc for 'every' option + +------------------------------------------------------------------- Old: ---- Redis-1.972.tar.gz New: ---- Redis-1.974.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Redis.spec ++++++ --- /var/tmp/diff_new_pack.B0EPet/_old 2014-07-26 09:42:18.000000000 +0200 +++ /var/tmp/diff_new_pack.B0EPet/_new 2014-07-26 09:42:18.000000000 +0200 @@ -17,7 +17,7 @@ Name: perl-Redis -Version: 1.972 +Version: 1.974 Release: 0 %define cpan_name Redis Summary: Perl binding for Redis database @@ -41,7 +41,7 @@ BuildRequires: perl(Test::Fatal) BuildRequires: perl(Test::More) >= 0.98 BuildRequires: perl(Test::SharedFork) -BuildRequires: perl(Test::TCP) +BuildRequires: perl(Test::TCP) >= 1.19 BuildRequires: perl(Try::Tiny) Requires: perl(IO::Socket::Timeout) >= 0.22 Requires: perl(Try::Tiny) ++++++ Redis-1.972.tar.gz -> Redis-1.974.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/Changes new/Redis-1.974/Changes --- old/Redis-1.972/Changes 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/Changes 2014-05-16 21:42:52.000000000 +0200 @@ -1,5 +1,26 @@ Revision history for Redis +1.974 2014-05-16 21:42:48 Europe/Amsterdam + +1.973_04 2014-05-12 22:53:06 Europe/Amsterdam + + * release again, last one was screwed up. + * fix #85 (PR #86) reconnect during transaction + +1.973_03 2014-05-12 22:49:07 Europe/Amsterdam + + * fix #85 (PR #86) reconnect during transaction + +1.973_02 2014-04-30 12:04:29 Europe/Amsterdam + + * merge PR #84 optimize try read sock + +1.973_01 2014-04-26 18:00:31 Europe/Amsterdam + + * use new network code from Ivan Kruglov + * fix sentinel tests + * fix #81: doc for 'every' option + 1.972 2014-02-18 00:54:01 Europe/Amsterdam * Sentinel features (connections, timeouts, etc) support * various bugfixes and testfixes diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/MANIFEST new/Redis-1.974/MANIFEST --- old/Redis-1.972/MANIFEST 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/MANIFEST 2014-05-16 21:42:52.000000000 +0200 @@ -2,6 +2,7 @@ Changes LICENSE MANIFEST +META.json META.yml Makefile.PL README diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/META.json new/Redis-1.974/META.json --- old/Redis-1.972/META.json 1970-01-01 01:00:00.000000000 +0100 +++ new/Redis-1.974/META.json 2014-05-16 21:42:52.000000000 +0200 @@ -0,0 +1,70 @@ +{ + "abstract" : "Perl binding for Redis database", + "author" : [ + "Pedro Melo <[email protected]>", + "Damien Krotkine <[email protected]>" + ], + "dynamic_config" : 0, + "generated_by" : "Dist::Zilla version 5.005, CPAN::Meta::Converter version 2.132830", + "license" : [ + "artistic_2" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";, + "version" : "2" + }, + "name" : "Redis", + "prereqs" : { + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "6.63_03", + "Module::Build::Tiny" : "0.030" + } + }, + "develop" : { + "requires" : { + "Pod::Coverage::TrustPod" : "0", + "Test::CPAN::Meta" : "0", + "Test::Pod::Coverage" : "1.08" + } + }, + "runtime" : { + "requires" : { + "IO::Socket::Timeout" : "0.22", + "Try::Tiny" : "0", + "perl" : "5.008" + } + }, + "test" : { + "requires" : { + "Digest::SHA" : "0", + "File::Spec" : "0", + "IO::Handle" : "0", + "IO::String" : "0", + "IPC::Cmd" : "0", + "IPC::Open3" : "0", + "Pod::Coverage::TrustPod" : "0", + "Test::CPAN::Meta" : "0", + "Test::Deep" : "0", + "Test::Fatal" : "0", + "Test::More" : "0.98", + "Test::SharedFork" : "0", + "Test::TCP" : "1.19" + } + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "https://github.com/PerlRedis/perl-redis/issues"; + }, + "homepage" : "https://github.com/PerlRedis/perl-redis";, + "repository" : { + "type" : "git", + "url" : "https://github.com/PerlRedis/perl-redis.git";, + "web" : "https://github.com/PerlRedis/perl-redis"; + } + }, + "version" : "1.974" +} + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/META.yml new/Redis-1.974/META.yml --- old/Redis-1.972/META.yml 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/META.yml 2014-05-16 21:42:52.000000000 +0200 @@ -16,7 +16,7 @@ Test::Fatal: 0 Test::More: 0.98 Test::SharedFork: 0 - Test::TCP: 0 + Test::TCP: 1.19 configure_requires: ExtUtils::MakeMaker: 6.63_03 Module::Build::Tiny: 0.030 @@ -35,4 +35,4 @@ bugtracker: https://github.com/PerlRedis/perl-redis/issues homepage: https://github.com/PerlRedis/perl-redis repository: https://github.com/PerlRedis/perl-redis.git -version: 1.972 +version: 1.974 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/Makefile.PL new/Redis-1.974/Makefile.PL --- old/Redis-1.972/Makefile.PL 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/Makefile.PL 2014-05-16 21:42:52.000000000 +0200 @@ -96,9 +96,9 @@ "Test::Fatal" => 0, "Test::More" => "0.98", "Test::SharedFork" => 0, - "Test::TCP" => 0 + "Test::TCP" => "1.19" }, - "VERSION" => "1.972", + "VERSION" => "1.974", "test" => { "TESTS" => "t/*.t" } @@ -119,7 +119,7 @@ "Test::Fatal" => 0, "Test::More" => "0.98", "Test::SharedFork" => 0, - "Test::TCP" => 0, + "Test::TCP" => "1.19", "Try::Tiny" => 0 ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/README new/Redis-1.974/README --- old/Redis-1.972/README 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/README 2014-05-16 21:42:52.000000000 +0200 @@ -1,7 +1,7 @@ This archive contains the distribution Redis, -version 1.972: +version 1.974: Perl binding for Redis database diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/dist.ini new/Redis-1.974/dist.ini --- old/Redis-1.972/dist.ini 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/dist.ini 2014-05-16 21:42:52.000000000 +0200 @@ -6,9 +6,11 @@ copyright_year = 2013 ; -- version from git -[Git::NextVersion] +version = 1.974 +;[Git::NextVersion] first_version = 1.962 +[MetaJSON] [MetaResources] homepage = https://github.com/PerlRedis/perl-redis bugtracker.web = https://github.com/PerlRedis/perl-redis/issues @@ -57,7 +59,7 @@ Test::Deep = 0 Test::Fatal = 0 Test::More = 0.98 -Test::TCP = 0 +Test::TCP = 1.19 Test::CPAN::Meta = 0 Pod::Coverage::TrustPod = 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/lib/Redis/Hash.pm new/Redis-1.974/lib/Redis/Hash.pm --- old/Redis-1.972/lib/Redis/Hash.pm 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/lib/Redis/Hash.pm 2014-05-16 21:42:52.000000000 +0200 @@ -9,7 +9,7 @@ # package Redis::Hash; { - $Redis::Hash::VERSION = '1.972'; + $Redis::Hash::VERSION = '1.974'; } # ABSTRACT: tie Perl hashes to Redis hashes @@ -89,7 +89,7 @@ =head1 VERSION -version 1.972 +version 1.974 =head1 DESCRIPTION diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/lib/Redis/List.pm new/Redis-1.974/lib/Redis/List.pm --- old/Redis-1.972/lib/Redis/List.pm 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/lib/Redis/List.pm 2014-05-16 21:42:52.000000000 +0200 @@ -9,7 +9,7 @@ # package Redis::List; { - $Redis::List::VERSION = '1.972'; + $Redis::List::VERSION = '1.974'; } # ABSTRACT: tie Perl arrays to Redis lists @@ -109,7 +109,7 @@ =head1 VERSION -version 1.972 +version 1.974 =head1 SYNOPSYS diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/lib/Redis/Sentinel.pm new/Redis-1.974/lib/Redis/Sentinel.pm --- old/Redis-1.972/lib/Redis/Sentinel.pm 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/lib/Redis/Sentinel.pm 2014-05-16 21:42:52.000000000 +0200 @@ -9,7 +9,7 @@ # package Redis::Sentinel; { - $Redis::Sentinel::VERSION = '1.972'; + $Redis::Sentinel::VERSION = '1.974'; } # ABSTRACT: Redis Sentinel interface @@ -57,7 +57,7 @@ =head1 VERSION -version 1.972 +version 1.974 =head1 SYNOPSIS diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/lib/Redis.pm new/Redis-1.974/lib/Redis.pm --- old/Redis-1.972/lib/Redis.pm 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/lib/Redis.pm 2014-05-16 21:42:52.000000000 +0200 @@ -9,7 +9,7 @@ # package Redis; { - $Redis::VERSION = '1.972'; + $Redis::VERSION = '1.974'; } # ABSTRACT: Perl binding for Redis database @@ -38,6 +38,7 @@ use constant EWOULDBLOCK => eval {Errno::EWOULDBLOCK} || -1E9; use constant EAGAIN => eval {Errno::EAGAIN} || -1E9; use constant EINTR => eval {Errno::EINTR} || -1E9; +use constant BUFSIZE => 4096; sub _maybe_enable_timeouts { my ($self, $socket) = @_; @@ -54,8 +55,9 @@ sub new { my ($class, %args) = @_; - my $self = bless {}, $class; + my $self = bless {}, $class; + $self->{__buf} = ''; $self->{debug} = $args{debug} || $ENV{REDIS_DEBUG}; ## Deal with REDIS_SERVER ENV @@ -217,7 +219,19 @@ # If this is an EXEC command, in pipelined mode, and one of the commands # executed in the transaction yields an error, we must collect all errors # from that command, rather than throwing an exception immediately. - my $collect_errors = $cb && uc($command) eq 'EXEC'; + my $uc_command = uc($command); + my $collect_errors = $cb && $uc_command eq 'EXEC'; + + if ($uc_command eq 'MULTI') { + $self->{__inside_transaction} = 1; + } elsif ($uc_command eq 'EXEC' || $uc_command eq 'DISCARD') { + delete $self->{__inside_transaction}; + delete $self->{__inside_watch}; + } elsif ($uc_command eq 'WATCH') { + $self->{__inside_watch} = 1; + } elsif ($uc_command eq 'UNWATCH') { + delete $self->{__inside_watch}; + } ## Fast path, no reconnect; $self->{reconnect} @@ -244,6 +258,9 @@ ref($_) eq 'Redis::X::Reconnect' or die $_; + $self->{__inside_transaction} || $self->{__inside_watch} + and croak("reconnect disabled inside transaction or watch"); + $self->connect; $cb->(); } @@ -312,7 +329,7 @@ $self->__send_command('QUIT'); }; - close(delete $self->{sock}) if $self->{sock}; + $self->__close_sock() if $self->{sock}; return 1; } @@ -328,7 +345,7 @@ $self->wait_all_responses; $self->__send_command('SHUTDOWN'); - close(delete $self->{sock}) || croak("Can't close socket: $!"); + $self->__close_sock() || croak("Can't close socket: $!"); return 1; } @@ -347,7 +364,7 @@ $self->__std_cmd('PING'); } catch { - close(delete $self->{sock}); + $self->__close_sock(); return; }; } @@ -424,22 +441,21 @@ $s->add($sock); while ($s->can_read($timeout)) { - my $has_stuff = __try_read_sock($sock); + my $has_stuff = $self->__try_read_sock($sock); # If the socket is ready to read but there is nothing to read, ( so # it's an EOF ), try to reconnect. defined $has_stuff or $self->__throw_reconnect('EOF from server'); - while (1) { - my $has_stuff = __try_read_sock($sock); - $has_stuff - or last ; ## no data ( or socket became EOF), back to select until - ## timeout - + + do { my ($reply, $error) = $self->__read_response('WAIT_FOR_MESSAGES'); croak "[WAIT_FOR_MESSAGES] $error, " if defined $error; $self->__process_pubsub_msg($reply); $count++; - } + + # if __try_read_sock() return 0 (no data) + # or undef ( socket became EOF), back to select until timeout + } while ($self->{__buf} || $self->__try_read_sock($sock)); } }); @@ -565,6 +581,8 @@ sub connect { my ($self) = @_; delete $self->{sock}; + delete $self->{__inside_watch}; + delete $self->{__inside_transaction}; # Suppose we have at least one command response pending, but we're about # to reconnect. The new connection will never get a response to any of @@ -597,6 +615,8 @@ $self->{sock} = $self->{builder}->($self) || croak("Could not connect to Redis server at $self->{server}: $!"); + $self->{__buf} = ''; + if (exists $self->{password}) { try { $self->auth($self->{password}) } catch { @@ -610,6 +630,14 @@ return; } +sub __close_sock { + my ($self) = @_; + $self->{__buf} = ''; + delete $self->{__inside_watch}; + delete $self->{__inside_transaction}; + return close(delete $self->{sock}); +} + sub __on_connection { my ($self) = @_; @@ -676,7 +704,7 @@ } ## Check to see if socket was closed: reconnect on EOF - my $status = __try_read_sock($sock); + my $status = $self->__try_read_sock($sock); $self->__throw_reconnect('Not connected to any server') unless defined $status; @@ -747,7 +775,7 @@ my $self = $_[0]; my $sock = $self->{sock}; - my $data = <$sock>; + my $data = $self->__read_line_raw; croak("Error while reading from Redis server: $!") unless defined $data; @@ -758,121 +786,99 @@ return ($type, $data); } +sub __read_line_raw { + my $self = $_[0]; + my $sock = $self->{sock}; + my $buf = \$self->{__buf}; + + if (length $$buf) { + my $idx = index($$buf, "\r\n"); + $idx >= 0 and return substr($$buf, 0, $idx + 2, ''); + } + + while (1) { + my $bytes = sysread($sock, $$buf, BUFSIZE, length($$buf)); + next if !defined $bytes && $! == EINTR; + return unless defined $bytes && $bytes; + + # start looking for \r\n where we stopped last time + # extracting one is required to handle corner case + # where \r\n are split and therefore read by two conseqent sysreads + my $idx = index($$buf, "\r\n", length($$buf) - $bytes - 1); + $idx >= 0 and return substr($$buf, 0, $idx + 2, ''); + } +} + sub __read_len { my ($self, $len) = @_; + my $buf = \$self->{__buf}; + my $buflen = length($$buf); - my $data = ''; - my $offset = 0; - while ($len) { - my $bytes = read $self->{sock}, $data, $len, $offset; - croak("Error while reading from Redis server: $!") - unless defined $bytes; - croak("Redis server closed connection") unless $bytes; - - $offset += $bytes; - $len -= $bytes; + if ($buflen < $len) { + my $to_read = $len - $buflen; + while ($to_read > 0) { + my $bytes = sysread($self->{sock}, $$buf, BUFSIZE, length($$buf)); + next if !defined $bytes && $! == EINTR; + croak("Error while reading from Redis server: $!") unless defined $bytes; + croak("Redis server closed connection") unless $bytes; + $to_read -= $bytes; + } } + my $data = substr($$buf, 0, $len, ''); chomp $data; warn "[RECV RAW] '$data'" if $self->{debug}; return $data; } - -# -# The reason for this code: -# -# IO::Select and buffered reads like <$sock> and read() don't mix -# For example, if I receive two MESSAGE messages (from Redis PubSub), -# the first read for the first message will probably empty to socket -# buffer and move the data to the perl IO buffer. -# -# This means that IO::Select->can_read will return false (after all -# the socket buffer is empty) but from the application point of view -# there is still data to be read and process -# -# Hence this code. We try to do a non-blocking read() of 1 byte, and if -# we succeed, we put it back and signal "yes, Virginia, there is still -# stuff out there" -# -# We could just use sysread and leave the socket buffer with the second -# message, and then use IO::Select as intended, and previous versions of -# this code did that (check the git history for this file), but -# performance suffers, about 20/30% slower, mostly because we do a lot -# of "read one line", where <$sock> beats the crap of anything you can -# write on Perl-land. -# sub __try_read_sock { - my $sock = shift; + my ($self, $sock) = @_; my $data = ''; - __fh_nonblocking($sock, 1); + while (1) { + # WIN32 doesn't support MSG_DONTWAIT, + # need to swith fh to nonblockng mode manually. + # For Unix still use MSG_DONTWAIT because of fewer syscalls + my ($res, $err); + if (WIN32) { + __fh_nonblocking_win32($sock, 1); + $res = recv($sock, $data, BUFSIZE, 0); + $err = 0 + $!; + __fh_nonblocking_win32($sock, 0); + } else { + $res = recv($sock, $data, BUFSIZE, MSG_DONTWAIT); + $err = 0 + $!; + } - ## Lots of problems with Windows here. This is a temporary fix until I - ## figure out what is happening there. It looks like the wrong fix - ## because we should not mix sysread (unbuffered I/O) with ungetc() - ## below (buffered I/O), so I do expect to revert this soon. - ## Call it a run through the CPAN Testers Gautlet fix. If I had to - ## guess (and until my Windows box has a new power supply I do have to - ## guess), I would say that the problems lies with the call - ## __fh_nonblocking(), where on Windows we don't end up with a non- - ## blocking socket. - ## See - ## * https://github.com/melo/perl-redis/issues/20 - ## * https://github.com/melo/perl-redis/pull/21 - my $len; - local $! = 0; - if (WIN32) { - $len = sysread($sock, $data, 1); - } - else { - $len = read($sock, $data, 1); - } - my $err = 0 + $!; - __fh_nonblocking($sock, 0); + if (defined $res) { + ## have read some data + if (length($data)) { + $self->{__buf} .= $data; + return 1; + } - if (defined($len)) { - ## Have stuff - if ($len > 0) { - $sock->ungetc(ord($data)); - return 1; - } - ## EOF according to the docs - ## (however FreeBSD seems to return $len = 0 when read fails) - elsif ($len == 0) { - if ($err and ($err == EWOULDBLOCK or $err == EAGAIN or $err == EINTR)) { - return 0; - } - return; - } - else { - croak("read()/sysread() are really bonkers on $^O, return negative values ($len)"); - } - } + ## no data but also no error means EOF + return; + } - ## Keep going if nothing there, but socket is alive - return 0 if $err and ($err == EWOULDBLOCK or $err == EAGAIN or $err == EINTR); + next if $err && $err == EINTR; - ## No errno, but result is undef?? This happens sometimes on my tests - ## when the server timesout the client. I traced the system calls and - ## I see the read() system call return 0 for EOF, but on this side of - ## perl, we get undef... We should see the 0 return code for EOF, I - ## suspect the fact that we are in non-blocking mode is the culprit - return if $err == 0; - - ## For everything else, there is Mastercard... - croak("Unexpected error condition $err/$^O, please report this as a bug"); -} + ## Keep going if nothing there, but socket is alive + return 0 if $err and ($err == EWOULDBLOCK or $err == EAGAIN); + ## result is undef but err is 0? should never happen + return if $err == 0; -### Copied from AnyEvent::Util -BEGIN { - *__fh_nonblocking = (WIN32) - ? sub($$) { ioctl $_[0], 0x8004667e, pack "L", $_[1]; } # FIONBIO - : sub($$) { fcntl $_[0], F_SETFL, $_[1] ? O_NONBLOCK : 0; }; + ## For everything else, there is Mastercard... + croak("Unexpected error condition $err/$^O, please report this as a bug"); + } } +## Copied from AnyEvent::Util +sub __fh_nonblocking_win32 { + ioctl $_[0], 0x8004667e, pack "L", $_[1]; +} ########################## # I take exception to that @@ -898,7 +904,7 @@ =head1 VERSION -version 1.972 +version 1.974 =head1 SYNOPSIS @@ -924,10 +930,10 @@ ## Enable auto-reconnect ## Try to reconnect every 1s up to 60 seconds until success ## Die if you can't after that - my $redis = Redis->new(reconnect => 60); + my $redis = Redis->new(reconnect => 60, every => 1000); - ## Try each 100ms upto 2 seconds (every is in milisecs) - my $redis = Redis->new(reconnect => 2, every => 100); + ## Try each 100ms upto 2 seconds (every is in nanosecond) + my $redis = Redis->new(reconnect => 2, every => 100_000); ## Enable connection timeout (in seconds) my $redis = Redis->new(cnx_timeout => 60); @@ -1132,7 +1138,7 @@ The C<< reconnect >> option enables auto-reconnection mode. If we cannot connect to the Redis server, or if a network write fails, we enter retry mode. -We will try a new connection every C<< every >> milliseconds (1000ms by +We will try a new connection every C<< every >> nanoseconds (1 ms by default), up-to C<< reconnect >> seconds. Be aware that read errors will always thrown an exception, and will not trigger @@ -1773,7 +1779,7 @@ =head1 ACKNOWLEDGEMENTS -The following persons contributed to this project (alphabetical order): +The following persons contributed to this project (random order): =over diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/t/02-responses.t new/Redis-1.974/t/02-responses.t --- old/Redis-1.972/t/02-responses.t 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/t/02-responses.t 2014-05-16 21:42:52.000000000 +0200 @@ -27,6 +27,7 @@ sub r { $r->{sock} = IO::String->new(join('', map {"$_\r\n"} @_)); + $r->{__buf} = ''; } ## -ERR responses diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/t/05-nonblock.t new/Redis-1.974/t/05-nonblock.t --- old/Redis-1.972/t/05-nonblock.t 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/t/05-nonblock.t 2014-05-16 21:42:52.000000000 +0200 @@ -26,7 +26,7 @@ ## But kill if we block local $SIG{ALRM} = sub { kill 9, $$ }; alarm(2); - ok(!Redis::__try_read_sock($r->{sock}), "Nothing to read, didn't block"); + ok(!$r->__try_read_sock($r->{sock}), "Nothing to read, didn't block"); alarm(0); }; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Redis-1.972/t/07-reconnect.t new/Redis-1.974/t/07-reconnect.t --- old/Redis-1.972/t/07-reconnect.t 2014-02-18 00:54:05.000000000 +0100 +++ new/Redis-1.974/t/07-reconnect.t 2014-05-16 21:42:52.000000000 +0200 @@ -17,6 +17,7 @@ use Redis; use lib 't/tlib'; use Test::SpawnRedisServer; +use Net::EmptyPort qw(empty_port); my ($c, $srv) = redis(timeout => 1); END { $c->() if $c } @@ -108,6 +109,63 @@ ok(tv_interval($t0) > 3, '... minimum value for the reconnect reached'); }; +subtest "Reconnect during transaction" => sub { + $c->(); ## Make previous server is dead + + my $port = empty_port(); + ok(($c, $srv) = redis(port => $port, timeout => 1), "spawn redis on port $port"); + ok(my $r = Redis->new(reconnect => 3, server => $srv), 'connected to our test redis-server'); + + ok($r->multi(), 'start transacion'); + ok($r->set('reconnect_1' => 1), 'set first key'); + + $c->(); + ok(($c, $srv) = redis(port => $port, timeout => 1), "respawn redis on port $port"); + + like(exception { $r->set('reconnect_2' => 2) }, qr{reconnect disabled inside transaction}, 'set second key'); + + $r->connect(); #reconnect + is($r->exists('reconnect_1'), 0, 'key "reconnect_1" should not exist'); + is($r->exists('reconnect_2'), 0, 'key "reconnect_2" should not exist'); +}; + +subtest "Reconnect works after WATCH + MULTI + EXEC" => sub { + $c->(); ## Make previous server is dead + + my $port = empty_port(); + ok(($c, $srv) = redis(port => $port, timeout => 1), "spawn redis on port $port"); + ok(my $r = Redis->new(reconnect => 3, server => $srv), 'connected to our test redis-server'); + + ok($r->set('watch' => 'watch'), 'set watch key'); + ok($r->watch('watch'), 'start watching key'); + ok($r->multi(), 'start transacion'); + ok($r->set('reconnect' => 1), 'set key'); + ok($r->exec(), 'execute transaction'); + + $c->(); + ok(($c, $srv) = redis(port => $port, timeout => 1), "respawn redis on port $port"); + + ok($r->set('reconnect' => 1), 'setting key should not fail'); +}; + +subtest "Reconnect works after WATCH + MULTI + DISCARD" => sub { + $c->(); ## Make previous server is dead + + my $port = empty_port(); + ok(($c, $srv) = redis(port => $port, timeout => 1), "spawn redis on port $port"); + ok(my $r = Redis->new(reconnect => 3, server => $srv), 'connected to our test redis-server'); + + ok($r->set('watch' => 'watch'), 'set watch key'); + ok($r->watch('watch'), 'start watching key'); + ok($r->multi(), 'start transacion'); + ok($r->set('reconnect' => 1), 'set key'); + ok($r->discard(), 'dscard transaction'); + + $c->(); + ok(($c, $srv) = redis(port => $port, timeout => 1), "respawn redis on port $port"); + + ok($r->set('reconnect' => 1), 'setting second key should not fail'); +}; done_testing(); -- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
