File Coverage

blib/lib/RedisDB/Parser/Error.pm
Criterion Covered Total %
statement 24 24 100.0
branch 4 4 100.0
condition n/a
subroutine 8 8 100.0
pod 2 2 100.0
total 38 38 100.0


line stmt bran cond sub pod time code
1             package RedisDB::Parser::Error;
2              
3 3     3   15 use strict;
  3         5  
  3         71  
4 3     3   13 use warnings;
  3         8  
  3         183  
5             our $VERSION = "2.23";
6             $VERSION = eval $VERSION;
7              
8             =head1 NAME
9              
10             RedisDB::Parser::Error - default error class for RedisDB::Parser
11              
12             =head1 SYNOPSIS
13              
14             use Scalar::Util qw(blessed);
15             ...;
16             sub callback {
17             my ( $master, $reply ) = @_;
18             die "$reply" if blessed $reply; # it's more like damned
19             ...; # do something with reply
20             }
21              
22             =head1 DESCRIPTION
23              
24             Then RedisDB::Parser parses error response from server it creates an object of
25             this class and passes it to callback. In string context object returns the
26             error message from the server.
27              
28             =head1 METHODS
29              
30             =cut
31              
32 3     3   958 use overload '""' => \&as_string;
  3         729  
  3         26  
33              
34             =head2 $class->new($message)
35              
36             Create new error object with specified error message.
37              
38             =cut
39              
40             sub new {
41 10     10 1 25431 my ( $class, $message ) = @_;
42 10 100       32 if ( $message =~ /^MOVED / ) {
    100          
43 2         8 return "${class}::MOVED"->new($message);
44             }
45             elsif ( $message =~ /^ASK / ) {
46 2         9 return "${class}::ASK"->new($message);
47             }
48 6         26 return bless { message => $message }, $class;
49             }
50              
51             =head2 $self->as_string
52              
53             Return error message. Also you can just use object in string context.
54              
55             =cut
56              
57             sub as_string {
58 10     10 1 2875 return shift->{message};
59             }
60              
61             package RedisDB::Parser::Error::MOVED;
62 3     3   510 use strict;
  3         6  
  3         69  
63 3     3   12 use warnings;
  3         6  
  3         461  
64             our @ISA = qw(RedisDB::Parser::Error);
65              
66             sub new {
67 4     4   6 my ( $class, $message ) = @_;
68 4         21 my ( $type, $slot, $host, $port ) =
69             ( $message =~ /^(MOVED|ASK) \s ([0-9]+) \s ([0-9.]+):([0-9]+)$/x );
70 4         20 return bless {
71             slot => $slot,
72             host => $host,
73             port => $port,
74             message => $message,
75             }, $class;
76             }
77              
78             package RedisDB::Parser::Error::ASK;
79             our @ISA = qw(RedisDB::Parser::Error::MOVED);
80              
81             1;
82              
83             __END__