The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Changes 04
META.json 22
META.yml 1111
README 11
lib/RedisDB/Parser/Error.pm 228
lib/RedisDB/Parser/PP.pm 22
lib/RedisDB/Parser/XS.pm 22
lib/RedisDB/Parser.pm 22
t/parser.t 1321
9 files changed (This is a version diff) 3573
@@ -1,3 +1,7 @@
+2.21 Tue Feb 10 2015 Pavel Shaydo <zwon@cpan.org>
+    - create special error objects for MOVED and ASK redirections from
+    redis cluster
+
 2.20 Sun Dec  1 2013 Pavel Shaydo <zwon@cpan.org>
     - stable version, no code changes
 
@@ -4,7 +4,7 @@
       "Pavel Shaydo <zwon@cpan.org>"
    ],
    "dynamic_config" : 1,
-   "generated_by" : "ExtUtils::MakeMaker version 6.82, CPAN::Meta::Converter version 2.132830",
+   "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.143240",
    "keywords" : [
       "redis",
       "protocol",
@@ -62,7 +62,7 @@
          "url" : "git://github.com/trinitum/perl-RedisDB-Parser"
       }
    },
-   "version" : "2.20",
+   "version" : "2.21",
    "x_contributors" : [
       "Pavel Shaydo <zwon@cpan.org>"
    ]
@@ -3,14 +3,14 @@ abstract: 'Redis protocol parser'
 author:
   - 'Pavel Shaydo <zwon@cpan.org>'
 build_requires:
-  Test::FailWarnings: 0
-  Test::More: 0.94
-  Test::Most: 0.22
+  Test::FailWarnings: '0'
+  Test::More: '0.94'
+  Test::Most: '0.22'
 configure_requires:
-  ExtUtils::CBuilder: 0.27
-  ExtUtils::MakeMaker: 6.3002
+  ExtUtils::CBuilder: '0.27'
+  ExtUtils::MakeMaker: '6.3002'
 dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.82, CPAN::Meta::Converter version 2.132830'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.143240'
 keywords:
   - redis
   - protocol
@@ -18,7 +18,7 @@ keywords:
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
-  version: 1.4
+  version: '1.4'
 name: RedisDB-Parser
 no_index:
   directory:
@@ -27,14 +27,14 @@ no_index:
   file:
     - README.pod
 requires:
-  Encode: 2.1
-  Try::Tiny: 0
-  perl: 5.008004
+  Encode: '2.1'
+  Try::Tiny: '0'
+  perl: '5.008004'
 resources:
   bugtracker: https://github.com/trinitum/perl-RedisDB-Parser/issues
   homepage: https://github.com/trinitum/perl-RedisDB-Parser
   license: http://dev.perl.org/licenses/
   repository: git://github.com/trinitum/perl-RedisDB-Parser
-version: 2.20
+version: '2.21'
 x_contributors:
   - 'Pavel Shaydo <zwon@cpan.org>'
@@ -10,7 +10,7 @@ INSTALLATION
         make install
 
 LICENSE AND COPYRIGHT
-    Copyright (C) 2013 Pavel Shaydo
+    Copyright (C) 2015 Pavel Shaydo
 
     This program is free software; you can redistribute it and/or modify it
     under the terms of either: the GNU General Public License as published
@@ -2,7 +2,7 @@ package RedisDB::Parser::Error;
 
 use strict;
 use warnings;
-our $VERSION = "2.20";
+our $VERSION = "2.21";
 $VERSION = eval $VERSION;
 
 =head1 NAME
@@ -39,6 +39,12 @@ Create new error object with specified error message.
 
 sub new {
     my ( $class, $message ) = @_;
+    if ( $message =~ /^MOVED / ) {
+        return "${class}::MOVED"->new($message);
+    }
+    elsif ( $message =~ /^ASK / ) {
+        return "${class}::ASK"->new($message);
+    }
     return bless { message => $message }, $class;
 }
 
@@ -52,6 +58,26 @@ sub as_string {
     return shift->{message};
 }
 
+package RedisDB::Parser::Error::MOVED;
+use strict;
+use warnings;
+our @ISA = qw(RedisDB::Parser::Error);
+
+sub new {
+    my ( $class, $message ) = @_;
+    my ( $type, $slot, $host, $port ) =
+      ( $message =~ /^(MOVED|ASK) \s ([0-9]+) \s ([0-9.]+):([0-9]+)$/x );
+    return bless {
+        slot    => $slot,
+        host    => $host,
+        port    => $port,
+        message => $message,
+    }, $class;
+}
+
+package RedisDB::Parser::Error::ASK;
+our @ISA = qw(RedisDB::Parser::Error::MOVED);
+
 1;
 
 __END__
@@ -66,7 +92,7 @@ Pavel Shaydo, C<< <zwon at cpan.org> >>
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright 2011-2013 Pavel Shaydo.
+Copyright 2011-2015 Pavel Shaydo.
 
 This program is free software; you can redistribute it and/or modify it
 under the terms of either: the GNU General Public License as published
@@ -2,7 +2,7 @@ package RedisDB::Parser::PP;
 
 use strict;
 use warnings;
-our $VERSION = "2.20";
+our $VERSION = "2.21";
 $VERSION = eval $VERSION;
 
 =head1 NAME
@@ -265,7 +265,7 @@ Pavel Shaydo, C<< <zwon at cpan.org> >>
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright 2011-2013 Pavel Shaydo.
+Copyright 2011-2015 Pavel Shaydo.
 
 This program is free software; you can redistribute it and/or modify it
 under the terms of either: the GNU General Public License as published
@@ -1,7 +1,7 @@
 package RedisDB::Parser::XS;
 use strict;
 use warnings;
-our $VERSION = "2.20";
+our $VERSION = "2.21";
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -43,7 +43,7 @@ Pavel Shaydo, C<< <zwon at cpan.org> >>
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright 2011-2013 Pavel Shaydo.
+Copyright 2011-2015 Pavel Shaydo.
 
 This program is free software; you can redistribute it and/or modify it
 under the terms of either: the GNU General Public License as published
@@ -2,7 +2,7 @@ package RedisDB::Parser;
 
 use strict;
 use warnings;
-our $VERSION = "2.20";
+our $VERSION = "2.21";
 $VERSION = eval $VERSION;
 
 use Try::Tiny;
@@ -177,7 +177,7 @@ Pavel Shaydo C<< <zwon at cpan.org> >>
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright 2011-2013 Pavel Shaydo.
+Copyright 2011-2015 Pavel Shaydo.
 
 This program is free software; you can redistribute it and/or modify it
 under the terms of either: the GNU General Public License as published
