Search the CPAN - metacpan.org

Changes	1 9
META.json	3 4
META.yml	2 3
Makefile.PL	0 1
lib/RedisDB/Cluster.pm	3 3
lib/RedisDB/Error.pm	1 1
lib/RedisDB/Sentinel.pm	1 1
lib/RedisDB.pm	56 38
t/transactions.t	2 7
9 files changed (This is a version diff)	6967

Changes

@@ -1,6 +1,14 @@
 Revision history for RedisDB
 
-2.43 Tue Apr  7 2015 Pavel Shaydo <zwon@trinitum.org>
+2.45 Tue Jun 23 2015 Pavel Shaydo <zwon@trinitum.org>
+    - fix cluster code to work with clusters using IPv6,
+      see #25, patch by Troy Ablan
+
+2.44 Sun Jun 14 2015 Pavel Shaydo <zwon@cpan.org>
+    - internals refactoring
+    - fix test failing on FreeBSD
+
+2.43 Tue Apr  7 2015 Pavel Shaydo <zwon@cpan.org>
     - remove wrapper for SYNC command, as it does not work
     - fix test failing with redis-server 3.0.0.
       See #23, reported by Victor Efimov

META.json

@@ -4,7 +4,7 @@
       "Pavel Shaydo <zwon@cpan.org>"
    ],
    "dynamic_config" : 1,
-   "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240",
+   "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001",
    "keywords" : [
       "redis"
    ],
@@ -61,11 +61,12 @@
          "url" : "git://github.com/trinitum/RedisDB"
       }
    },
-   "version" : "2.43",
+   "version" : "2.45",
    "x_contributors" : [
       "Pavel Shaydo <zwon@cpan.org>",
       "HIROSE Masaaki <hirose31@gmail.com>",
       "Uwe Voelker <uwe.voelker@xing.com>",
-      "Andrew O'Brien"
+      "Andrew O'Brien",
+      "Troy Ablan"
    ]
 }

META.yml

@@ -12,7 +12,7 @@ build_requires:
 configure_requires:
   ExtUtils::MakeMaker: '6.3002'
 dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240'
+generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001'
 keywords:
   - redis
 license: perl
@@ -35,9 +35,10 @@ resources:
   homepage: https://github.com/trinitum/RedisDB
   license: http://dev.perl.org/licenses/
   repository: git://github.com/trinitum/RedisDB
-version: '2.43'
+version: '2.45'
 x_contributors:
   - 'Pavel Shaydo <zwon@cpan.org>'
   - 'HIROSE Masaaki <hirose31@gmail.com>'
   - 'Uwe Voelker <uwe.voelker@xing.com>'
   - "Andrew O'Brien"
+  - 'Troy Ablan'

Makefile.PL

@@ -47,6 +47,7 @@ WriteMakefile(
             'HIROSE Masaaki <hirose31@gmail.com>',
             'Uwe Voelker <uwe.voelker@xing.com>',
             "Andrew O'Brien",
+            'Troy Ablan',
         ],
     },
 );

lib/RedisDB/Cluster.pm

@@ -2,7 +2,7 @@ package RedisDB::Cluster;
 
 use strict;
 use warnings;
-our $VERSION = "2.43";
+our $VERSION = "2.45";
 $VERSION = eval $VERSION;
 
 use Carp;
