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 4     4   22 use strict;
  4         8  
  4         114  
4 4     4   23 use warnings;
  4         35  
  4         306  
5             our $VERSION = "2.22";
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 4     4   4322 use overload '""' => \&as_string;
  4         2996  
  4         45  
33              
34             =head2 $class->new($message)
35              
36             Create new error object with specified error message.
37              
38             =cut
39              
40             sub new {
41 14     14 1 31804 my ( $class, $message ) = @_;
42 14 100       1207 if ( $message =~ /^MOVED / ) {
    100          
43 2         15 return "${class}::MOVED"->new($message);
44             }
45             elsif ( $message =~ /^ASK / ) {
46 2         17 return "${class}::ASK"->new($message);
47             }
48 10         2302 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 3445 return shift->{message};
59             }
60              
61             package RedisDB::Parser::Error::MOVED;
62 4     4   979 use strict;
  4         7  
  4         144  
63 4     4   30 use warnings;
  4         9  
  4         872  
64             our @ISA = qw(RedisDB::Parser::Error);
65              
66             sub new {
67 4     4   7 my ( $class, $message ) = @_;
68 4         25 my ( $type, $slot, $host, $port ) =
69             ( $message =~ /^(MOVED|ASK) \s ([0-9]+) \s ([0-9.]+):([0-9]+)$/x );
70 4         30 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__