Permalink
Browse files

Merge branch 'client_set_get_name'

* client_set_get_name:
  Update Changes, prepare for new release
  Updated docs with CLIENT * commands, plus name constructor parameter
  Add name parameter to new(): sets the connection name (2.6.9+)
  Add tests for 2.6.9 client {set,get}name commands
  T::SpawnRedisServer::redis() accepts requires_version => VER now
  If redis-server cannot be started, make sure we reap the zombie
  Use Redis.pm to test the new server connection, return redis-server version
  Fix Pod
  • Loading branch information...
2 parents 888f0f4 + 6032719 commit 1887747a2f6fac62ff79936a9db769a1acb21d5f @melo melo committed Jan 15, 2013
Showing with 129 additions and 18 deletions.
  1. +3 −0 Changes
  2. +44 −1 lib/Redis.pm
  3. +34 −0 t/42-client_cmds.t
  4. +48 −17 t/tlib/Test/SpawnRedisServer.pm
View
@@ -1,6 +1,9 @@
Revision history for Redis
{{$NEXT}}
+ * Support for name constructor parameter, set connection name
+ * Add documentation for CLIENT * commands
+ * Improve reliability of Test::SpawnRedisServer
1.957 2013-01-15T13:18:07Z
* Fix minimum Perl version
View
@@ -47,6 +47,14 @@ sub new {
$self->{password} = $args{password} if $args{password};
$self->{on_connect} = $args{on_connect} if $args{on_connect};
+ if (my $name = $args{name}) {
+ my $on_conn = $self->{on_connect};
+ $self->{on_connect} = sub {
+ $_[0]->client_setname($name);
+ $on_conn->(@_) if $on_conn;
+ }
+ }
+
if ($args{sock}) {
$self->{server} = $args{sock};
$self->{builder} = sub { IO::Socket::UNIX->new($_[0]->{server}) };
@@ -662,6 +670,9 @@ __END__
my $redis = Redis->new(server => 'redis.example.com:8080');
+ ## Set the connection name (requires Redis 2.6.9)
+ my $redis = Redis->new(server => 'redis.example.com:8080', name => 'my_connection_name');
+
## Use UNIX domain socket
my $redis = Redis->new(sock => '/path/to/socket');
@@ -817,6 +828,7 @@ back without utf-8 flag turned on.
my $r = Redis->new( reconnect => 60, every => 5000 );
my $r = Redis->new( password => 'boo' );
my $r = Redis->new( on_connect => sub { my ($redis) = @_; ... } );
+ my $r = Redis->new( name => 'my_connection_name' ); ## Redis 2.6.9 required
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
@@ -852,7 +864,7 @@ tcp:127.0.0.1:11011
The C<< encoding >> parameter speficies 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>>.
+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
@@ -880,6 +892,14 @@ sucessfull 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.
+Starting with Redis 2.6.9, you can 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. Please note that there are restrictions on the name you can
+set, the most important of which is, no spaces. See the
+L<CLIENT SETNAME documentation|http://redis.io/commands/client-setname>
+for all the juicy details.
+
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.
@@ -900,6 +920,29 @@ pipelined operation.
The C<ping> method does not support pipelined operation.
+=head3 client_list
+
+ @clients = $r->client_list;
+
+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.
+
+=head3 client_getname
+
+ my $connection_name = $r->client_getname;
+
+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.
+
+=head3 client_setname
+
+ $r->client_setname('my_connection_name');
+
+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.
=head2 Pipeline management
View
@@ -0,0 +1,34 @@
+#!perl
+
+use warnings;
+use strict;
+use Test::More;
+use Redis;
+use lib 't/tlib';
+use Test::SpawnRedisServer;
+
+my ($c, $srv) = redis(requires_version => '2.6.9');
+END { $c->() if $c }
+
+subtest 'client_{set|get}name commands' => sub {
+ ok(my $r = Redis->new(server => $srv), 'connected to our test redis-server');
+
+ my @clients = $r->client_list;
+ is(@clients, 1, 'one client listed');
+ like($clients[0], qr/\s+name=\s+/, '... no name set yet');
+
+ is($r->client_setname('my_preccccious'), 'OK', "client_setname() is supported, no errors");
+ is($r->client_getname, 'my_preccccious', '... client_getname() returns new connection name');
+
+ @clients = $r->client_list;
+ like($clients[0], qr/\s+name=my_preccccious\s+/, '... no name set yet');
+};
+
+
+subtest 'client name via constructor' => sub {
+ ok(my $r = Redis->new(server => $srv, name => 'buuu'), 'connected to our test redis-server, with a name');
+ is($r->client_getname, 'buuu', '... name was properly set');
+};
+
+
+done_testing();
@@ -3,6 +3,7 @@ package # Hide from PAUSE
use strict;
use warnings;
+use Redis;
use File::Temp;
use IPC::Cmd qw(can_run);
use POSIX ":sys_wait_h";
@@ -32,60 +33,90 @@ sub redis {
");
$fh->flush;
- Test::More::diag("Redis port $port, cfg $fn") if $ENV{REDIS_DEBUG};
+ my $addr = "127.0.0.1:$port";
+ Test::More::diag("Spawn Redis at $addr, cfg $fn") if $ENV{REDIS_DEBUG};
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 $c;
- eval { $c = spawn_server($redis_server_path, $fn) };
+ my ($ver, $c);
+ eval { ($ver, $c) = spawn_server($redis_server_path, $fn, $addr) };
if (my $e = $@) {
+ reap();
Test::More::plan skip_all => "Could not start redis-server: $@";
return;
}
- return ($c, "127.0.0.1:$port");
+ 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));
}
sub spawn_server {
- my $pid = fork();
+ my $addr = pop;
+ my $pid = fork();
if ($pid) { ## Parent
require Test::More;
Test::More::diag("Starting server with pid $pid") if $ENV{REDIS_DEBUG};
- ## FIXME: we should PING it until he is ready
- sleep(1);
- my $alive = 1;
+ my $redis = Redis->new(server => $addr, reconnect => 5, every => 200);
+ my $version = $redis->info->{redis_version};
+ my $alive = 1;
- return sub {
+ my $c = sub {
return unless $alive;
Test::More::diag("Killing server at $pid") if $ENV{REDIS_DEBUG};
kill(15, $pid);
- my $try = 0;
- while ($try++ < 10) {
- my $ok = waitpid($pid, WNOHANG);
- $try = -1, last if $ok > 0;
- sleep(1);
- }
+ my $failed = reap($pid);
Test::More::diag("Failed to kill server at $pid")
- if $ENV{REDIS_DEBUG} && $try > 0;
+ if $ENV{REDIS_DEBUG} and $failed;
unlink('redis-server.log');
unlink('dump.rdb');
$alive = 0;
};
+
+ return $version => $c;
}
elsif (defined $pid) { ## Child
exec(@_);
- die "Failed exec of '@_': $!, ";
+ warn "## In child Failed exec of '@_': $!, ";
+ exit(1);
}
die "Could not fork(): $!";
}
+sub reap {
+ my ($pid) = @_;
+ $pid = -1 unless $pid;
+
+ my $try = 0;
+ while ($try++ < 3) {
+ my $ok = waitpid($pid, WNOHANG);
+ $try = 0, last if $ok > 0;
+ sleep(1);
+ }
+
+ return $try;
+}
1;

0 comments on commit 1887747

Please sign in to comment.