File Coverage

blib/lib/DBIx/ParseError/MySQL.pm
Criterion Covered Total %
statement 35 35 100.0
branch 10 10 100.0
condition n/a
subroutine 10 10 100.0
pod n/a
total 55 55 100.0


line stmt bran cond sub pod time code
1             package DBIx::ParseError::MySQL;
2              
3 1     1   196602 use utf8;
  1         6  
  1         7  
4 1     1   31 use strict;
  1         3  
  1         19  
5 1     1   4 use warnings;
  1         2  
  1         24  
6              
7 1     1   577 use Moo;
  1         11655  
  1         4  
8              
9 1     1   1552 use Scalar::Util qw( blessed );
  1         3  
  1         51  
10 1     1   624 use Types::Standard qw( Str Bool Object );
  1         76045  
  1         11  
11              
12             # ABSTRACT: Error parser for MySQL
13 1     1   1543 use version;
  1         1880  
  1         6  
14             our $VERSION = 'v1.0.2'; # VERSION
15              
16             #pod =head1 SYNOPSIS
17             #pod
18             #pod use DBIx::ParseError::MySQL;
19             #pod
20             #pod eval {
21             #pod my $result = $dbh->do('SELECT 1');
22             #pod };
23             #pod if ($@) {
24             #pod if (DBIx::ParseError::MySQL->new($@)->is_transient) { $dbh->reconnect }
25             #pod else { die; }
26             #pod }
27             #pod
28             #pod =head1 DESCRIPTION
29             #pod
30             #pod This module is a database error categorizer, specifically for MySQL. This module is also
31             #pod compatible with Galera's WSREP errors.
32             #pod
33             #pod =head1 ATTRIBUTES
34             #pod
35             #pod =head1 orig_error
36             #pod
37             #pod Returns the original, untouched error object or string.
38             #pod
39             #pod =cut
40              
41             has orig_error => (
42             is => 'ro',
43             isa => Str|Object,
44             required => 1,
45             );
46              
47             #pod =head1 error_string
48             #pod
49             #pod Returns the stringified version of the error.
50             #pod
51             #pod =cut
52              
53             has error_string => (
54             is => 'lazy',
55             isa => Str,
56             init_arg => undef,
57             );
58              
59             sub _build_error_string {
60 23     23   205 my $self = shift;
61              
62             # All of the exception objects should support this, too.
63 23         392 return $self->orig_error."";
64             }
65              
66             #pod =head1 error_type
67             #pod
68             #pod Returns a string that describes the type of error. These can be one of the following:
69             #pod
70             #pod lock Lock errors, like a lock wait timeout or deadlock
71             #pod connection Connection/packet failures, disconnections
72             #pod shutdown Errors that happen when a server is shutting down
73             #pod duplicate_value Duplicate entry errors
74             #pod unknown Any other error
75             #pod
76             #pod =cut
77              
78             has error_type => (
79             is => 'lazy',
80             isa => Str,
81             init_arg => undef,
82             );
83              
84             sub _build_error_type {
85 23     23   1793 my $self = shift;
86              
87 23         364 my $error = $self->error_string;
88              
89             # We have to capture just the first error, not other errors that may be buried in the
90             # stack trace.
91 23         636 $error =~ s/ at [^\n]+ line \d+\.?\n.+//s;
92              
93             # Disable /x flag to allow for whitespace within string, but turn it on for newlines
94             # and comments.
95             #
96             # These error messages are purposely long and case-sensitive, because we're looking
97             # for these errors -anywhere- in the string. Best to get as exact of a match as
98             # possible.
99              
100             # Locks
101 23 100       249 return 'lock' if $error =~ m<
102             (?-x:Deadlock found when trying to get (?:user-level |locking service )?lock; try )(?:
103             (?-x:restarting transaction)|
104             (?-x:rolling back transaction/releasing locks and restarting lock acquisition)|
105             (?-x:releasing locks and restarting lock acquisition)
106             )|
107             (?-x:Lock wait timeout exceeded; try restarting transaction)|
108             (?-x:Service lock wait timeout exceeded)|
109             (?-x:WSREP detected deadlock/conflict and aborted the transaction.\s+Try restarting the transaction)
110             >x;
111              
112             # Various connection/packet problems
113 17 100       253 return 'connection' if $error =~ m<
114             # Connection dropped/interrupted
115             (?-x:MySQL server has gone away)|
116             (?-x:Lost connection to MySQL server)|
117             (?-x:Query execution was interrupted)|
118              
119             # Initial connection failure
120             (?-x:Bad handshake)|
121             (?-x:Too many connections)|
122             (?-x:Host '\S+' is blocked because of many connection errors)|
123             (?-x:Can't get hostname for your address)|
124             (?-x:Can't connect to (?:local )?MySQL server)|
125              
126             # Packet corruption
127             (?-x:Got a read error from the connection pipe)|
128             (?-x:Got (?:an error|timeout) (?:reading|writing) communication packets)|
129             (?-x:Malformed communication packet)
130             >x;
131              
132             # Failover/shutdown of node/server
133 7 100       65 return 'shutdown' if $error =~ m<
134             (?-x:WSREP has not yet prepared node for application use)|
135             (?-x:Server shutdown in progress)|
136             (?-x:Normal shutdown)|
137             (?-x:Shutdown complete)
138             >x;
139              
140             # Duplicate entry error
141 5 100       48 return 'duplicate_value' if $error =~ m<
142             # Any value can be in the first piece here...
143             (?-x:Duplicate entry '.+?' for key '\S+')
144             >xs; # include \n in .+
145              
146 3         50 return 'unknown';
147             }
148              
149              
150             #pod =head2 is_transient
151             #pod
152             #pod Returns a true value if the error is the type that is likely transient. For example,
153             #pod errors that recommend retrying transactions or connection failures. This check can be
154             #pod used to figure out if it's worth retrying a transaction.
155             #pod
156             #pod This is merely a check for the following L:
157             #pod C<< lock connection shutdown >>.
158             #pod
159             #pod =cut
160              
161             has is_transient => (
162             is => 'lazy',
163             isa => Bool,
164             init_arg => undef,
165             );
166              
167             sub _build_is_transient {
168 23     23   19231 my $self = shift;
169              
170 23         365 my $type = $self->error_type;
171              
172 23 100       461 return 1 if $type =~ /^(lock|connection|shutdown)$/;
173 5         76 return 0;
174             }
175              
176             #pod =head1 CONSTRUCTORS
177             #pod
178             #pod =head1 new
179             #pod
180             #pod my $parsed_error = DBIx::ParseError::MySQL->new($@);
181             #pod
182             #pod Returns a C object. Since the error is the only parameter, it
183             #pod can be passed by itself.
184             #pod
185             #pod =cut
186              
187             around BUILDARGS => sub {
188             my ($orig, $class, @args) = @_;
189              
190             if (@args == 1 && defined $args[0] && (!ref $args[0] || blessed $args[0])) {
191             my $error = shift @args;
192             push @args, ( orig_error => $error );
193             }
194              
195             return $class->$orig(@args);
196             };
197              
198             #pod =head1 SEE ALSO
199             #pod
200             #pod L - A similar parser, but specifically tailored to L.
201             #pod
202             #pod =cut
203              
204             1;
205              
206             __END__