@@ -258,7 +258,7 @@ sub execute {
     while ( $attempts-- ) {
         my $redis = $self->{_connections}{$node_key};
         unless ($redis) {
-            my ( $host, $port ) = split /:/, $node_key;
+            my ( $host, $port ) = split /:([^:]+)$/, $node_key;
             $redis = _connect_to_node(
                 $self,
                 {
@@ -546,7 +546,7 @@ sub _get_node_info {
 sub _ensure_hash_address {
     my $addr = shift;
     unless ( ref $addr eq 'HASH' ) {
-        my ( $host, $port ) = split /:/, $addr;
+        my ( $host, $port ) = split /:([^:]+)$/, $addr;
         croak "invalid address spec: $addr" unless $host and $port;
         $addr = {
             host => $host,

lib/RedisDB/Error.pm

@@ -2,7 +2,7 @@ package RedisDB::Error;
 
 use strict;
 use base 'RedisDB::Parser::Error';
-our $VERSION = "2.43";
+our $VERSION = "2.45";
 $VERSION = eval $VERSION;
 
 =head1 NAME

lib/RedisDB/Sentinel.pm

@@ -2,7 +2,7 @@ package RedisDB::Sentinel;
 
 use strict;
 use warnings;
-our $VERSION = "2.43";
+our $VERSION = "2.45";
 $VERSION = eval $VERSION;
 
 use Carp;

lib/RedisDB.pm

@@ -2,7 +2,7 @@ package RedisDB;
 
 use strict;
 use warnings;
-our $VERSION = "2.43";
+our $VERSION = "2.45";
 $VERSION = eval $VERSION;
 
 use RedisDB::Error;
@@ -152,6 +152,10 @@ sub new {
     return $self;
 }
 
+sub _is_redisdb_error {
+    ref(shift) =~ /^RedisDB::Error/;
+}
+
 sub _init_parser {
     my $self = shift;
     $self->{_parser} = RedisDB::Parser->new(
@@ -356,7 +360,7 @@ sub _connect {
             $self->{password},
             sub {
                 my ( $self, $res ) = @_;
-                croak "$res" if ref $res eq 'RedisDB::Error';
+                croak "$res" if _is_redisdb_error($res);
             }
         );
     }
@@ -535,7 +539,7 @@ sub send_command {
 
 sub _ignore {
     my ( $self, $res ) = @_;
-    if ( ref $res eq 'RedisDB::Error' ) {
+    if ( _is_redisdb_error($res) ) {
         warn "Ignoring error returned by redis-server: $res";
     }
 }
@@ -689,7 +693,7 @@ sub get_reply {
     }
 
     my $res = shift @{ $self->{_replies} };
-    if ( ref $res eq 'RedisDB::Error'
+    if ( _is_redisdb_error($res)
         and ( $self->{raise_error} or $self->{_in_multi} or $self->{_watching} ) )
     {
         croak $res;
@@ -887,6 +891,25 @@ The following commands implement some additional postprocessing of the results:
 
 =cut
 
+sub _execute_with_postprocess {
+    my $self  = shift;
+    my $ppsub = pop;
+    if ( $_[-1] && ref $_[-1] eq 'CODE' ) {
+        my $orig = pop;
+        my $cb   = sub {
+            my ( $redis, $reply ) = @_;
+            $reply = $ppsub->($reply) unless _is_redisdb_error($reply);
+            $orig->( $redis, $reply );
+        };
+        return $self->send_command( @_, $cb );
+    }
+    else {
+        my $reply = $self->execute(@_);
+        $reply = $ppsub->($reply) unless _is_redisdb_error($reply);
+        return $reply;
+    }
+}
+
 =head2 $self->info([\&callback])
 
 return information and statistics about the server. Redis-server returns
@@ -897,18 +920,7 @@ returns it as a hash reference.
 
 sub info {
     my $self = shift;
-    my $orig = $_[-1];
-    if ( $orig && ref $orig eq 'CODE' ) {
-        my $cb = sub {
-            my ( $redis, $info ) = @_;
-            $orig->( $redis, _parse_info($info) );
-        };
-        return $self->send_command( 'INFO', $cb );
-    }
-    else {
-        my $info = $self->execute('INFO');
-        return _parse_info($info);
-    }
+    return $self->_execute_with_postprocess('INFO', @_, \&_parse_info);
 }
 
 sub _parse_info {
@@ -927,18 +939,7 @@ output and returns result as reference to array of hashes.
 
 sub client_list {
     my $self = shift;
-    my $orig = $_[-1];
-    if ( $orig && ref $orig eq 'CODE' ) {
-        my $cb = sub {
-            my ( $redis, $list ) = @_;
-            $orig->( $redis, _parse_client_list($list) );
-        };
-        return $self->send_command( qw(CLIENT LIST), $cb );
-    }
-    else {
-        my $list = $self->execute(qw(CLIENT LIST));
-        return _parse_client_list($list);
-    }
+    return $self->_execute_with_postprocess('CLIENT', 'LIST', @_, \&_parse_client_list);
 }
 
 sub _parse_client_list {
@@ -963,21 +964,10 @@ and returns it as a hash reference.
 
 sub cluster_info {
     my $self = shift;
-    my $orig = $_[-1];
-    if ( $orig && ref $orig eq 'CODE' ) {
-        my $cb = sub {
-            my ( $redis, $info ) = @_;
-            $orig->( $redis, _parse_info($info) );
-        };
-        return $self->send_command( 'CLUSTER', 'INFO', $cb );
-    }
-    else {
-        my $info = $self->execute('CLUSTER', 'INFO');
-        return _parse_info($info);
-    }
+    return $self->_execute_with_postprocess('CLUSTER', 'INFO', @_, \&_parse_info);
 }
 
-=head2 $self->cluster_nodes
+=head2 $self->cluster_nodes([\&callback])
 
 return list of cluster nodes. Each node represented as a hash with the
 following keys: node_id, address, host, port, flags, master_id, last_ping_sent,
@@ -987,16 +977,19 @@ last_pong_received, link_state, slots.
 
 sub cluster_nodes {
     my $self = shift;
+    return $self->_execute_with_postprocess( 'CLUSTER', 'NODES', @_,
+        sub { $self->_parse_cluster_nodes(@_) } );
+}
 
-    my $list = $self->execute(qw(CLUSTER NODES));
-    return $list if ref $list =~ /^RedisDB::Error/;
+sub _parse_cluster_nodes {
+    my ($self, $list) = @_;
 
     my @nodes;
     for ( split /^/, $list ) {
         my ( $node_id, $addr, $flags, $master_id, $ping, $pong, $state, @slots ) =
           split / /;
         my %flags = map { $_ => 1 } split /,/, $flags;
-        my ( $host, $port ) = split /:/, $addr;
+        my ( $host, $port ) = split /:([^:]+)$/, $addr;
         unless ($host) {
             $host = $self->{host}, $addr = "$self->{host}:$port",
         }
@@ -1066,18 +1059,7 @@ sentinel it will contain "services".
 
 sub role {
     my $self = shift;
-    my $orig = $_[-1];
-    if ( $orig && ref $orig eq 'CODE' ) {
-        my $cb = sub {
-            my ( $redis, $role ) = @_;
-            $orig->( $redis, _parse_role($role) );
-        };
-        return $self->send_command( 'ROLE', $cb );
-    }
-    else {
-        my $role = $self->execute('ROLE');
-        return _parse_role($role);
-    }
+    return $self->_execute_with_postprocess( 'ROLE', @_, \&_parse_role );
 }
 
 =head2 $self->shutdown

t/transactions.t

@@ -134,9 +134,10 @@ subtest "Reconnecting if disconnected after EXEC" => sub {
         code => sub {
             my $port = shift;
             my $sock = IO::Socket::IP->new(
+                LocalAddr => '127.0.0.1',
                 LocalPort => $port,
                 Listen    => 1,
-            );
+            ) or die $_;
             while ( my $cli = $sock->accept ) {
                 my $line;
                 while ( defined( $line = <$cli> ) ) {
@@ -157,7 +158,11 @@ subtest "Reconnecting if disconnected after EXEC" => sub {
             }
         }
     );
-    my $redis = RedisDB->new( port => $server->port, raise_error => undef, );
+    my $redis = RedisDB->new(
+        host        => '127.0.0.1',
+        port        => $server->port,
+        raise_error => undef,
+    );
     ok $redis->multi(RedisDB::IGNORE_REPLY), "Entered transaction (async)";
     is $redis->set( "key", "42" ), "QUEUED", "QUEUED set";
     my $repl;

	Global
`s`	Focus search bar
`?`	Bring up this help dialog

	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)

	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse

	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)