@@ -1,69 +1,3 @@
-
-use strict;
-use warnings;
-
-use Module::Build 0.3601;
-
-
-my %module_build_args = (
- "build_requires" => {
- "Module::Build" => "0.3601"
- },
- "configure_requires" => {
- "ExtUtils::MakeMaker" => "6.63_03",
- "Module::Build" => "0.3601"
- },
- "dist_abstract" => "Perl binding for Redis database",
- "dist_author" => [
- "Pedro Melo <melo\@cpan.org>",
- "Damien Krotkine <dams\@cpan.org>"
- ],
- "dist_name" => "Redis",
- "dist_version" => "1.965",
- "license" => "artistic_2",
- "module_name" => "Redis",
- "recommends" => {},
- "recursive_test_files" => 1,
- "requires" => {
- "Try::Tiny" => 0,
- "perl" => "5.008"
- },
- "script_files" => [],
- "test_requires" => {
- "Digest::SHA" => 0,
- "File::Spec" => 0,
- "IO::Handle" => 0,
- "IO::String" => 0,
- "IPC::Cmd" => 0,
- "IPC::Open3" => 0,
- "Test::Deep" => 0,
- "Test::Fatal" => 0,
- "Test::More" => "0.98",
- "Test::SharedFork" => 0
- }
-);
-
-
-my %fallback_build_requires = (
- "Digest::SHA" => 0,
- "File::Spec" => 0,
- "IO::Handle" => 0,
- "IO::String" => 0,
- "IPC::Cmd" => 0,
- "IPC::Open3" => 0,
- "Module::Build" => "0.3601",
- "Test::Deep" => 0,
- "Test::Fatal" => 0,
- "Test::More" => "0.98",
- "Test::SharedFork" => 0
-);
-
-
-unless ( eval { Module::Build->VERSION(0.4004) } ) {
- delete $module_build_args{test_requires};
- $module_build_args{build_requires} = \%fallback_build_requires;
-}
-
-my $build = Module::Build->new(%module_build_args);
-
-$build->create_build_script;
+use 5.008;
+use Module::Build::Tiny 0.036;
+Build_PL();
@@ -1,5 +1,74 @@
Revision history for Redis
+1.978 2015-01-28 09:52:27 Europe/Amsterdam
+
+ * reshape the documentation
+ * croak when reconnecting while responses are pending (#101)
+ * merge PR#106 ( support "0" in topic )
+
+1.977 2015-01-28 01:10:31 Europe/Amsterdam
+
+1.976 2014-10-03 15:05:58 Europe/Amsterdam
+
+1.975 2014-08-03 20:50:25 Europe/Amsterdam
+
+ * Clarification about reconnect and read_timeout (#89)
+ * Test::CPAN::Meta (et al.) are required even if unused (#92)
+
+1.974 2014-05-16 21:42:48 Europe/Amsterdam
+
+ * released as stable version, no change
+
+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
+ * fix network code for BSDs
+ * no_auto_connect_on_new
+
+1.971 2014-02-01 09:55:11 Europe/Paris
+
+ * skip some tests that fail on some platforms for now
+
+1.970 2014-01-30 15:07:42 Europe/Amsterdam
+
+ * fix tests breaking in some case
+
+1.969 2014-01-30 13:19:28 Europe/Amsterdam
+
+ * Clarification for (p)unsubscribe commands.
+ * use Test::TCP for testing
+
+1.968 2014-01-30 12:19:11 Europe/Amsterdam
+
+ * Add a no_auto_connect_on_new parameter to new() to allow users
+ to call $x = Redis->new and then $x->connect, instead of Redis
+ auto-connecting. Useful for tuning the cnx_timeout parameter.
+
+1.967 2013-12-28 22:58:55 Europe/Paris
+ * use new IO::Socket::Timeout with different API
+
+1.966 2013-12-17 13:58:33 Europe/Amsterdam
+ * fix tests for Redis 2.8
+
1.965 2013-11-29 09:28:36 Europe/Amsterdam
* fix #60: TEST_REQUIRES needs newer MakeMaker
@@ -1,4 +1,4 @@
-This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
This is free software, licensed under:
@@ -2,6 +2,7 @@ Build.PL
Changes
LICENSE
MANIFEST
+META.json
META.yml
Makefile.PL
README
@@ -9,6 +10,7 @@ dist.ini
lib/Redis.pm
lib/Redis/Hash.pm
lib/Redis/List.pm
+lib/Redis/Sentinel.pm
scripts/publish.pl
scripts/redis-benchmark.pl
t/00-compile.t
@@ -20,18 +22,21 @@ t/05-nonblock.t
t/06-on-connect.t
t/07-reconnect.t
t/08-unix-socket.t
-t/09-env-redis-server.t
t/10-tie-list.t
+t/11-timeout.t
t/20-tie-hash.t
t/30-scripts.t
t/42-client_cmds.t
+t/44-no-unicode-bug.t
t/50-fork_safe.t
t/release-distmeta.t
t/release-pod-coverage.t
t/tlib/Test/SpawnRedisServer.pm
+t/tlib/Test/SpawnRedisTimeoutServer.pm
tools/benchmarks/read_vs_sysread.pl
tools/benchmarks/readline_vs_sysread_vs_recv/client-readline.pl
tools/benchmarks/readline_vs_sysread_vs_recv/client-recv.pl
tools/benchmarks/readline_vs_sysread_vs_recv/client-sysread.pl
tools/benchmarks/readline_vs_sysread_vs_recv/run.pl
tools/benchmarks/readline_vs_sysread_vs_recv/server-generator.pl
+tools/html_doc_scrapper.pl
@@ -0,0 +1,70 @@
+{
+ "abstract" : "Perl binding for Redis database",
+ "author" : [
+ "Pedro Melo <melo@cpan.org>",
+ "Damien Krotkine <dams@cpan.org>"
+ ],
+ "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.036"
+ }
+ },
+ "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.978"
+}
+
@@ -10,14 +10,16 @@ build_requires:
IO::String: 0
IPC::Cmd: 0
IPC::Open3: 0
- Module::Build: 0.3601
+ 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
configure_requires:
ExtUtils::MakeMaker: 6.63_03
- Module::Build: 0.3601
+ Module::Build::Tiny: 0.036
dynamic_config: 0
generated_by: 'Dist::Zilla version 5.005, CPAN::Meta::Converter version 2.132830'
license: artistic_2
@@ -26,10 +28,11 @@ meta-spec:
version: 1.4
name: Redis
requires:
+ IO::Socket::Timeout: 0.22
Try::Tiny: 0
perl: 5.008
resources:
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.965
+version: 1.978
@@ -1,7 +1,66 @@
+# This Makefile.PL for Redis was generated by
+# Dist::Zilla::Plugin::MakeMaker::Fallback 0.005
+# and Dist::Zilla::Plugin::MakeMaker::Awesome 0.19.
+# Don't edit it but the dist.ini and plugins used to construct it.
use strict;
use warnings;
+BEGIN {
+my %configure_requires = (
+ 'ExtUtils::MakeMaker' => '6.63_03',
+ 'Module::Build::Tiny' => '0.036',
+);
+
+my @missing = grep {
+ ! eval "require $_; $_->VERSION($configure_requires{$_}); 1"
+} keys %configure_requires;
+
+if (not @missing)
+{
+ print "Congratulations, your toolchain understands 'configure_requires'!\n\n";
+}
+else
+{
+ $ENV{PERL_MM_FALLBACK_SILENCE_WARNING} or warn <<'EOW';
+*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***
+
+If you're seeing this warning, your toolchain is really, really old* and you'll
+almost certainly have problems installing CPAN modules from this century. But
+never fear, dear user, for we have the technology to fix this!
+
+If you're using CPAN.pm to install things, then you can upgrade it using:
+
+ cpan CPAN
+
+If you're using CPANPLUS to install things, then you can upgrade it using:
+
+ cpanp CPANPLUS
+
+If you're using cpanminus, you shouldn't be seeing this message in the first
+place, so please file an issue on github.
+
+If you're installing manually, please retrain your fingers to run Build.PL
+when present instead.
+
+This public service announcement was brought to you by the Perl Toolchain
+Gang, the irc.perl.org #toolchain IRC channel, and the number 42.
+
+----
+
+* Alternatively, you are doing something overly clever, in which case you
+should consider setting the 'prefer_installer' config option in CPAN.pm, or
+'prefer_makefile' in CPANPLUS, to 'mb" and '0' respectively.
+
+You can also silence this warning for future installations by setting the
+PERL_MM_FALLBACK_SILENCE_WARNING environment variable.
+
+EOW
+
+ sleep 10 if -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT));
+}
+}
+
use 5.008;
use ExtUtils::MakeMaker 6.63_03;
@@ -11,18 +70,17 @@ use ExtUtils::MakeMaker 6.63_03;
my %WriteMakefileArgs = (
"ABSTRACT" => "Perl binding for Redis database",
"AUTHOR" => "Pedro Melo <melo\@cpan.org>, Damien Krotkine <dams\@cpan.org>",
- "BUILD_REQUIRES" => {
- "Module::Build" => "0.3601"
- },
+ "BUILD_REQUIRES" => {},
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => "6.63_03",
- "Module::Build" => "0.3601"
+ "Module::Build::Tiny" => "0.036"
},
"DISTNAME" => "Redis",
"EXE_FILES" => [],
"LICENSE" => "artistic_2",
"NAME" => "Redis",
"PREREQ_PM" => {
+ "IO::Socket::Timeout" => "0.22",
"Try::Tiny" => 0
},
"TEST_REQUIRES" => {
@@ -32,12 +90,15 @@ my %WriteMakefileArgs = (
"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::SharedFork" => 0,
+ "Test::TCP" => "1.19"
},
- "VERSION" => "1.965",
+ "VERSION" => "1.978",
"test" => {
"TESTS" => "t/*.t"
}
@@ -48,14 +109,17 @@ my %FallbackPrereqs = (
"Digest::SHA" => 0,
"File::Spec" => 0,
"IO::Handle" => 0,
+ "IO::Socket::Timeout" => "0.22",
"IO::String" => 0,
"IPC::Cmd" => 0,
"IPC::Open3" => 0,
- "Module::Build" => "0.3601",
+ "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",
"Try::Tiny" => 0
);
@@ -1,11 +1,11 @@
This archive contains the distribution Redis,
-version 1.965:
+version 1.978:
Perl binding for Redis database
-This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
This is free software, licensed under:
@@ -3,12 +3,14 @@ author = Pedro Melo <melo@cpan.org>
author = Damien Krotkine <dams@cpan.org>
license = Artistic_2_0
copyright_holder = Pedro Melo, Damien Krotkine
-copyright_year = 2013
+copyright_year = 2015
; -- 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
@@ -17,6 +19,10 @@ repository.url = https://github.com/PerlRedis/perl-redis.git
repository.type = git
[GatherDir]
+exclude_match = redis-server-*
+exclude_match = t/redis-server-*
+exclude_match = sentinel-*
+exclude_match = t/sentinel-*
[PruneCruft]
[ManifestSkip]
[MetaYAML]
@@ -25,15 +31,15 @@ repository.type = git
[ExtraTests]
[ExecDir]
[ShareDir]
-[MakeMaker]
-eumm_version = 6.63_03
[Manifest]
[TestRelease]
[ConfirmRelease]
[UploadToCPAN]
-[ModuleBuild]
+[ModuleBuildTiny]
+[MakeMaker::Fallback]
+eumm_version = 6.63_03
[PkgVersion]
[PodWeaver]
[Prepender]
@@ -44,14 +50,18 @@ copyright = 1
[PodCoverageTests]
[Prereqs]
Try::Tiny = 0
+IO::Socket::Timeout = 0.22
[Prereqs / TestRequires]
Test::SharedFork = 0
-Digest::SHA = 0,
-IO::String = 0,
-IPC::Cmd = 0,
-Test::Deep = 0,
-Test::Fatal = 0,
-Test::More = 0.98,
+Digest::SHA = 0
+IO::String = 0
+IPC::Cmd = 0
+Test::Deep = 0
+Test::Fatal = 0
+Test::More = 0.98
+Test::TCP = 1.19
+Test::CPAN::Meta = 0
+Pod::Coverage::TrustPod = 0
; -- release
[NextRelease]
@@ -1,7 +1,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -9,7 +9,7 @@
#
package Redis::Hash;
{
- $Redis::Hash::VERSION = '1.965';
+ $Redis::Hash::VERSION = '1.978';
}
# ABSTRACT: tie Perl hashes to Redis hashes
@@ -89,7 +89,7 @@ Redis::Hash - tie Perl hashes to Redis hashes
=head1 VERSION
-version 1.965
+version 1.978
=head1 DESCRIPTION
@@ -134,7 +134,7 @@ Damien Krotkine <dams@cpan.org>
=head1 COPYRIGHT AND LICENSE
-This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
This is free software, licensed under:
@@ -1,7 +1,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -9,7 +9,7 @@
#
package Redis::List;
{
- $Redis::List::VERSION = '1.965';
+ $Redis::List::VERSION = '1.978';
}
# ABSTRACT: tie Perl arrays to Redis lists
@@ -109,7 +109,7 @@ Redis::List - tie Perl arrays to Redis lists
=head1 VERSION
-version 1.965
+version 1.978
=head1 SYNOPSYS
@@ -146,7 +146,7 @@ Damien Krotkine <dams@cpan.org>
=head1 COPYRIGHT AND LICENSE
-This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
This is free software, licensed under:
@@ -0,0 +1,118 @@
+#
+# This file is part of Redis
+#
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
+#
+# This is free software, licensed under:
+#
+# The Artistic License 2.0 (GPL Compatible)
+#
+package Redis::Sentinel;
+{
+ $Redis::Sentinel::VERSION = '1.978';
+}
+
+# ABSTRACT: Redis Sentinel interface
+
+use warnings;
+use strict;
+
+use Carp;
+
+use base qw(Redis);
+
+sub new {
+ my ($class, %args) = @_;
+ # these args are not allowed when contacting a sentinel
+ delete @args{qw(sentinels service)};
+
+ $class->SUPER::new(%args);
+}
+
+sub get_service_address {
+ my ($self, $service) = @_;
+ my ($ip, $port) = $self->sentinel('get-master-addr-by-name', $service);
+ defined $ip
+ or return;
+ $ip eq 'IDONTKNOW'
+ and return $ip;
+ return "$ip:$port";
+}
+
+sub get_masters {
+ map { +{ @$_ }; } @{ shift->sentinel('masters') || [] };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Redis::Sentinel - Redis Sentinel interface
+
+=head1 VERSION
+
+version 1.978
+
+=head1 SYNOPSIS
+
+ my $sentinel = Redis::Sentinel->new( ... );
+ my $service_address = $sentinel->get_service_address('mymaster');
+ my @masters = $sentinel->get_masters;
+
+=head1 DESCRIPTION
+
+This is a subclass of the Redis module, specialized into connecting to a
+Sentinel instance. Inherits from the C<Redis> package;
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+See C<new> in L<Redis.pm>. All parameters are supported, except C<sentinels>
+and C<service>, which are silently ignored.
+
+=head1 METHODS
+
+All the methods of the C<Redis> package are supported, plus the additional following methods:
+
+=head2 get_service_address
+
+Takes the name of a service as parameter, and returns either void (emptly list)
+if the master couldn't be found, the string 'IDONTKNOW' if the service is in
+the sentinel config but cannot be reached, or the string C<"$ip:$port"> if the
+service were found.
+
+=head2 get_masters
+
+Returns a list of HashRefs representing all the master redis instances that
+this sentinel monitors.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Pedro Melo <melo@cpan.org>
+
+=item *
+
+Damien Krotkine <dams@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
+
+This is free software, licensed under:
+
+ The Artistic License 2.0 (GPL Compatible)
+
+=cut
@@ -1,7 +1,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -9,7 +9,7 @@
#
package Redis;
{
- $Redis::VERSION = '1.965';
+ $Redis::VERSION = '1.978';
}
# ABSTRACT: Perl binding for Redis database
@@ -21,30 +21,46 @@ use strict;
use IO::Socket::INET;
use IO::Socket::UNIX;
+use IO::Socket::Timeout;
use IO::Select;
use IO::Handle;
use Fcntl qw( O_NONBLOCK F_SETFL );
use Errno ();
use Data::Dumper;
-use Carp qw/confess/;
-use Encode;
+use Carp;
use Try::Tiny;
use Scalar::Util ();
+use Redis::Sentinel;
+
use constant WIN32 => $^O =~ /mswin32/i;
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) = @_;
+ $socket or return;
+ exists $self->{read_timeout} || exists $self->{write_timeout}
+ or return $socket;
+ IO::Socket::Timeout->enable_timeouts_on($socket);
+ defined $self->{read_timeout}
+ and $socket->read_timeout($self->{read_timeout});
+ defined $self->{write_timeout}
+ and $socket->write_timeout($self->{write_timeout});
+ $socket;
+}
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
- if ($ENV{REDIS_SERVER} && !$args{sock} && !$args{server}) {
+ if ($ENV{REDIS_SERVER} && ! exists $args{sock} && ! exists $args{server} && ! exists $args{sentinel}) {
if ($ENV{REDIS_SERVER} =~ m!^/!) {
$args{sock} = $ENV{REDIS_SERVER};
}
@@ -56,35 +72,108 @@ sub new {
}
}
- $args{password}
- and $self->{password} = $args{password};
-
- $args{on_connect}
- and $self->{on_connect} = $args{on_connect};
+ defined $args{$_}
+ and $self->{$_} = $args{$_} for
+ qw(password on_connect name no_auto_connect_on_new cnx_timeout
+ write_timeout read_timeout sentinels_cnx_timeout sentinels_write_timeout
+ sentinels_read_timeout no_sentinels_list_update);
- defined $args{name}
- and $self->{name} = $args{name};
+ $self->{reconnect} = $args{reconnect} || 0;
+ $self->{conservative_reconnect} = $args{conservative_reconnect} || 0;
+ $self->{every} = $args{every} || 1000;
- if ($args{sock}) {
+ if (exists $args{sock}) {
$self->{server} = $args{sock};
- $self->{builder} = sub { IO::Socket::UNIX->new($_[0]->{server}) };
- }
- else {
- $self->{server} = $args{server} || '127.0.0.1:6379';
$self->{builder} = sub {
- IO::Socket::INET->new(
- PeerAddr => $_[0]->{server},
- Proto => 'tcp',
- );
+ my ($self) = @_;
+ $self->_maybe_enable_timeouts(
+ IO::Socket::UNIX->new(
+ Peer => $self->{server},
+ ( $self->{cnx_timeout} ? ( Timeout => $self->{cnx_timeout} ): () ),
+ )
+ );
+ };
+ } elsif ($args{sentinels}) {
+ $self->{sentinels} = $args{sentinels};
+
+ ref $self->{sentinels} eq 'ARRAY'
+ or croak("'sentinels' param must be an ArrayRef");
+
+ defined($self->{service} = $args{service})
+ or croak("Need 'service' name when using 'sentinels'!");
+
+ $self->{builder} = sub {
+ my ($self) = @_;
+ # try to connect to a sentinel
+ my $status;
+ foreach my $sentinel_address (@{$self->{sentinels}}) {
+ my $sentinel = eval {
+ Redis::Sentinel->new(
+ server => $sentinel_address,
+ cnx_timeout => ( exists $self->{sentinels_cnx_timeout}
+ ? $self->{sentinels_cnx_timeout} : 0.1),
+ read_timeout => ( exists $self->{sentinels_read_timeout}
+ ? $self->{sentinels_read_timeout} : 1 ),
+ write_timeout => ( exists $self->{sentinels_write_timeout}
+ ? $self->{sentinels_write_timeout} : 1 ),
+ )
+ } or next;
+ my $server_address = $sentinel->get_service_address($self->{service});
+ defined $server_address
+ or $status ||= "Sentinels don't know this service",
+ next;
+ $server_address eq 'IDONTKNOW'
+ and $status = "service is configured in one Sentinel, but was never reached",
+ next;
+
+ # we found the service, set the server
+ $self->{server} = $server_address;
+
+ if (! $self->{no_sentinels_list_update} ) {
+ # move the elected sentinel at the front of the list and add
+ # additional sentinels
+ my $idx = 2;
+ my %h = ( ( map { $_ => $idx++ } @{$self->{sentinels}}),
+ $sentinel_address => 1,
+ );
+ $self->{sentinels} = [
+ ( sort { $h{$a} <=> $h{$b} } keys %h ), # sorted existing sentinels,
+ grep { ! $h{$_}; } # list of unknown
+ map { +{ @$_ }->{name}; } # names of
+ $sentinel->sentinel( # sentinels
+ sentinels => $self->{service} # for this service
+ )
+ ];
+ }
+
+ return $self->_maybe_enable_timeouts(
+ IO::Socket::INET->new(
+ PeerAddr => $server_address,
+ Proto => 'tcp',
+ ( $self->{cnx_timeout} ? ( Timeout => $self->{cnx_timeout} ) : () ),
+ )
+ );
+ }
+ croak($status || "failed to connect to any of the sentinels");
+ };
+ } else {
+ $self->{server} = exists $args{server} ? $args{server} : '127.0.0.1:6379';
+ $self->{builder} = sub {
+ my ($self) = @_;
+ $self->_maybe_enable_timeouts(
+ IO::Socket::INET->new(
+ PeerAddr => $self->{server},
+ Proto => 'tcp',
+ ( $self->{cnx_timeout} ? ( Timeout => $self->{cnx_timeout} ) : () ),
+ )
+ );
};
}
$self->{is_subscriber} = 0;
$self->{subscribers} = {};
- $self->{reconnect} = $args{reconnect} || 0;
- $self->{every} = $args{every} || 1000;
- $self->__connect;
+ $self->connect unless $args{no_auto_connect_on_new};
return $self;
}
@@ -130,7 +219,19 @@ sub __std_cmd {
# 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}
@@ -157,7 +258,13 @@ sub __with_reconnect {
ref($_) eq 'Redis::X::Reconnect'
or die $_;
- $self->__connect;
+ $self->{__inside_transaction} || $self->{__inside_watch}
+ and croak("reconnect disabled inside transaction or watch");
+
+ scalar @{$self->{queue} || []} && $self->{conservative_reconnect}
+ and croak("reconnect disabled while responses are pending and conservative reconnect mode enabled");
+
+ $self->connect;
$cb->();
}
);
@@ -174,7 +281,7 @@ sub __run_cmd {
}
: $cb || sub {
my ($reply, $error) = @_;
- confess "[$command] $error, " if defined $error;
+ croak "[$command] $error, " if defined $error;
$ret = $reply;
};
@@ -217,7 +324,7 @@ sub quit {
my ($self) = @_;
return unless $self->{sock};
- confess "[quit] only works in synchronous mode, "
+ croak "[quit] only works in synchronous mode, "
if @_ && ref $_[-1] eq 'CODE';
try {
@@ -225,7 +332,7 @@ sub quit {
$self->__send_command('QUIT');
};
- close(delete $self->{sock}) if $self->{sock};
+ $self->__close_sock() if $self->{sock};
return 1;
}
@@ -234,14 +341,14 @@ sub shutdown {
my ($self) = @_;
$self->__is_valid_command('SHUTDOWN');
- confess "[shutdown] only works in synchronous mode, "
+ croak "[shutdown] only works in synchronous mode, "
if @_ && ref $_[-1] eq 'CODE';
return unless $self->{sock};
$self->wait_all_responses;
$self->__send_command('SHUTDOWN');
- close(delete $self->{sock}) || confess("Can't close socket: $!");
+ $self->__close_sock() || croak("Can't close socket: $!");
return 1;
}
@@ -250,7 +357,7 @@ sub ping {
my $self = shift;
$self->__is_valid_command('PING');
- confess "[ping] only works in synchronous mode, "
+ croak "[ping] only works in synchronous mode, "
if @_ && ref $_[-1] eq 'CODE';
return unless exists $self->{sock};
@@ -260,7 +367,7 @@ sub ping {
$self->__std_cmd('PING');
}
catch {
- close(delete $self->{sock});
+ $self->__close_sock();
return;
};
}
@@ -337,22 +444,21 @@ sub wait_for_messages {
$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');
- confess "[WAIT_FOR_MESSAGES] $error, " if defined $error;
+ 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));
}
});
@@ -375,7 +481,7 @@ sub __subscription_cmd {
my $command = shift;
my $cb = pop;
- confess("Missing required callback in call to $command(), ")
+ croak("Missing required callback in call to $command(), ")
unless ref($cb) eq 'CODE';
$self->wait_all_responses;
@@ -426,7 +532,7 @@ sub __process_subscription_changes {
while (%$expected) {
my ($m, $error) = $self->__read_response($cmd);
- confess "[$cmd] $error, " if defined $error;
+ croak "[$cmd] $error, " if defined $error;
## Deal with pending PUBLISH'ed messages
if ($m->[0] =~ /^p?message$/) {
@@ -451,7 +557,7 @@ sub __process_pubsub_msg {
my $sub = $m->[1];
my $cbid = "$m->[0]:$sub";
my $data = pop @$m;
- my $topic = $m->[2] || $sub;
+ my $topic = defined $m->[2] ? $m->[2] : $sub;
if (!exists $subs->{$cbid}) {
warn "Message for topic '$topic' ($cbid) without expected callback, ";
@@ -469,15 +575,17 @@ sub __process_pubsub_msg {
sub __is_valid_command {
my ($self, $cmd) = @_;
- confess("Cannot use command '$cmd' while in SUBSCRIBE mode, ")
+ croak("Cannot use command '$cmd' while in SUBSCRIBE mode, ")
if $self->{is_subscriber};
}
### Socket operations
-sub __connect {
+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
@@ -508,13 +616,15 @@ sub __build_sock {
my ($self) = @_;
$self->{sock} = $self->{builder}->($self)
- || confess("Could not connect to Redis server at $self->{server}: $!");
+ || croak("Could not connect to Redis server at $self->{server}: $!");
+
+ $self->{__buf} = '';
if (exists $self->{password}) {
try { $self->auth($self->{password}) }
catch {
$self->{reconnect} = 0;
- confess("Redis server refused password");
+ croak("Redis server refused password");
};
}
@@ -523,6 +633,14 @@ sub __build_sock {
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) = @_;
@@ -541,20 +659,19 @@ sub __on_connection {
and $self->select($self->{current_database});
}
- # TODO: don't use each
- while (my ($topic, $cbs) = each %{$self->{subscribers}}) {
+ foreach my $topic (CORE::keys(%{$self->{subscribers}})) {
if ($topic =~ /(p?message):(.*)$/ ) {
my ($key, $channel) = ($1, $2);
if ($key eq 'message') {
$self->__send_command('subscribe', $channel);
my (undef, $error) = $self->__read_response('subscribe');
defined $error
- and confess "[subscribe] $error";
+ and croak "[subscribe] $error";
} else {
$self->__send_command('psubscribe', $channel);
my (undef, $error) = $self->__read_response('psubscribe');
defined $error
- and confess "[psubscribe] $error";
+ and croak "[psubscribe] $error";
}
}
}
@@ -571,7 +688,7 @@ sub __send_command {
my $deb = $self->{debug};
if ($self->{pid} != $$) {
- $self->__connect;
+ $self->connect;
}
my $sock = $self->{sock}
@@ -584,13 +701,13 @@ sub __send_command {
my $n_elems = scalar(@_) + scalar(@cmd);
my $buf = "\*$n_elems\r\n";
for my $bin (@cmd, @_) {
- # force to consider inputs as bytes strings.
- Encode::_utf8_off($bin);
+ utf8::downgrade($bin, 1)
+ or croak "command sent is not an octet sequence in the native encoding (Latin-1). Consider using debug mode to see the command itself.";
$buf .= defined($bin) ? '$' . length($bin) . "\r\n$bin\r\n" : "\$-1\r\n";
}
## 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;
@@ -609,7 +726,7 @@ sub __send_command {
sub __read_response {
my ($self, $cmd, $collect_errors) = @_;
- confess("Not connected to any server") unless $self->{sock};
+ croak("Not connected to any server") unless $self->{sock};
local $/ = "\r\n";
@@ -617,7 +734,7 @@ sub __read_response {
return $self->__read_response_r($cmd, $collect_errors) unless $self->{debug};
my ($result, $error) = $self->__read_response_r($cmd, $collect_errors);
- warn "[RECV] $cmd ", Dumper($result, $error) if $self->{debug};
+ warn "[RECV] $cmd ", Dumper($result, $error);
return $result, $error;
}
@@ -646,14 +763,14 @@ sub __read_response_r {
push @list, \@nested;
}
else {
- confess "[$command] $nested[1], " if defined $nested[1];
+ croak "[$command] $nested[1], " if defined $nested[1];
push @list, $nested[0];
}
}
return \@list, undef;
}
else {
- confess "unknown answer type: $type ($result), ";
+ croak "unknown answer type: $type ($result), ";
}
}
@@ -661,8 +778,8 @@ sub __read_line {
my $self = $_[0];
my $sock = $self->{sock};
- my $data = <$sock>;
- confess("Error while reading from Redis server: $!")
+ my $data = $self->__read_line_raw;
+ croak("Error while reading from Redis server: $!")
unless defined $data;
chomp $data;
@@ -672,116 +789,99 @@ sub __read_line {
return ($type, $data);
}
-sub __read_len {
- my ($self, $len) = @_;
+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, '');
+ }
- my $data = '';
- my $offset = 0;
- while ($len) {
- my $bytes = read $self->{sock}, $data, $len, $offset;
- confess("Error while reading from Redis server: $!")
- unless defined $bytes;
- confess("Redis server closed connection") unless $bytes;
+ 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, '');
+ }
+}
- $offset += $bytes;
- $len -= $bytes;
+sub __read_len {
+ my ($self, $len) = @_;
+ my $buf = \$self->{__buf};
+ my $buflen = length($$buf);
+
+ 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);
-
- ## 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;
- if (WIN32) {
- $len = sysread($sock, $data, 1);
- }
- else {
- $len = read($sock, $data, 1);
- }
- my $err = 0 + $!;
- __fh_nonblocking($sock, 0);
-
- if (defined($len)) {
- ## Have stuff
- if ($len > 0) {
- $sock->ungetc(ord($data));
- return 1;
- }
- ## EOF according to the docs
- elsif ($len == 0) {
- return;
- }
- else {
- confess("read()/sysread() are really bonkers on $^O, return negative values ($len)");
- }
- }
+ 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 + $!;
+ }
+
+ if (defined $res) {
+ ## have read some data
+ if (length($data)) {
+ $self->{__buf} .= $data;
+ return 1;
+ }
- ## Keep going if nothing there, but socket is alive
- return 0 if $err and ($err == EWOULDBLOCK or $err == EAGAIN or $err == EINTR);
+ ## no data but also no error means EOF
+ return;
+ }
- ## 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;
+ next if $err && $err == EINTR;
- ## For everything else, there is Mastercard...
- confess("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
@@ -807,7 +907,7 @@ Redis - Perl binding for Redis database
=head1 VERSION
-version 1.965
+version 1.978
=head1 SYNOPSIS
@@ -833,10 +933,29 @@ version 1.965
## 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 => 1_000_000);
- ## 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 microseconds)
+ my $redis = Redis->new(reconnect => 2, every => 100_000);
+
+ ## Enable connection timeout (in seconds)
+ my $redis = Redis->new(cnx_timeout => 60);
+
+ ## Enable read timeout (in seconds)
+ my $redis = Redis->new(read_timeout => 0.5);
+
+ ## Enable write timeout (in seconds)
+ my $redis = Redis->new(write_timeout => 1.2);
+
+ ## Connect via a list of Sentinels to a given service
+ my $redis = Redis->new(sentinels => [ '127.0.0.1:12345' ], service => 'mymaster');
+
+ ## Same, but with connection, read and write timeout on the sentinel hosts
+ my $redis = Redis->new( sentinels => [ '127.0.0.1:12345' ], service => 'mymaster',
+ sentinels_cnx_timeout => 0.1,
+ sentinels_read_timeout => 1,
+ sentinels_write_timeout => 1,
+ );
## Use all the regular Redis commands, they all accept a list of
## arguments
@@ -913,7 +1032,7 @@ method call:
Pending responses to pipelined commands are processed in a single batch, as
soon as at least one of the following conditions holds:
-=over 4
+=over
=item *
@@ -948,17 +1067,14 @@ useful for Redis transactions; see L</exec>.
=head1 ENCODING
There is no encoding feature anymore, it has been deprecated and finally
-removed. This module consider that any data sent to the Redis server is a raw
-octets string, even if it has utf8 flag set. And it doesn't do anything when
-getting data from the Redis server.
+removed. This module consider that any data sent to the Redis server is a binary data.
+And it doesn't do anything when getting data from the Redis server.
-So, do you pre-encoding or post-decoding operation yourself if needed !
+So, if you are working with character strings, you should pre-encode or post-decode it if needed !
-=head1 METHODS
+=head1 CONSTRUCTOR
-=head2 Constructors
-
-=head3 new
+=head2 new
my $r = Redis->new; # $ENV{REDIS_SERVER} or 127.0.0.1:6379
@@ -971,6 +1087,21 @@ So, do you pre-encoding or post-decoding operation yourself if needed !
my $r = Redis->new( name => 'my_connection_name' );
my $r = Redis->new( name => sub { "cache-for-$$" });
+ my $redis = Redis->new(sentinels => [ '127.0.0.1:12345', '127.0.0.1:23456' ],
+ service => 'mymaster');
+
+ ## Connect via a list of Sentinels to a given service
+ my $redis = Redis->new(sentinels => [ '127.0.0.1:12345' ], service => 'mymaster');
+
+ ## Same, but with connection, read and write timeout on the sentinel hosts
+ my $redis = Redis->new( sentinels => [ '127.0.0.1:12345' ], service => 'mymaster',
+ sentinels_cnx_timeout => 0.1,
+ sentinels_read_timeout => 1,
+ sentinels_write_timeout => 1,
+ );
+
+=head3 C<< server >>
+
The C<< server >> parameter specifies the Redis server we should connect to,
via TCP. Use the 'IP:PORT' format. If no C<< server >> option is present, we
will attempt to use the C<< REDIS_SERVER >> environment variable. If neither of
@@ -979,10 +1110,15 @@ those options are present, it defaults to '127.0.0.1:6379'.
Alternatively you can use the C<< sock >> parameter to specify the path of the
UNIX domain socket where the Redis server is listening.
+Alternatively you can use the C<< sentinels >> parameter and the C<< service >>
+parameter to specify a list of sentinels to contact and try to get the address
+of the given service name. C<< sentinels >> must be an ArrayRef and C<< service
+>> an Str.
+
The C<< REDIS_SERVER >> can be used for UNIX domain sockets too. The following
formats are supported:
-=over 4
+=over
=item *
@@ -1002,18 +1138,11 @@ tcp:127.0.0.1:11011
=back
-The C<< encoding >> parameter specifies the encoding we will use to decode all
-the data we receive and encode all the data sent to the redis server. Due to
-backwards-compatibility we default to C<< utf8 >>. To disable all this
-encoding/decoding, you must use C<< encoding => undef >>. B<< This is the
-recommended option >>.
-
-B<< Warning >>: this option has several problems and it is B<deprecated>. A
-future version might add other filtering options though.
+=head3 C<< reconnect >>, C<< every >>
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 >> microseconds (1 ms by
default), up-to C<< reconnect >> seconds.
Be aware that read errors will always thrown an exception, and will not trigger
@@ -1022,16 +1151,92 @@ a retry until the new command is sent.
If we cannot re-establish a connection after C<< reconnect >> seconds, an
exception will be thrown.
+=head3 C<< conservative_reconnect >>
+
+C<< conservative_reconnect >> option makes sure that reconnection is only attempted
+when no pending command is ongoing. For instance, if you're doing
+C<$redis->incr('key')>, and if the server properly understood and processed the
+command, but the network connection is dropped just before the server replies :
+the command has been processed but the client doesn't know it. In this
+situation, if reconnect is enabled, the Redis client will reconnect and send
+the C<incr> command *again*. If it succeeds, at the end the key as been
+incremented *two* times. To avoid this issue, you can set the C<conservative_reconnect>
+option to a true value. In this case, the client will reconnect only if no
+request is pending. Otherwise it will die with the message: C<reconnect
+disabled while responses are pending and safe reconnect mode enabled>.
+
+=head3 C<< cnx_timeout >>
+
+The C<< cnx_timeout >> option enables connection timeout. The Redis client will
+wait at most that number of seconds (can be fractional) before giving up
+connecting to a server.
+
+=head3 C<< sentinels_cnx_timeout >>
+
+The C<< sentinels_cnx_timeout >> option enables sentinel connection timeout.
+When using the sentinels feature, Redis client will wait at most that number of
+seconds (can be fractional) before giving up connecting to a sentinel.
+B<Default>: 0.1
+
+=head3 C<< read_timeout >>
+
+The C<< read_timeout >> option enables read timeout. The Redis client will wait
+at most that number of seconds (can be fractional) before giving up when
+reading from the server.
+
+=head3 C<< sentinels_read_timeout >>
+
+The C<< sentinels_read_timeout >> option enables sentinel read timeout. When
+using the sentinels feature, the Redis client will wait at most that number of
+seconds (can be fractional) before giving up when reading from a sentinel
+server. B<Default>: 1
+
+=head3 C<< write_timeout >>
+
+The C<< write_timeout >> option enables write timeout. The Redis client will wait
+at most that number of seconds (can be fractional) before giving up when
+reading from the server.
+
+=head3 C<< sentinels_write_timeout >>
+
+The C<< sentinels_write_timeout >> option enables sentinel write timeout. When
+using the sentinels feature, the Redis client will wait at most that number of
+seconds (can be fractional) before giving up when reading from a sentinel
+server. B<Default>: 1
+
+=head3 C<< password >>
+
If your Redis server requires authentication, you can use the C<< password >>
attribute. After each established connection (at the start or when
reconnecting), the Redis C<< AUTH >> command will be send to the server. If the
password is wrong, an exception will be thrown and reconnect will be disabled.
+=head3 C<< on_connect >>
+
You can also provide a code reference that will be immediately after each
successful connection. The C<< on_connect >> attribute is used to provide the
code reference, and it will be called with the first parameter being the Redis
object.
+=head3 C<< no_auto_connect_on_new >>
+
+You can also provide C<< no_auto_connect_on_new >> in which case C<<
+new >> won't call C<< $obj->connect >> for you implicitly, you'll have
+to do that yourself. This is useful for figuring out how long
+connection setup takes so you can configure the C<< cnx_timeout >>
+appropriately.
+
+=head3 C<< no_sentinels_list_update >>
+
+You can also provide C<< no_sentinels_list_update >>. By default (that is,
+without this option), when successfully contacting a sentinel server, the Redis
+client will ask it for the list of sentinels known for the given service, and
+merge it with its list of sentinels (in the C<< sentinels >> attribute). You
+can disable this behavior by setting C<< no_sentinels_list_update >> to a true
+value.
+
+=head3 C<< name >>
+
You can also set a name for each connection. This can be very useful for
debugging purposes, using the C<< CLIENT LIST >> command. To set a connection
name, use the C<< name >> parameter. You can use both a scalar value or a
@@ -1046,129 +1251,180 @@ details. This feature is safe to use with all versions of Redis servers. If C<<
CLIENT SETNAME >> support is not available (Redis servers 2.6.9 and above
only), the name parameter is ignored.
+=head3 C<< debug >>
+
The C<< debug >> parameter enables debug information to STDERR, including all
interactions with the server. You can also enable debug with the C<REDIS_DEBUG>
environment variable.
-=head2 Connection Handling
+=head1 CONNECTION HANDLING
-=head3 quit
+=head2 connect
+
+ $r->connect;
+
+Connects to the Redis server. This is done by default when the obect is
+constructed using C<new()>, unless C<no_auto_connect_on_new> has been set. See
+this option in the C<new()> constructor.
+
+=head2 quit
$r->quit;
Closes the connection to the server. The C<quit> method does not support
pipelined operation.
-=head3 ping
+=head2 ping
$r->ping || die "no server?";
The C<ping> method does not support pipelined operation.
-=head3 client_list
+=head1 PIPELINE MANAGEMENT
- @clients = $r->client_list;
+=head2 wait_all_responses
-Returns list of clients connected to the server. See L<< CLIENT LIST
-documentation|http://redis.io/commands/client-list >> for a description of the
-fields and their meaning.
+Waits until all pending pipelined responses have been received, and invokes the
+pipeline callback for each one. See L</PIPELINING>.
-=head3 client_getname
+=head2 wait_one_response
- my $connection_name = $r->client_getname;
+Waits until the first pending pipelined response has been received, and invokes
+its callback. See L</PIPELINING>.
-Returns the name associated with this connection. See L</client_setname> or the
-C<< name >> parameter to L</new> for ways to set this name.
+=head1 PUBLISH/SUBSCRIBE COMMANDS
-=head3 client_setname
+When one of L</subscribe> or L</psubscribe> is used, the Redis object will
+enter I<PubSub> mode. When in I<PubSub> mode only commands in this section,
+plus L</quit>, will be accepted.
- $r->client_setname('my_connection_name');
+If you plan on using PubSub and other Redis functions, you should use two Redis
+objects, one dedicated to PubSub and the other for regular commands.
-Sets this connection name. See the L<CLIENT SETNAME
-documentation|http://redis.io/commands/client-setname> for restrictions on the
-connection name string. The most important one: no spaces.
+All Pub/Sub commands receive a callback as the last parameter. This callback
+receives three arguments:
-=head2 Pipeline management
+=over
-=head3 wait_all_responses
+=item *
-Waits until all pending pipelined responses have been received, and invokes the
-pipeline callback for each one. See L</PIPELINING>.
+The published message.
-=head3 wait_one_response
+=item *
-Waits until the first pending pipelined response has been received, and invokes
-its callback. See L</PIPELINING>.
+The topic over which the message was sent.
-=head2 Transaction-handling commands
+=item *
-B<Warning:> the behaviour of these commands when combined with pipelining is
-still under discussion, and you should B<NOT> use them at the same time just
-now.
+The subscribed topic that matched the topic for the message. With L</subscribe>
+these last two are the same, always. But with L</psubscribe>, this parameter
+tells you the pattern that matched.
-You can L<follow the discussion to see the open issues with
-this|https://github.com/melo/perl-redis/issues/17>.
+=back
-=head3 multi
+See the L<Pub-Sub notes|http://redis.io/topics/pubsub> for more information
+about the messages you will receive on your callbacks after each L</subscribe>,
+L</unsubscribe>, L</psubscribe> and L</punsubscribe>.
- $r->multi;
+=head2 publish
-=head3 discard
+ $r->publish($topic, $message);
- $r->discard;
+Publishes the C<< $message >> to the C<< $topic >>.
-=head3 exec
+=head2 subscribe
- my @individual_replies = $r->exec;
+ $r->subscribe(
+ @topics_to_subscribe_to,
+ my $savecallback = sub {
+ my ($message, $topic, $subscribed_topic) = @_;
+ ...
+ },
+ );
-C<exec> has special behaviour when run in a pipeline: the C<$reply> argument to
-the pipeline callback is an array ref whose elements are themselves C<[$reply,
-$error]> pairs. This means that you can accurately detect errors yielded by
-any command in the transaction, and without any exceptions being thrown.
+Subscribe one or more topics. Messages published into one of them will be
+received by Redis, and the specified callback will be executed.
+
+=head2 unsubscribe
+
+ $r->unsubscribe(@topic_list, $savecallback);
+
+Stops receiving messages via C<$savecallback> for all the topics in
+C<@topic_list>. B<WARNING:> it is important that you give the same calleback
+that you used for subscribtion. The value of the CodeRef must be the same, as
+this is how internally the code identifies it.
+
+=head2 psubscribe
+
+ my @topic_matches = ('prefix1.*', 'prefix2.*');
+ $r->psubscribe(@topic_matches, my $savecallback = sub { my ($m, $t, $s) = @_; ... });
+
+Subscribes a pattern of topics. All messages to topics that match the pattern
+will be delivered to the callback.
-=head2 Commands operating on string values
+=head2 punsubscribe
-=head3 set
+ my @topic_matches = ('prefix1.*', 'prefix2.*');
+ $r->punsubscribe(@topic_matches, $savecallback);
- $r->set( foo => 'bar' );
+Stops receiving messages via C<$savecallback> for all the topics pattern
+matches in C<@topic_list>. B<WARNING:> it is important that you give the same
+calleback that you used for subscribtion. The value of the CodeRef must be the
+same, as this is how internally the code identifies it.
- $r->setnx( foo => 42 );
+=head2 is_subscriber
-=head3 get
+ if ($r->is_subscriber) { say "We are in Pub/Sub mode!" }
- my $value = $r->get( 'foo' );
+Returns true if we are in I<Pub/Sub> mode.
-=head3 mget
+=head2 wait_for_messages
- my @values = $r->mget( 'foo', 'bar', 'baz' );
+ my $keep_going = 1; ## Set to false somewhere to leave the loop
+ my $timeout = 5;
+ $r->wait_for_messages($timeout) while $keep_going;
-=head3 incr
+Blocks, waits for incoming messages and delivers them to the appropriate
+callbacks.
- $r->incr('counter');
+Requires a single parameter, the number of seconds to wait for messages. Use 0
+to wait for ever. If a positive non-zero value is used, it will return after
+that amount of seconds without a single notification.
- $r->incrby('tripplets', 3);
+Please note that the timeout is not a commitment to return control to the
+caller at most each C<timeout> seconds, but more a idle timeout, were control
+will return to the caller if Redis is idle (as in no messages were received
+during the timeout period) for more than C<timeout> seconds.
-=head3 decr
+The L</wait_for_messages> call returns the number of messages processed during
+the run.
- $r->decr('counter');
+=head1 IMPORTANT NOTES ON METHODS
- $r->decrby('tripplets', 3);
+=head2 methods that return multiple values
-=head3 exists
+When a method returns more than one value, it checks the context and returns
+either a list of values or an ArrayRef.
- $r->exists( 'key' ) && print "got key!";
+=head2 transaction-handling methods
-=head3 del
+B<Warning:> the behaviour of the TRANSACTIONS commands when combined with
+pipelining is still under discussion, and you should B<NOT> use them at the
+same time just now.
- $r->del( 'key' ) || warn "key doesn't exist";
+You can L<follow the discussion to see the open issues with
+this|https://github.com/PerlRedis/perl-redis/issues/17>.
-=head3 type
+=head2 exec
- $r->type( 'key' ); # = string
+ my @individual_replies = $r->exec;
-=head2 Commands operating on the key space
+C<exec> has special behaviour when run in a pipeline: the C<$reply> argument to
+the pipeline callback is an array ref whose elements are themselves C<[$reply,
+$error]> pairs. This means that you can accurately detect errors yielded by
+any command in the transaction, and without any exceptions being thrown.
-=head3 keys
+=head2 keys
my @keys = $r->keys( '*glob_pattern*' );
my $keys = $r->keys( '*glob_pattern*' ); # count of matching keys
@@ -1178,447 +1434,1043 @@ matching keys (not an array ref of matching keys as you might expect). This
does not apply in pipelined mode: assuming the server returns a list of keys,
as expected, it is always passed to the pipeline callback as an array ref.
-=head3 randomkey
+=head2 hashes
- my $key = $r->randomkey;
+Hashes in Redis cannot be nested as in perl, if you want to store a nested
+hash, you need to serialize the hash first. If you want to have a named
+hash, you can use Redis-hashes. You will find an example in the tests
+of this module t/01-basic.t
-=head3 rename
+=head2 eval
- my $ok = $r->rename( 'old-key', 'new-key', $new );
+Note that this commands sends the Lua script every time you call it. See
+L</evalsha> and L</script_load> for an alternative.
-=head3 dbsize
+=head2 info
- my $nr_keys = $r->dbsize;
+ my $info_hash = $r->info;
-=head2 Commands operating on lists
+The C<info> method is unique in that it decodes the server's response into a
+hashref, if possible. This decoding happens in both synchronous and pipelined
+modes.
-See also L<Redis::List> for tie interface.
+=head1 KEYS
-=head3 rpush
+=head2 del
- $r->rpush( $key, $value );
+ $r->del(key [key ...])
-=head3 lpush
+Delete a key (see L<http://redis.io/commands/del>)
- $r->lpush( $key, $value );
+=head2 dump
-=head3 llen
+ $r->dump(key)
- $r->llen( $key );
+Return a serialized version of the value stored at the specified key. (see L<http://redis.io/commands/dump>)
-=head3 lrange
+=head2 exists
- my @list = $r->lrange( $key, $start, $end );
+ $r->exists(key)
-=head3 ltrim
+Determine if a key exists (see L<http://redis.io/commands/exists>)
- my $ok = $r->ltrim( $key, $start, $end );
+=head2 expire
-=head3 lindex
+ $r->expire(key, seconds)
- $r->lindex( $key, $index );
+Set a key's time to live in seconds (see L<http://redis.io/commands/expire>)
-=head3 lset
+=head2 expireat
- $r->lset( $key, $index, $value );
+ $r->expireat(key, timestamp)
-=head3 lrem
+Set the expiration for a key as a UNIX timestamp (see L<http://redis.io/commands/expireat>)
- my $modified_count = $r->lrem( $key, $count, $value );
+=head2 keys
-=head3 lpop
+ $r->keys(pattern)
- my $value = $r->lpop( $key );
+Find all keys matching the given pattern (see L<http://redis.io/commands/keys>)
-=head3 rpop
+=head2 migrate
- my $value = $r->rpop( $key );
+ $r->migrate(host, port, key, destination-db, timeout, [COPY], [REPLACE])
-=head2 Commands operating on sets
+Atomically transfer a key from a Redis instance to another one. (see L<http://redis.io/commands/migrate>)
-=head3 sadd
+=head2 move
- my $ok = $r->sadd( $key, $member );
+ $r->move(key, db)
-=head3 scard
+Move a key to another database (see L<http://redis.io/commands/move>)
- my $n_elements = $r->scard( $key );
+=head2 object
-=head3 sdiff
+ $r->object(subcommand, [arguments [arguments ...]])
- my @elements = $r->sdiff( $key1, $key2, ... );
- my $elements = $r->sdiff( $key1, $key2, ... ); # ARRAY ref
+Inspect the internals of Redis objects (see L<http://redis.io/commands/object>)
-=head3 sdiffstore
+=head2 persist
- my $ok = $r->sdiffstore( $dstkey, $key1, $key2, ... );
+ $r->persist(key)
-=head3 sinter
+Remove the expiration from a key (see L<http://redis.io/commands/persist>)
- my @elements = $r->sinter( $key1, $key2, ... );
- my $elements = $r->sinter( $key1, $key2, ... ); # ARRAY ref
+=head2 pexpire
-=head3 sinterstore
+ $r->pexpire(key, milliseconds)
- my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );
+Set a key's time to live in milliseconds (see L<http://redis.io/commands/pexpire>)
-=head3 sismember
+=head2 pexpireat
- my $bool = $r->sismember( $key, $member );
+ $r->pexpireat(key, milliseconds-timestamp)
-=head3 smembers
+Set the expiration for a key as a UNIX timestamp specified in milliseconds (see L<http://redis.io/commands/pexpireat>)
- my @elements = $r->smembers( $key );
- my $elements = $r->smembers( $key ); # ARRAY ref
+=head2 pttl
-=head3 smove
+ $r->pttl(key)
- my $ok = $r->smove( $srckey, $dstkey, $element );
+Get the time to live for a key in milliseconds (see L<http://redis.io/commands/pttl>)
-=head3 spop
+=head2 randomkey
- my $element = $r->spop( $key );
+ $r->randomkey()
-=head3 srandmemeber
+Return a random key from the keyspace (see L<http://redis.io/commands/randomkey>)
- my $element = $r->srandmember( $key );
+=head2 rename
-=head3 srem
+ $r->rename(key, newkey)
- $r->srem( $key, $member );
+Rename a key (see L<http://redis.io/commands/rename>)
-=head3 sunion
+=head2 renamenx
- my @elements = $r->sunion( $key1, $key2, ... );
- my $elements = $r->sunion( $key1, $key2, ... ); # ARRAY ref
+ $r->renamenx(key, newkey)
-=head3 sunionstore
+Rename a key, only if the new key does not exist (see L<http://redis.io/commands/renamenx>)
- my $ok = $r->sunionstore( $dstkey, $key1, $key2, ... );
+=head2 restore
-=head2 Commands operating on hashes
+ $r->restore(key, ttl, serialized-value)
-Hashes in Redis cannot be nested as in perl, if you want to store a nested
-hash, you need to serialize the hash first. If you want to have a named
-hash, you can use Redis-hashes. You will find an example in the tests
-of this module t/01-basic.t
+Create a key using the provided serialized value, previously obtained using DUMP. (see L<http://redis.io/commands/restore>)
-=head3 hset
+=head2 scan
-Sets the value to a key in a hash.
- $r->hset('hashname', $key => $value); ## returns true on success
+ $r->scan(cursor, [MATCH pattern], [COUNT count])
-=head3 hget
+Incrementally iterate the keys space (see L<http://redis.io/commands/scan>)
-Gets the value to a key in a hash.
+=head2 sort
- my $value = $r->hget('hashname', $key);
+ $r->sort(key, [BY pattern], [LIMIT offset count], [GET pattern [GET pattern ...]], [ASC|DESC], [ALPHA], [STORE destination])
-=head3 hexists
+Sort the elements in a list, set or sorted set (see L<http://redis.io/commands/sort>)
- if($r->hexists('hashname', $key) {
- ## do something, the key exists
- }
- else {
- ## the key does not exist
- }
+=head2 ttl
-=head3 hdel
+ $r->ttl(key)
-Deletes a key from a hash
- if($r->hdel('hashname', $key)) {
- ## key is deleted
- }
- else {
- ## oops
- }
+Get the time to live for a key (see L<http://redis.io/commands/ttl>)
-=head3 hincrby
+=head2 type
-Adds an integer to a value. The integer is signed, so a negative integer decrements.
+ $r->type(key)
- my $key = 'testkey';
- $r->hset('hashname', $key => 1); ## value -> 1
- my $increment = 1; ## has to be an integer
- $r->hincrby('hashname', $key => $increment); ## value -> 2
- $increment = 5;
- $r->hincrby('hashname', $key => $increment); ## value -> 7
- $increment = -1;
- $r->hincrby('hashname', $key => $increment); ## value -> 6
+Determine the type stored at key (see L<http://redis.io/commands/type>)
-=head3 hsetnx
+=head1 STRINGS
-Adds a key to a hash unless it is not already set.
+=head2 append
- my $key = 'testnx';
- $r->hsetnx('hashname', $key => 1); ## returns true
- $r->hsetnx('hashname', $key => 2); ## returns false because key already exists
+ $r->append(key, value)
-=head3 hmset
+Append a value to a key (see L<http://redis.io/commands/append>)
-Adds multiple keys to a hash.
+=head2 bitcount
- $r->hmset('hashname', 'key1' => 'value1', 'key2' => 'value2'); ## returns true on success
+ $r->bitcount(key, [start end])
-=head3 hmget
+Count set bits in a string (see L<http://redis.io/commands/bitcount>)
-Returns multiple keys of a hash.
+=head2 bitop
- my @values = $r->hmget('hashname', 'key1', 'key2');
+ $r->bitop(operation, destkey, key [key ...])
-=head3 hgetall
+Perform bitwise operations between strings (see L<http://redis.io/commands/bitop>)
-Returns the whole hash.
+=head2 bitpos
- my %hash = $r->hgetall('hashname');
+ $r->bitpos(key, bit, [start], [end])
-=head3 hkeys
+Find first bit set or clear in a string (see L<http://redis.io/commands/bitpos>)
-Returns the keys of a hash.
+=head2 blpop
- my @keys = $r->hkeys('hashname');
+ $r->blpop(key [key ...], timeout)
-=head3 hvals
+Remove and get the first element in a list, or block until one is available (see L<http://redis.io/commands/blpop>)
-Returns the values of a hash.
+=head2 brpop
- my @values = $r->hvals('hashname');
+ $r->brpop(key [key ...], timeout)
-=head3 hlen
+Remove and get the last element in a list, or block until one is available (see L<http://redis.io/commands/brpop>)
-Returns the count of keys in a hash.
+=head2 brpoplpush
- my $keycount = $r->hlen('hashname');
+ $r->brpoplpush(source, destination, timeout)
-=head2 Sorting
+Pop a value from a list, push it to another list and return it; or block until one is available (see L<http://redis.io/commands/brpoplpush>)
-=head3 sort
+=head2 decr
- $r->sort("key BY pattern LIMIT start end GET pattern ASC|DESC ALPHA');
+ $r->decr(key)
-=head2 Publish/Subscribe commands
+Decrement the integer value of a key by one (see L<http://redis.io/commands/decr>)
-When one of L</subscribe> or L</psubscribe> is used, the Redis object will
-enter I<PubSub> mode. When in I<PubSub> mode only commands in this section,
-plus L</quit>, will be accepted.
+=head2 decrby
-If you plan on using PubSub and other Redis functions, you should use two Redis
-objects, one dedicated to PubSub and the other for regular commands.
+ $r->decrby(key, decrement)
-All Pub/Sub commands receive a callback as the last parameter. This callback
-receives three arguments:
+Decrement the integer value of a key by the given number (see L<http://redis.io/commands/decrby>)
-=over 4
+=head2 get
-=item *
+ $r->get(key)
-The published message.
+Get the value of a key (see L<http://redis.io/commands/get>)
-=item *
+=head2 getbit
-The topic over which the message was sent.
+ $r->getbit(key, offset)
-=item *
+Returns the bit value at offset in the string value stored at key (see L<http://redis.io/commands/getbit>)
-The subscribed topic that matched the topic for the message. With L</subscribe>
-these last two are the same, always. But with L</psubscribe>, this parameter
-tells you the pattern that matched.
+=head2 getrange
-=back
+ $r->getrange(key, start, end)
-See the L<Pub/Sub notes|http://redis.io/topics/pubsub> for more information
-about the messages you will receive on your callbacks after each L</subscribe>,
-L</unsubscribe>, L</psubscribe> and L</punsubscribe>.
+Get a substring of the string stored at a key (see L<http://redis.io/commands/getrange>)
-=head3 publish
+=head2 getset
- $r->publish($topic, $message);
+ $r->getset(key, value)
-Publishes the C<< $message >> to the C<< $topic >>.
+Set the string value of a key and return its old value (see L<http://redis.io/commands/getset>)
-=head3 subscribe
+=head2 incr
- $r->subscribe(
- @topics_to_subscribe_to,
- sub {
- my ($message, $topic, $subscribed_topic) = @_;
- ...
- },
- );
+ $r->incr(key)
-Subscribe one or more topics. Messages published into one of them will be
-received by Redis, and the specified callback will be executed.
+Increment the integer value of a key by one (see L<http://redis.io/commands/incr>)
-=head3 unsubscribe
+=head2 incrby
- $r->unsubscribe(@topic_list, sub { my ($m, $t, $s) = @_; ... });
+ $r->incrby(key, increment)
-Stops receiving messages for all the topics in C<@topic_list>.
+Increment the integer value of a key by the given amount (see L<http://redis.io/commands/incrby>)
-=head3 psubscribe
+=head2 incrbyfloat
- my @topic_matches = ('prefix1.*', 'prefix2.*');
- $r->psubscribe(@topic_matches, sub { my ($m, $t, $s) = @_; ... });
+ $r->incrbyfloat(key, increment)
-Subscribes a pattern of topics. All messages to topics that match the pattern
-will be delivered to the callback.
+Increment the float value of a key by the given amount (see L<http://redis.io/commands/incrbyfloat>)
-=head3 punsubscribe
+=head2 mget
- my @topic_matches = ('prefix1.*', 'prefix2.*');
- $r->punsubscribe(@topic_matches, sub { my ($m, $t, $s) = @_; ... });
+ $r->mget(key [key ...])
-Stops receiving messages for all the topics pattern matches in C<@topic_list>.
+Get the values of all the given keys (see L<http://redis.io/commands/mget>)
-=head3 is_subscriber
+=head2 mset
- if ($r->is_subscriber) { say "We are in Pub/Sub mode!" }
+ $r->mset(key value [key value ...])
-Returns true if we are in I<Pub/Sub> mode.
+Set multiple keys to multiple values (see L<http://redis.io/commands/mset>)
-=head3 wait_for_messages
+=head2 msetnx
- my $keep_going = 1; ## Set to false somewhere to leave the loop
- my $timeout = 5;
- $r->wait_for_messages($timeout) while $keep_going;
+ $r->msetnx(key value [key value ...])
-Blocks, waits for incoming messages and delivers them to the appropriate
-callbacks.
+Set multiple keys to multiple values, only if none of the keys exist (see L<http://redis.io/commands/msetnx>)
-Requires a single parameter, the number of seconds to wait for messages. Use 0
-to wait for ever. If a positive non-zero value is used, it will return after
-that amount of seconds without a single notification.
+=head2 psetex
-Please note that the timeout is not a commitment to return control to the
-caller at most each C<timeout> seconds, but more a idle timeout, were control
-will return to the caller if Redis is idle (as in no messages were received
-during the timeout period) for more than C<timeout> seconds.
+ $r->psetex(key, milliseconds, value)
-The L</wait_for_messages> call returns the number of messages processed during
-the run.
+Set the value and expiration in milliseconds of a key (see L<http://redis.io/commands/psetex>)
-=head2 Persistence control commands
+=head2 set
-=head3 save
+ $r->set(key, value, [EX seconds], [PX milliseconds], [NX|XX])
- $r->save;
+Set the string value of a key (see L<http://redis.io/commands/set>)
-=head3 bgsave
+=head2 setbit
- $r->bgsave;
+ $r->setbit(key, offset, value)
-=head3 lastsave
+Sets or clears the bit at offset in the string value stored at key (see L<http://redis.io/commands/setbit>)
- $r->lastsave;
+=head2 setex
-=head2 Scripting commands
+ $r->setex(key, seconds, value)
-=head3 eval
+Set the value and expiration of a key (see L<http://redis.io/commands/setex>)
- $r->eval($lua_script, $num_keys, $key1, ..., $arg1, $arg2);
+=head2 setnx
-Executes a Lua script server side.
+ $r->setnx(key, value)
-Note that this commands sends the Lua script every time you call it. See
-L</evalsha> and L</script_load> for an alternative.
+Set the value of a key, only if the key does not exist (see L<http://redis.io/commands/setnx>)
-=head3 evalsha
+=head2 setrange
- $r->eval($lua_script_sha1, $num_keys, $key1, ..., $arg1, $arg2);
+ $r->setrange(key, offset, value)
-Executes a Lua script cached on the server side by its SHA1 digest.
+Overwrite part of a string at key starting at the specified offset (see L<http://redis.io/commands/setrange>)
-See L</script_load>.
+=head2 strlen
-=head3 script_load
+ $r->strlen(key)
- my ($sha1) = $r->script_load($lua_script);
+Get the length of the value stored in a key (see L<http://redis.io/commands/strlen>)
-Cache Lua script, returns SHA1 digest that can be used with L</evalsha>.
+=head1 HASHES
-=head3 script_exists
+=head2 hdel
- my ($exists1, $exists2, ...) = $r->script_exists($scrip1_sha, $script2_sha, ...);
+ $r->hdel(key, field [field ...])
-Given a list of SHA1 digests, returns a list of booleans, one for each SHA1,
-that report the existence of each script in the server cache.
+Delete one or more hash fields (see L<http://redis.io/commands/hdel>)
-=head3 script_kill
+=head2 hexists
- $r->script_kill;
+ $r->hexists(key, field)
-Kills the currently running script.
+Determine if a hash field exists (see L<http://redis.io/commands/hexists>)
-=head3 script_flush
+=head2 hget
- $r->script_flush;
+ $r->hget(key, field)
-Flush the Lua scripts cache.
+Get the value of a hash field (see L<http://redis.io/commands/hget>)
-=head2 Remote server control commands
+=head2 hgetall
-=head3 info
+ $r->hgetall(key)
- my $info_hash = $r->info;
+Get all the fields and values in a hash (see L<http://redis.io/commands/hgetall>)
-The C<info> method is unique in that it decodes the server's response into a
-hashref, if possible. This decoding happens in both synchronous and pipelined
-modes.
+=head2 hincrby
-=head3 shutdown
+ $r->hincrby(key, field, increment)
- $r->shutdown;
+Increment the integer value of a hash field by the given number (see L<http://redis.io/commands/hincrby>)
-The C<shutdown> method does not support pipelined operation.
+=head2 hincrbyfloat
-=head3 slowlog
+ $r->hincrbyfloat(key, field, increment)
- my $nr_items = $r->slowlog("len");
- my @last_ten_items = $r->slowlog("get", 10);
+Increment the float value of a hash field by the given amount (see L<http://redis.io/commands/hincrbyfloat>)
-The C<slowlog> command gives access to the server's slow log.
+=head2 hkeys
-=head2 Multiple databases handling commands
+ $r->hkeys(key)
-=head3 select
+Get all the fields in a hash (see L<http://redis.io/commands/hkeys>)
- $r->select( $dbindex ); # 0 for new clients
+=head2 hlen
-=head3 move
+ $r->hlen(key)
- $r->move( $key, $dbindex );
+Get the number of fields in a hash (see L<http://redis.io/commands/hlen>)
-=head3 flushdb
+=head2 hmget
- $r->flushdb;
+ $r->hmget(key, field [field ...])
-=head3 flushall
+Get the values of all the given hash fields (see L<http://redis.io/commands/hmget>)
- $r->flushall;
+=head2 hmset
-=head1 ACKNOWLEDGEMENTS
+ $r->hmset(key, field value [field value ...])
-The following persons contributed to this project (alphabetical order):
+Set multiple hash fields to multiple values (see L<http://redis.io/commands/hmset>)
-=over 4
+=head2 hscan
-=item *
+ $r->hscan(key, cursor, [MATCH pattern], [COUNT count])
-Aaron Crane (pipelining and AUTOLOAD caching support)
+Incrementally iterate hash fields and associated values (see L<http://redis.io/commands/hscan>)
-=item *
+=head2 hset
-Dirk Vleugels
+ $r->hset(key, field, value)
-=item *
+Set the string value of a hash field (see L<http://redis.io/commands/hset>)
-Flavio Poletti
+=head2 hsetnx
-=item *
+ $r->hsetnx(key, field, value)
-Jeremy Zawodny
+Set the value of a hash field, only if the field does not exist (see L<http://redis.io/commands/hsetnx>)
-=item *
+=head2 hvals
+
+ $r->hvals(key)
+
+Get all the values in a hash (see L<http://redis.io/commands/hvals>)
+
+=head1 SETS
+
+=head2 sadd
+
+ $r->sadd(key, member [member ...])
+
+Add one or more members to a set (see L<http://redis.io/commands/sadd>)
+
+=head2 scard
+
+ $r->scard(key)
+
+Get the number of members in a set (see L<http://redis.io/commands/scard>)
+
+=head2 sdiff
+
+ $r->sdiff(key [key ...])
+
+Subtract multiple sets (see L<http://redis.io/commands/sdiff>)
+
+=head2 sdiffstore
+
+ $r->sdiffstore(destination, key [key ...])
+
+Subtract multiple sets and store the resulting set in a key (see L<http://redis.io/commands/sdiffstore>)
+
+=head2 sinter
+
+ $r->sinter(key [key ...])
+
+Intersect multiple sets (see L<http://redis.io/commands/sinter>)
+
+=head2 sinterstore
+
+ $r->sinterstore(destination, key [key ...])
+
+Intersect multiple sets and store the resulting set in a key (see L<http://redis.io/commands/sinterstore>)
+
+=head2 sismember
+
+ $r->sismember(key, member)
+
+Determine if a given value is a member of a set (see L<http://redis.io/commands/sismember>)
+
+=head2 smembers
+
+ $r->smembers(key)
+
+Get all the members in a set (see L<http://redis.io/commands/smembers>)
+
+=head2 smove
+
+ $r->smove(source, destination, member)
+
+Move a member from one set to another (see L<http://redis.io/commands/smove>)
+
+=head2 spop
+
+ $r->spop(key)
+
+Remove and return a random member from a set (see L<http://redis.io/commands/spop>)
+
+=head2 srandmember
+
+ $r->srandmember(key, [count])
+
+Get one or multiple random members from a set (see L<http://redis.io/commands/srandmember>)
+
+=head2 srem
+
+ $r->srem(key, member [member ...])
+
+Remove one or more members from a set (see L<http://redis.io/commands/srem>)
+
+=head2 sscan
+
+ $r->sscan(key, cursor, [MATCH pattern], [COUNT count])
+
+Incrementally iterate Set elements (see L<http://redis.io/commands/sscan>)
+
+=head2 sunion
+
+ $r->sunion(key [key ...])
+
+Add multiple sets (see L<http://redis.io/commands/sunion>)
+
+=head2 sunionstore
+
+ $r->sunionstore(destination, key [key ...])
+
+Add multiple sets and store the resulting set in a key (see L<http://redis.io/commands/sunionstore>)
+
+=head1 SORTED SETS
+
+=head2 zadd
+
+ $r->zadd(key, score member [score member ...])
+
+Add one or more members to a sorted set, or update its score if it already exists (see L<http://redis.io/commands/zadd>)
+
+=head2 zcard
+
+ $r->zcard(key)
+
+Get the number of members in a sorted set (see L<http://redis.io/commands/zcard>)
+
+=head2 zcount
+
+ $r->zcount(key, min, max)
+
+Count the members in a sorted set with scores within the given values (see L<http://redis.io/commands/zcount>)
+
+=head2 zincrby
+
+ $r->zincrby(key, increment, member)
+
+Increment the score of a member in a sorted set (see L<http://redis.io/commands/zincrby>)
+
+=head2 zinterstore
+
+ $r->zinterstore(destination, numkeys, key [key ...], [WEIGHTS weight [weight ...]], [AGGREGATE SUM|MIN|MAX])
+
+Intersect multiple sorted sets and store the resulting sorted set in a new key (see L<http://redis.io/commands/zinterstore>)
+
+=head2 zlexcount
+
+ $r->zlexcount(key, min, max)
+
+Count the number of members in a sorted set between a given lexicographical range (see L<http://redis.io/commands/zlexcount>)
+
+=head2 zrange
+
+ $r->zrange(key, start, stop, [WITHSCORES])
+
+Return a range of members in a sorted set, by index (see L<http://redis.io/commands/zrange>)
+
+=head2 zrangebylex
+
+ $r->zrangebylex(key, min, max, [LIMIT offset count])
+
+Return a range of members in a sorted set, by lexicographical range (see L<http://redis.io/commands/zrangebylex>)
+
+=head2 zrangebyscore
+
+ $r->zrangebyscore(key, min, max, [WITHSCORES], [LIMIT offset count])
+
+Return a range of members in a sorted set, by score (see L<http://redis.io/commands/zrangebyscore>)
+
+=head2 zrank
+
+ $r->zrank(key, member)
+
+Determine the index of a member in a sorted set (see L<http://redis.io/commands/zrank>)
+
+=head2 zrem
+
+ $r->zrem(key, member [member ...])
+
+Remove one or more members from a sorted set (see L<http://redis.io/commands/zrem>)
+
+=head2 zremrangebylex
+
+ $r->zremrangebylex(key, min, max)
+
+Remove all members in a sorted set between the given lexicographical range (see L<http://redis.io/commands/zremrangebylex>)
+
+=head2 zremrangebyrank
+
+ $r->zremrangebyrank(key, start, stop)
+
+Remove all members in a sorted set within the given indexes (see L<http://redis.io/commands/zremrangebyrank>)
+
+=head2 zremrangebyscore
+
+ $r->zremrangebyscore(key, min, max)
+
+Remove all members in a sorted set within the given scores (see L<http://redis.io/commands/zremrangebyscore>)
+
+=head2 zrevrange
+
+ $r->zrevrange(key, start, stop, [WITHSCORES])
+
+Return a range of members in a sorted set, by index, with scores ordered from high to low (see L<http://redis.io/commands/zrevrange>)
+
+=head2 zrevrangebylex
+
+ $r->zrevrangebylex(key, max, min, [LIMIT offset count])
+
+Return a range of members in a sorted set, by lexicographical range, ordered from higher to lower strings. (see L<http://redis.io/commands/zrevrangebylex>)
+
+=head2 zrevrangebyscore
+
+ $r->zrevrangebyscore(key, max, min, [WITHSCORES], [LIMIT offset count])
+
+Return a range of members in a sorted set, by score, with scores ordered from high to low (see L<http://redis.io/commands/zrevrangebyscore>)
+
+=head2 zrevrank
+
+ $r->zrevrank(key, member)
+
+Determine the index of a member in a sorted set, with scores ordered from high to low (see L<http://redis.io/commands/zrevrank>)
+
+=head2 zscan
+
+ $r->zscan(key, cursor, [MATCH pattern], [COUNT count])
+
+Incrementally iterate sorted sets elements and associated scores (see L<http://redis.io/commands/zscan>)
+
+=head2 zscore
+
+ $r->zscore(key, member)
+
+Get the score associated with the given member in a sorted set (see L<http://redis.io/commands/zscore>)
+
+=head2 zunionstore
+
+ $r->zunionstore(destination, numkeys, key [key ...], [WEIGHTS weight [weight ...]], [AGGREGATE SUM|MIN|MAX])
+
+Add multiple sorted sets and store the resulting sorted set in a new key (see L<http://redis.io/commands/zunionstore>)
+
+=head1 HYPERLOGLOG
+
+=head2 pfadd
+
+ $r->pfadd(key, element [element ...])
+
+Adds the specified elements to the specified HyperLogLog. (see L<http://redis.io/commands/pfadd>)
+
+=head2 pfcount
+
+ $r->pfcount(key [key ...])
+
+Return the approximated cardinality of the set(s) observed by the HyperLogLog at key(s). (see L<http://redis.io/commands/pfcount>)
+
+=head2 pfmerge
+
+ $r->pfmerge(destkey, sourcekey [sourcekey ...])
+
+Merge N different HyperLogLogs into a single one. (see L<http://redis.io/commands/pfmerge>)
+
+=head1 PUB/SUB
+
+=head2 pubsub
+
+ $r->pubsub(subcommand, [argument [argument ...]])
+
+Inspect the state of the Pub/Sub subsystem (see L<http://redis.io/commands/pubsub>)
+
+=head1 TRANSACTIONS
+
+=head2 discard
+
+ $r->discard()
+
+Discard all commands issued after MULTI (see L<http://redis.io/commands/discard>)
+
+=head2 exec
+
+ $r->exec()
+
+Execute all commands issued after MULTI (see L<http://redis.io/commands/exec>)
+
+=head2 multi
+
+ $r->multi()
+
+Mark the start of a transaction block (see L<http://redis.io/commands/multi>)
+
+=head2 unwatch
+
+ $r->unwatch()
+
+Forget about all watched keys (see L<http://redis.io/commands/unwatch>)
+
+=head2 watch
+
+ $r->watch(key [key ...])
+
+Watch the given keys to determine execution of the MULTI/EXEC block (see L<http://redis.io/commands/watch>)
+
+=head1 SCRIPTING
+
+=head2 eval
+
+ $r->eval(script, numkeys, key [key ...], arg [arg ...])
+
+Execute a Lua script server side (see L<http://redis.io/commands/eval>)
+
+=head2 evalsha
+
+ $r->evalsha(sha1, numkeys, key [key ...], arg [arg ...])
+
+Execute a Lua script server side (see L<http://redis.io/commands/evalsha>)
+
+=head2 script_exists
+
+ $r->script_exists(script [script ...])
+
+Check existence of scripts in the script cache. (see L<http://redis.io/commands/script-exists>)
+
+=head2 script_flush
+
+ $r->script_flush()
+
+Remove all the scripts from the script cache. (see L<http://redis.io/commands/script-flush>)
+
+=head2 script_kill
+
+ $r->script_kill()
+
+Kill the script currently in execution. (see L<http://redis.io/commands/script-kill>)
+
+=head2 script_load
+
+ $r->script_load(script)
+
+Load the specified Lua script into the script cache. (see L<http://redis.io/commands/script-load>)
+
+=head1 CONNECTION
+
+=head2 auth
+
+ $r->auth(password)
+
+Authenticate to the server (see L<http://redis.io/commands/auth>)
+
+=head2 echo
+
+ $r->echo(message)
+
+Echo the given string (see L<http://redis.io/commands/echo>)
+
+=head2 ping
+
+ $r->ping()
+
+Ping the server (see L<http://redis.io/commands/ping>)
+
+=head2 quit
+
+ $r->quit()
+
+Close the connection (see L<http://redis.io/commands/quit>)
+
+=head2 select
+
+ $r->select(index)
+
+Change the selected database for the current connection (see L<http://redis.io/commands/select>)
+
+=head1 SERVER
+
+=head2 bgrewriteaof
+
+ $r->bgrewriteaof()
+
+Asynchronously rewrite the append-only file (see L<http://redis.io/commands/bgrewriteaof>)
+
+=head2 bgsave
+
+ $r->bgsave()
+
+Asynchronously save the dataset to disk (see L<http://redis.io/commands/bgsave>)
+
+=head2 client_getname
+
+ $r->client_getname()
+
+Get the current connection name (see L<http://redis.io/commands/client-getname>)
+
+=head2 client_kill
+
+ $r->client_kill([ip:port], [ID client-id], [TYPE normal|slave|pubsub], [ADDR ip:port], [SKIPME yes/no])
+
+Kill the connection of a client (see L<http://redis.io/commands/client-kill>)
+
+=head2 client_list
+
+ $r->client_list()
+
+Get the list of client connections (see L<http://redis.io/commands/client-list>)
+
+=head2 client_pause
+
+ $r->client_pause(timeout)
+
+Stop processing commands from clients for some time (see L<http://redis.io/commands/client-pause>)
+
+=head2 client_setname
+
+ $r->client_setname(connection-name)
+
+Set the current connection name (see L<http://redis.io/commands/client-setname>)
+
+=head2 cluster_slots
+
+ $r->cluster_slots()
+
+Get array of Cluster slot to node mappings (see L<http://redis.io/commands/cluster-slots>)
+
+=head2 command
+
+ $r->command()
+
+Get array of Redis command details (see L<http://redis.io/commands/command>)
+
+=head2 command_count
+
+ $r->command_count()
+
+Get total number of Redis commands (see L<http://redis.io/commands/command-count>)
+
+=head2 command_getkeys
+
+ $r->command_getkeys()
+
+Extract keys given a full Redis command (see L<http://redis.io/commands/command-getkeys>)
+
+=head2 command_info
+
+ $r->command_info(command-name [command-name ...])
+
+Get array of specific Redis command details (see L<http://redis.io/commands/command-info>)
+
+=head2 config_get
+
+ $r->config_get(parameter)
+
+Get the value of a configuration parameter (see L<http://redis.io/commands/config-get>)
+
+=head2 config_resetstat
+
+ $r->config_resetstat()
+
+Reset the stats returned by INFO (see L<http://redis.io/commands/config-resetstat>)
+
+=head2 config_rewrite
+
+ $r->config_rewrite()
+
+Rewrite the configuration file with the in memory configuration (see L<http://redis.io/commands/config-rewrite>)
+
+=head2 config_set
+
+ $r->config_set(parameter, value)
+
+Set a configuration parameter to the given value (see L<http://redis.io/commands/config-set>)
+
+=head2 dbsize
+
+ $r->dbsize()
+
+Return the number of keys in the selected database (see L<http://redis.io/commands/dbsize>)
+
+=head2 debug_object
+
+ $r->debug_object(key)
+
+Get debugging information about a key (see L<http://redis.io/commands/debug-object>)
+
+=head2 debug_segfault
+
+ $r->debug_segfault()
+
+Make the server crash (see L<http://redis.io/commands/debug-segfault>)
+
+=head2 flushall
+
+ $r->flushall()
+
+Remove all keys from all databases (see L<http://redis.io/commands/flushall>)
+
+=head2 flushdb
+
+ $r->flushdb()
+
+Remove all keys from the current database (see L<http://redis.io/commands/flushdb>)
+
+=head2 info
+
+ $r->info([section])
+
+Get information and statistics about the server (see L<http://redis.io/commands/info>)
+
+=head2 lastsave
+
+ $r->lastsave()
+
+Get the UNIX time stamp of the last successful save to disk (see L<http://redis.io/commands/lastsave>)
+
+=head2 lindex
+
+ $r->lindex(key, index)
+
+Get an element from a list by its index (see L<http://redis.io/commands/lindex>)
+
+=head2 linsert
+
+ $r->linsert(key, BEFORE|AFTER, pivot, value)
+
+Insert an element before or after another element in a list (see L<http://redis.io/commands/linsert>)
+
+=head2 llen
+
+ $r->llen(key)
+
+Get the length of a list (see L<http://redis.io/commands/llen>)
+
+=head2 lpop
+
+ $r->lpop(key)
+
+Remove and get the first element in a list (see L<http://redis.io/commands/lpop>)
+
+=head2 lpush
+
+ $r->lpush(key, value [value ...])
+
+Prepend one or multiple values to a list (see L<http://redis.io/commands/lpush>)
+
+=head2 lpushx
+
+ $r->lpushx(key, value)
+
+Prepend a value to a list, only if the list exists (see L<http://redis.io/commands/lpushx>)
+
+=head2 lrange
+
+ $r->lrange(key, start, stop)
+
+Get a range of elements from a list (see L<http://redis.io/commands/lrange>)
+
+=head2 lrem
+
+ $r->lrem(key, count, value)
+
+Remove elements from a list (see L<http://redis.io/commands/lrem>)
+
+=head2 lset
+
+ $r->lset(key, index, value)
+
+Set the value of an element in a list by its index (see L<http://redis.io/commands/lset>)
+
+=head2 ltrim
+
+ $r->ltrim(key, start, stop)
+
+Trim a list to the specified range (see L<http://redis.io/commands/ltrim>)
+
+=head2 monitor
+
+ $r->monitor()
+
+Listen for all requests received by the server in real time (see L<http://redis.io/commands/monitor>)
+
+=head2 role
+
+ $r->role()
+
+Return the role of the instance in the context of replication (see L<http://redis.io/commands/role>)
+
+=head2 rpop
+
+ $r->rpop(key)
+
+Remove and get the last element in a list (see L<http://redis.io/commands/rpop>)
+
+=head2 rpoplpush
+
+ $r->rpoplpush(source, destination)
+
+Remove the last element in a list, append it to another list and return it (see L<http://redis.io/commands/rpoplpush>)
+
+=head2 rpush
+
+ $r->rpush(key, value [value ...])
+
+Append one or multiple values to a list (see L<http://redis.io/commands/rpush>)
+
+=head2 rpushx
+
+ $r->rpushx(key, value)
+
+Append a value to a list, only if the list exists (see L<http://redis.io/commands/rpushx>)
+
+=head2 save
+
+ $r->save()
+
+Synchronously save the dataset to disk (see L<http://redis.io/commands/save>)
+
+=head2 shutdown
+
+ $r->shutdown([NOSAVE], [SAVE])
+
+Synchronously save the dataset to disk and then shut down the server (see L<http://redis.io/commands/shutdown>)
+
+=head2 slaveof
+
+ $r->slaveof(host, port)
+
+Make the server a slave of another instance, or promote it as master (see L<http://redis.io/commands/slaveof>)
+
+=head2 slowlog
+
+ $r->slowlog(subcommand, [argument])
+
+Manages the Redis slow queries log (see L<http://redis.io/commands/slowlog>)
+
+=head2 sync
+
+ $r->sync()
+
+Internal command used for replication (see L<http://redis.io/commands/sync>)
+
+=head2 time
+
+ $r->time()
+
+Return the current server time (see L<http://redis.io/commands/time>)
+
+=head1 ACKNOWLEDGEMENTS
+
+The following persons contributed to this project (random order):
+
+=over
+
+=item *
+
+Aaron Crane (pipelining and AUTOLOAD caching support)
+
+=item *
+
+Dirk Vleugels
+
+=item *
+
+Flavio Poletti
+
+=item *
+
+Jeremy Zawodny
+
+=item *
sunnavy at bestpractical.com
@@ -1630,6 +2482,14 @@ Thiago Berlitz Rondon
Ulrich Habel
+=item *
+
+Ivan Kruglov
+
+=item *
+
+Steffen Mueller <smueller@cpan.org>
+
=back
=head1 AUTHORS
@@ -1648,7 +2508,7 @@ Damien Krotkine <dams@cpan.org>
=head1 COPYRIGHT AND LICENSE
-This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
This is free software, licensed under:
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -3,14 +3,15 @@ use warnings;
# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.037
-use Test::More tests => 3 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
+use Test::More tests => 4 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
my @module_files = (
'Redis.pm',
'Redis/Hash.pm',
- 'Redis/List.pm'
+ 'Redis/List.pm',
+ 'Redis/Sentinel.pm'
);
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -20,6 +20,14 @@ use Test::SpawnRedisServer;
my ($c, $srv) = redis();
END { $c->() if $c }
+my $n;
+is(
+ exception { $n = Redis->new(server => $srv, name => 'no_auto_connect', no_auto_connect_on_new => 1) },
+ undef, 'Got an unconnected object',
+);
+ok(!$n->ping, "ping doesn't work yet");
+$n->connect;
+ok($n->ping, "ping works after connection");
my $o;
is(
@@ -46,9 +54,11 @@ ok($o->set(foo => 'baz'), 'set foo => baz');
cmp_ok($o->get('foo'), 'eq', 'baz', 'get foo = baz');
my $euro = "\x{20ac}";
-ok($o->set(utf8 => $euro), 'set utf8');
-use Encode;
-cmp_ok(Encode::decode_utf8($o->get('utf8')), 'eq', $euro, 'get utf8');
+ok ord($euro) > 255, "assume \$eur is wide character";
+ok ! eval { $o->set(utf8 => $euro); 1 }, "accepts only binary data, thus crashes on strings with characters > 255";
+like "$@", qr/command sent is not an octet sequence in the native encoding/i, ".. and crashes on syswrite call";
+
+ok ! defined $o->get('utf8'), ".. and does not write actual data";
ok($o->set('test-undef' => 42), 'set test-undef');
ok($o->exists('test-undef'), 'exists undef');
@@ -108,7 +118,7 @@ ok(my $nr_keys = $o->dbsize, 'dbsize');
like(
exception { $o->lpush('foo', 'bar') },
- qr/\[lpush\] ERR Operation against a key holding the wrong kind of value,/,
+ qr/\[lpush\] (?:ERR|WRONGTYPE) Operation against a key holding the wrong kind of value,/,
'Error responses throw exception'
);
@@ -219,11 +229,15 @@ is($o->zscore($zset, 'foo'), 2);
ok($o->zincrby($zset, 1, 'bar'));
is($o->zscore($zset, 'bar'), 1); # bar was new, so its score got set to the increment
+SKIP: {
+eval { $o->zrank($zset, 'bar') };
+skip "zrank not implemented in this redis", 4 if $@ && $@ =~ /unknown command/;
is($o->zrank($zset, 'bar'), 0);
is($o->zrank($zset, 'foo'), 1);
is($o->zrevrank($zset, 'bar'), 1);
is($o->zrevrank($zset, 'foo'), 0);
+}
ok($o->zadd($zset, 2.1, 'baz')); # we now have bar foo baz
@@ -243,7 +257,11 @@ is_deeply($rounded_withscores, { baz => 2.1, foo => 2 });
is_deeply([$o->zrangebyscore($zset, 2, 3)], [qw/foo baz/]);
+SKIP: {
+eval { $o->zcount($zset, 2, 3) };
+skip "zcount not implemented in this redis", 1 if $@ && $@ =~ /unknown command/;
is($o->zcount($zset, 2, 3), 2);
+}
is($o->zcard($zset), 3);
@@ -255,7 +273,10 @@ my @zkeys = (qw/foo bar baz qux quux quuux quuuux quuuuux/);
ok($o->zadd($zset, $score++, $_)) for @zkeys;
is_deeply([$o->zrangebyscore($zset, 0, 8)], \@zkeys);
-is($o->zremrangebyrank($zset, 5, 8), 3); # remove quux and up
+SKIP: {
+my $retval = eval { $o->zremrangebyrank($zset, 5, 8) };
+skip "zremrangebyrank not implemented in this redis", 5 if $@ && $@ =~ /unknown command/;
+is($retval, 3); # remove quux and up
is_deeply([$o->zrangebyscore($zset, 0, 8)], [@zkeys[0 .. 4]]);
is($o->zremrangebyscore($zset, 0, 2), 2); # remove foo and bar
@@ -263,6 +284,7 @@ is_deeply([$o->zrangebyscore($zset, 0, 8)], [@zkeys[2 .. 4]]);
# only left with 3
is($o->zcard($zset), 3);
+}
ok($o->del($zset)); # cleanup
@@ -272,7 +294,10 @@ ok($o->del($zset)); # cleanup
my $hash = 'test-hash';
$o->del($hash);
-ok($o->hset($hash, foo => 'bar'));
+SKIP: {
+my $retval = eval { $o->hset($hash, foo => 'bar') };
+skip "hset not implemented in this redis", 20 if $@ && $@ =~ /unknown command/;
+ok($retval);
is($o->hget($hash, 'foo'), 'bar');
ok($o->hexists($hash, 'foo'));
ok($o->hdel($hash, 'foo'));
@@ -302,7 +327,7 @@ is_deeply([$o->hvals($hash)], [qw/1 2 3 4/]);
is_deeply({ $o->hgetall($hash) }, { foo => 1, bar => 2, baz => 3, qux => 4 });
ok($o->del($hash)); # remove entire hash
-
+}
## Multiple databases handling commands
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -27,6 +27,7 @@ ok(my $r = Redis->new(server => $srv), 'connected to our test redis-server');
sub r {
$r->{sock} = IO::String->new(join('', map {"$_\r\n"} @_));
+ $r->{__buf} = '';
}
## -ERR responses
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -20,6 +20,11 @@ use Test::SpawnRedisServer qw( redis reap );
my ($c, $srv) = redis();
END { $c->() if $c }
+{
+my $r = Redis->new(server => $srv);
+eval { $r->publish( 'aa', 'v1' ) };
+plan 'skip_all' => "pubsub not implemented on this redis server" if $@ && $@ =~ /unknown command/;
+}
my ($another_kill_switch, $yet_another_kill_switch);
END { $_ and $_->() for($another_kill_switch, $yet_another_kill_switch) }
@@ -133,6 +138,24 @@ subtest 'basics' => sub {
is(exception { $sub->info }, undef, 'Other commands ok after we leave subscriber_mode');
};
+subtest 'zero_topic' => sub {
+ my %got;
+ my $pub = Redis->new(server => $srv);
+ my $sub = Redis->new(server => $srv);
+
+ my $db_size = -1;
+ $sub->dbsize(sub { $db_size = $_[0] });
+
+ my $bad_topic = '0';
+
+ my $sub_cb = sub { my ($v, $t, $s) = @_; $got{$s} = "$v:$t" };
+ $sub->psubscribe("$bad_topic*", 'xx', $sub_cb);
+ is($pub->publish($bad_topic, 'vBAD'), 1, "Delivered to 1 subscriber of topic '$bad_topic'");
+
+ is($sub->wait_for_messages(1), 1, '... yep, got the expected 1 message');
+ cmp_deeply(\%got, { "$bad_topic*" => "vBAD:$bad_topic" }, "... for the expected topic, '$bad_topic'");
+};
+
subtest 'server is killed while waiting for subscribe' => sub {
my ($another_kill_switch, $another_server) = redis();
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -20,6 +20,12 @@ use Test::Deep;
my ($c, $srv) = redis();
END { $c->() if $c }
+{
+my $r = Redis->new(server => $srv);
+eval { $r->multi( ); };
+plan 'skip_all' => "multi without arguments not implemented on this redis server" if $@ && $@ =~ /unknown command/;
+}
+
ok(my $r = Redis->new(server => $srv), 'connected to our test redis-server');
@@ -71,16 +77,28 @@ subtest 'synchronous request with pending pipeline' => sub {
is($clunk, 'eth', 'synchronous request processes pending ones');
};
-pipeline_ok 'transaction',
- (
- [multi => [], 'OK'],
- [set => ['clunk' => 'eth'], 'QUEUED'],
- [rpush => ['clunk' => 'oops'], 'QUEUED'],
- [get => ['clunk'], 'QUEUED'],
- [ exec => [],
- [['OK', undef], [undef, 'ERR Operation against a key holding the wrong kind of value'], ['eth', undef],]
- ],
- );
+subtest 'transaction with error and pipeline' => sub {
+ my @responses;
+ my $s = sub { push @responses, [@_] };
+ $r->multi($s);
+ $r->set(clunk => 'eth', $s);
+ $r->rpush(clunk => 'oops', $s);
+ $r->get('clunk', $s);
+ $r->exec($s);
+ $r->wait_all_responses;
+
+ is(shift(@responses)->[0], 'OK' , 'multi started' );
+ is(shift(@responses)->[0], 'QUEUED', 'queued');
+ is(shift(@responses)->[0], 'QUEUED', 'queued');
+ is(shift(@responses)->[0], 'QUEUED', 'queued');
+ my $resp = shift @responses;
+ is ($resp->[0]->[0]->[0], 'OK', 'set');
+ is ($resp->[0]->[1]->[0], undef, 'bad rpush value should be undef');
+ like ($resp->[0]->[1]->[1],
+ qr/(?:ERR|WRONGTYPE) Operation against a key holding the wrong kind of value/,
+ 'bad rpush should give an error');
+ is ($resp->[0]->[2]->[0], 'eth', 'get should work');
+};
subtest 'transaction with error and no pipeline' => sub {
is($r->multi, 'OK', 'multi');
@@ -89,7 +107,7 @@ subtest 'transaction with error and no pipeline' => sub {
is($r->get('clunk'), 'QUEUED', 'transactional GET');
like(
exception { $r->exec },
- qr{\[exec\] ERR Operation against a key holding the wrong kind of value,},
+ qr{\[exec\] (?:WRONGTYPE|ERR) Operation against a key holding the wrong kind of value,},
'synchronous EXEC dies for intervening error'
);
};
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -26,7 +26,7 @@ subtest 'non-block TCP' => sub {
## 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);
};
@@ -41,7 +41,7 @@ subtest 'non-block UNIX' => sub {
## 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);
};
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -17,6 +17,7 @@ use Time::HiRes qw(gettimeofday tv_interval);
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 }
@@ -47,8 +48,24 @@ subtest 'Reconnection discards pending commands' => sub {
ok(close(delete $r->{sock}), 'evilly close connection to the server');
ok($r->set(foo => 'bar'), 'send command with reconnect');
-
is($processed_pending, 0, 'pending command discarded on reconnect');
+
+};
+
+subtest 'Conservative Reconnection dies on pending commands' => sub {
+ ok(my $r = Redis->new(reconnect => 2, conservative_reconnect => 1, server => $srv),
+ 'connected to our test redis-server');
+
+ my $processed_pending = 0;
+ $r->dbsize(sub { $processed_pending++ });
+
+ ok(close(delete $r->{sock}), 'evilly close connection to the server');
+ like(exception { $r->set(foo => 'bar') },
+ qr{while responses are pending and conservative reconnect mode enabled},
+ 'send command with reconnect and conservative_reconnect should raise an exception');
+
+ is($processed_pending, 0, 'pending command never arrived');
+
};
@@ -108,6 +125,63 @@ subtest "Reconnect gives up after timeout" => sub {
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();
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -1,57 +0,0 @@
-#!perl
-#
-# This file is part of Redis
-#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
-#
-# This is free software, licensed under:
-#
-# The Artistic License 2.0 (GPL Compatible)
-#
-
-use warnings;
-use strict;
-use Test::More;
-use Test::Fatal;
-use Redis;
-use lib 't/tlib';
-use Test::SpawnRedisServer;
-
-my ($c, $srv) = redis();
-END { $c->() if $c }
-
-subtest 'REDIS_SERVER TCP' => sub {
- my $n = time();
- my $r = Redis->new(server => $srv);
- $r->set($$ => $n);
-
- local $ENV{REDIS_SERVER} = $srv;
- is(exception { $r = Redis->new }, undef, "Direct IP/Port address on REDIS_SERVER works ($srv)",);
- is($r->get($$), $n, '... connected to the expected server');
-
- $ENV{REDIS_SERVER} = "tcp:$srv";
- is(exception { $r = Redis->new }, undef, 'Direct IP/Port address (with tcp prefix) on REDIS_SERVER works',);
- is($r->get($$), $n, '... connected to the expected server');
-};
-
-
-subtest 'REDIS_SERVER UNIX' => sub {
- my $srv = $ENV{TEST_REDIS_SERVER_SOCK_PATH};
- plan skip_all => 'Define ENV TEST_REDIS_SERVER_SOCK_PATH to test UNIX socket support'
- unless $srv;
-
- my $n = time();
- my $r = Redis->new(sock => $srv);
- $r->set($$ => $n);
-
- local $ENV{REDIS_SERVER} = $srv;
- is(exception { $r = Redis->new }, undef, 'UNIX path on REDIS_SERVER works',);
- is($r->get($$), $n, '... connected to the expected server');
-
- $ENV{REDIS_SERVER} = "unix:$srv";
- is(exception { $r = Redis->new }, undef, 'UNIX path (with unix prefix) on REDIS_SERVER works',);
- is($r->get($$), $n, '... connected to the expected server');
-};
-
-
-done_testing();
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -0,0 +1,71 @@
+#!perl
+#
+# This file is part of Redis
+#
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
+#
+# This is free software, licensed under:
+#
+# The Artistic License 2.0 (GPL Compatible)
+#
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Fatal;
+use Redis;
+use lib 't/tlib';
+use Test::SpawnRedisTimeoutServer;
+use Errno qw(ETIMEDOUT EWOULDBLOCK);
+use POSIX qw(strerror);
+use Carp;
+use IO::Socket::INET;
+use Test::TCP;
+
+subtest 'server replies quickly enough' => sub {
+ my $server = Test::SpawnRedisTimeoutServer::create_server_with_timeout(0);
+ my $redis = Redis->new(server => '127.0.0.1:' . $server->port, read_timeout => 1);
+ ok($redis);
+ my $res = $redis->get('foo');;
+ is $res, 42;
+};
+
+subtest "server doesn't replies quickly enough" => sub {
+ my $server = Test::SpawnRedisTimeoutServer::create_server_with_timeout(10);
+ my $redis = Redis->new(server => '127.0.0.1:' . $server->port, read_timeout => 1);
+ ok($redis);
+ my $msg1 = "Error while reading from Redis server: " . strerror(ETIMEDOUT);
+ my $msg2 = "Error while reading from Redis server: " . strerror(EWOULDBLOCK);
+ like(
+ exception { $redis->get('foo'); },
+ qr/$msg1|$msg2/,
+ "the code died as expected",
+ );
+};
+
+subtest "server doesn't respond at connection (cnx_timeout)" => sub {
+ SKIP: {
+ skip "This subtest is failing on some platforms", 4;
+ my $server = Test::TCP->new(code => sub {
+ my $port = shift;
+ my $sock = IO::Socket::INET->new(Listen => 1, LocalPort => $port, Proto => 'tcp', LocalAddr => '127.0.0.1') or croak "fail to listen on port $port";
+ while(1) {
+ sleep(1);
+ };
+ });
+
+ my $redis;
+ my $start_time = time;
+ isnt(
+ exception { $redis = Redis->new(server => '127.0.0.1:' . $server->port, cnx_timeout => 1); },
+ undef,
+ "the code died",
+ );
+ ok(time - $start_time >= 1, "gave up late enough");
+ ok(time - $start_time < 5, "gave up soon enough");
+ ok(!$redis, 'redis was not set');
+ }
+};
+
+done_testing;
+
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -0,0 +1,32 @@
+#!perl
+#
+# This file is part of Redis
+#
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
+#
+# This is free software, licensed under:
+#
+# The Artistic License 2.0 (GPL Compatible)
+#
+
+use warnings;
+use strict;
+use Test::More;
+use Test::Fatal;
+use Redis;
+use lib 't/tlib';
+use Test::SpawnRedisServer;
+
+my ($c, $srv) = redis();
+END { $c->() if $c }
+
+ok(my $r = Redis->new(server => $srv), 'connected to our test redis-server');
+my $s2 = my $s1 = "test\x{80}";
+utf8::upgrade($s1); # no need to use 'use utf8' to call this
+utf8::downgrade($s2); # no need to use 'use utf8' to call this
+ok ($s1 eq $s2, 'assume test string are considered identical by perl');
+$r->set($s1 => 42);
+is $r->get($s2), 42, "same binary strings should point to same keys";
+
+## All done
+done_testing();
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -1,7 +1,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -18,11 +18,10 @@ use IPC::Cmd qw(can_run);
use POSIX ":sys_wait_h";
use base qw( Exporter );
-our @EXPORT = qw( redis );
-our @EXPORT_OK = qw( redis reap );
+use Net::EmptyPort qw(empty_port);
-## FIXME: for the love of $Deity... move to Test::TCP, will you??
-my $port = 11011 + ($$ % 127);
+our @EXPORT = qw( redis sentinel );
+our @EXPORT_OK = qw( redis reap );
sub redis {
my %params = (
@@ -32,7 +31,7 @@ sub redis {
my ($fh, $fn) = File::Temp::tempfile();
- $port++;
+ my $port = empty_port();
my $local_port = $port;
$params{port}
@@ -89,6 +88,72 @@ sub redis {
return ($c, $addr, $ver, split(/[.]/, $ver), $local_port);
}
+sub sentinel {
+ my %params = (
+ timeout => 120,
+ @_,
+ );
+
+ my ($fh, $fn) = File::Temp::tempfile();
+
+ my $port = empty_port();
+
+ my $local_port = $port;
+ $params{port}
+ and $local_port = $params{port};
+
+ my $redis_port = $params{redis_port}
+ or die "need a redis port";
+
+ my $addr = "127.0.0.1:$local_port";
+
+ unlink("redis-sentinel-$addr.log");
+
+ $fh->print("
+ port $local_port
+
+ sentinel monitor mymaster 127.0.0.1 $redis_port 2
+ sentinel down-after-milliseconds mymaster 2000
+ sentinel failover-timeout mymaster 4000
+
+ logfile sentinel-$addr.log
+
+ ");
+ $fh->flush;
+
+ my $redis_server_path = $ENV{REDIS_SERVER_PATH} || 'redis-server';
+ if (!can_run($redis_server_path)) {
+ Test::More::plan skip_all => "Could not find binary redis-server";
+ return;
+ }
+
+ my ($ver, $c);
+ eval { ($ver, $c) = spawn_server($redis_server_path, $fn, '--sentinel', $addr) };
+ if (my $e = $@) {
+ reap();
+ Test::More::plan skip_all => "Could not start redis-sentinel: $@";
+ return;
+ }
+
+ if (my $rvs = $params{requires_version}) {
+ if (!defined $ver) {
+ $c->();
+ Test::More::plan skip_all => "This tests require at least redis-server $rvs, could not determine server version";
+ return;
+ }
+
+ my ($v1, $v2, $v3) = split(/[.]/, $ver);
+ my ($r1, $r2, $r3) = split(/[.]/, $rvs);
+ if ($v1 < $r1 or $v1 == $r1 and $v2 < $r2 or $v1 == $r1 and $v2 == $r2 and $v3 < $r3) {
+ $c->();
+ Test::More::plan skip_all => "This tests require at least redis-server $rvs, server found is $ver";
+ return;
+ }
+ }
+
+ return ($c, $addr, $ver, split(/[.]/, $ver), $local_port);
+}
+
sub spawn_server {
my $addr = pop;
my $pid = fork();
@@ -111,6 +176,7 @@ sub spawn_server {
Test::More::diag("Failed to kill server at $pid")
if $ENV{REDIS_DEBUG} and $failed;
unlink("redis-server-$addr.log");
+ unlink("redis-sentinel-$addr.log");
unlink('dump.rdb');
$alive = 0;
@@ -134,6 +200,7 @@ sub reap {
$limit = 3 unless $limit;
my $try = 0;
+ local $?;
while ($try++ < $limit) {
my $ok = waitpid($pid, WNOHANG);
$try = 0, last if $ok > 0;
@@ -0,0 +1,42 @@
+#
+# This file is part of Redis
+#
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
+#
+# This is free software, licensed under:
+#
+# The Artistic License 2.0 (GPL Compatible)
+#
+package # Hide from PAUSE
+ Test::SpawnRedisTimeoutServer;
+
+use strict;
+use warnings;
+use Test::TCP;
+
+sub create_server_with_timeout {
+ my $timeout = shift;
+
+ Test::TCP->new(
+ code => sub {
+ my $port = shift;
+ my $socket = IO::Socket::INET->new(
+ Listen => 5,
+ Timeout => 1,
+ Reuse => 1,
+ Blocking => 1,
+ LocalPort => $port
+ ) or die "failed to connect to RedisTimeoutServer: $!";
+
+ my $buffer;
+ while (1) {
+ my $client = $socket->accept();
+ if (defined (my $got = <$client>)) {
+ sleep $timeout;
+ $client->print("+42\r\n");
+ }
+ }
+ },
+ );
+}
+1;
@@ -1,7 +1,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -2,7 +2,7 @@
#
# This file is part of Redis
#
-# This software is Copyright (c) 2013 by Pedro Melo, Damien Krotkine.
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
#
# This is free software, licensed under:
#
@@ -0,0 +1,68 @@
+#
+# This file is part of Redis
+#
+# This software is Copyright (c) 2015 by Pedro Melo, Damien Krotkine.
+#
+# This is free software, licensed under:
+#
+# The Artistic License 2.0 (GPL Compatible)
+#
+use strict;
+use warnings;
+use 5.10.1;
+
+my %exclude = map { $_ => 1 }
+ qw(publish subscribe unsubscribe psubscribe punsubscribe );
+
+my %hash;
+my (@groups, $group, $command, @args, $text);
+my ($in_section, $in_nav, $in_args);
+
+while (my $line = <>) {
+ chomp $line;
+
+ $line =~ m|<section id="commands">|
+ and $in_section=1, next;
+ $in_section && $line =~ m|<nav>|
+ and $in_nav=1, next;
+ $in_section && $in_nav && $line =~ m|<a href="#([^"]+?)">(.+?)</a>|
+ and push(@groups,[$1, $2]), next;
+ $in_section && $in_nav && $line =~ m|</nav>|
+ and $in_section = 0, $in_nav = 0, next;
+
+ $line =~ m|li data-group="(.+?)".+?">|
+ and $group = $1,
+ next;
+ $line =~ m|href="/commands/(.+?)">.+?</a>|
+ and $command=$1, @args=(), next;
+ $line =~ m|<span class="args">|
+ and $in_args = 1, next;
+ $in_args && $line =~ m|</span>|
+ and $in_args = 0, next;
+ $in_args
+ and push(@args, $line =~ s/^\s+|\s+$//rg),
+ next;
+ ( ($text) = $line =~ m|<span class="summary">(.+?)</span>| )
+ && ! $exclude{$command}
+ and $hash{$group}{$command =~ s/-/_/gr} = {
+ text => $text,
+ synopsis => '$r->' . ($command =~ s/-/_/gr). '('
+ . join(', ', @args)
+ . ')',
+ ref => $command,
+ },
+ @args = ();
+}
+
+my $pod = '';
+foreach (@groups) {
+ my ($group, $name) = @$_;
+ $pod .= "=head1 " . uc($name) . "\n\n";
+ foreach my $command (sort keys %{$hash{$group}}) {
+ my %h = %{$hash{$group}{$command}};
+ $pod .= "=head2 $command\n\n"
+ . " $h{synopsis}\n\n"
+ . $h{text} . " (see L<http://redis.io/commands/$h{ref}>)\n\n";
+ }
+}
+say $pod;