@@ -94,24 +94,32 @@ sub cb {
 
 sub one_line_reply {
     @replies = ();
-    $parser->push_callback( \&cb ) for 1 .. 3;
-    is $parser->callbacks, 3, "Three callbacks were added";
+    $parser->push_callback( \&cb ) for 1 .. 5;
+    is $parser->callbacks, 5, "Five callbacks were added";
     $parser->parse("+");
     is @replies, 0, "+";
     $parser->parse("OK");
     is @replies, 0, "+OK";
     $parser->parse("\015");
     is @replies, 0, "+OK\\r";
-    $parser->parse("\012+And here we have something long$lf-OK\015");
+    $parser->parse("\012+And here we have something long$lf-ERR");
     is @replies, 2, "Found 2 replies";
-    is $parser->callbacks, 1, "One callback left";
+    is $parser->callbacks, 3, "Three callbacks left";
     eq_or_diff \@replies, [ "OK", "And here we have something long" ],
       "OK, And here we have something long";
     @replies = ();
-    $parser->parse("OK$lf");
-    is @replies, 1, "Got a reply";
+    $parser->parse(" error$lf-MOVED 7777 127.0.0.2:3333$lf-ASK 8888 127.0.0.2:4444$lf");
+    is @replies, 3, "Got 3 replies";
     isa_ok $replies[0], "RedisDB::Parser::Error", "Got an error object";
-    eq_or_diff( "$replies[0]", "OK\015OK", "got an error reply with \\r in it" );
+    is $replies[0]{message}, 'ERR error', 'correct error message';
+    isa_ok $replies[1], "RedisDB::Parser::Error::MOVED", "Got an MOVED error object";
+    is $replies[1]{slot}, 7777,        'correct slot';
+    is $replies[1]{host}, '127.0.0.2', 'correct host';
+    is $replies[1]{port}, '3333',      'correct port';
+    isa_ok $replies[2], "RedisDB::Parser::Error::ASK", "Got an ASK error object";
+    is $replies[2]{slot}, 8888,        'correct slot';
+    is $replies[2]{host}, '127.0.0.2', 'correct host';
+    is $replies[2]{port}, '4444',      'correct port';
 }
 
 sub integer_reply {
@@ -176,12 +184,12 @@ sub nested_mb_reply {
           . "*3${lf}\$3${lf}set${lf}\$4${lf}test${lf}\$2${lf}43${lf}" );
     is @replies, 0, 'waits for the last chunk';
     $parser->parse(
-        "*4${lf}:3${lf}:1336734889${lf}:20${lf}" . "*2${lf}\$7${lf}slowlog${lf}\$3${lf}len${lf}" );
+        "*4${lf}:3${lf}:1336734889${lf}:20${lf}" . "*3${lf}\$7${lf}slowlog${lf}*2${lf}:1${lf}:2${lf}\$3${lf}len${lf}" );
     is @replies, 1, "Got a reply";
     my $exp = [
         [ 5, 1336734898, 43,  [ 'get',     'test' ], ],
         [ 4, 1336734895, 175, [ 'set',     'test', '43' ], ],
-        [ 3, 1336734889, 20,  [ 'slowlog', 'len' ], ],
+        [ 3, 1336734889, 20,  [ 'slowlog', [1, 2 ], 'len', ], ],
     ];
     eq_or_diff shift(@replies), $exp, 'got correct nested multi-bulk reply';
 }
@@ -213,12 +221,12 @@ sub transaction {
     is @replies, 1, 'Got a reply';
     eq_or_diff shift(@replies), [ [], 'OK', undef, [qw(aa bb)] ],
       "Parsed reply with empty list and undef";
-    $parser->parse("*3$lf*0$lf-Oops$lf+OK$lf");
+    $parser->parse("*3$lf*0$lf-ERR Oops$lf+OK$lf");
     is @replies, 1, 'Got a reply with error inside';
     my $reply = shift @replies;
     eq_or_diff $reply->[0], [], "  has empty list";
     isa_ok $reply->[1], "RedisDB::Parser::Error", "  has error object";
-    is "$reply->[1]", "Oops", "  Oops";
+    is "$reply->[1]", "ERR Oops", "ERR Oops";
     is $reply->[2], "OK", "  has OK";
 }
 
@@ -228,7 +236,7 @@ sub propagate_reply {
         $parser->push_callback( sub { push @replies, [ $var, "$_[1]" ] } );
     }
     $parser->set_default_callback( sub { push @replies, [ 0, "$_[1]" ] } );
-    $parser->propagate_reply( RedisDB::Parser::Error->new("Oops") );
+    $parser->propagate_reply( RedisDB::Parser::Error->new("ERR Oops") );
     ok ! $parser->callbacks, "No callbacks in the queue";
-    eq_or_diff [ sort { $a->[0] <=> $b->[0] } @replies ], [ map { [ $_, "Oops" ] } 0 .. 3 ], "All callbacks got the error";
+    eq_or_diff [ sort { $a->[0] <=> $b->[0] } @replies ], [ map { [ $_, "ERR Oops" ] } 0 .. 3 ], "All callbacks got the error";
 }