The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

ZWON / RedisDB-Parser-2.23 / lib / RedisDB / Parser / Error.pm 

            

              
1
2
3
4
5
6
—
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
—
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
—
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
—
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

              
package RedisDB::Parser::Error;
use strict;
use warnings;
our $VERSION = "2.23";
$VERSION = eval $VERSION;
=head1 NAME
RedisDB::Parser::Error - default error class for RedisDB::Parser
=head1 SYNOPSIS
    use Scalar::Util qw(blessed);
    ...;
    sub callback {
        my ( $master, $reply ) = @_;
        die "$reply" if blessed $reply;    # it's more like damned
        ...;                               # do something with reply
    }
=head1 DESCRIPTION
Then RedisDB::Parser parses error response from server it creates an object of
this class and passes it to callback. In string context object returns the
error message from the server.
=head1 METHODS
=cut
use overload '""' => \&as_string;
=head2 $class->new($message)
Create new error object with specified error message.
=cut
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;
}
=head2 $self->as_string
Return error message. Also you can just use object in string context.
=cut
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__
=head1 SEE ALSO
L<RedisDB::Parser>
=head1 AUTHOR
Pavel Shaydo, C<< <zwon at cpan.org> >>
=head1 LICENSE AND COPYRIGHT
Copyright 2011-2015,2018 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
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut