line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::SQLstate; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
DBIx::SQLstate - message lookup and tokenization of SQL-State codes |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use DBI; |
12
|
|
|
|
|
|
|
use DBIx::SQLstate; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my $dbh = DBI->connect($data_source, $username, $password, |
15
|
|
|
|
|
|
|
{ |
16
|
|
|
|
|
|
|
HandleError => sub { |
17
|
|
|
|
|
|
|
my $msg = shift; |
18
|
|
|
|
|
|
|
my $h = shift; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $state = $h->state; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $message = sprintf("%s - %s", |
23
|
|
|
|
|
|
|
$state, DBIx::SQLstate->token($state) |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
die $message; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=cut |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
|
36
|
3
|
|
|
3
|
|
201400
|
use strict; |
|
3
|
|
|
|
|
25
|
|
|
3
|
|
|
|
|
91
|
|
37
|
3
|
|
|
3
|
|
18
|
use warnings; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
168
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
our $VERSION = 'v0.0.3'; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
our $DEFAULT_MESSAGE = 'Unkown SQL-state'; |
42
|
|
|
|
|
|
|
|
43
|
3
|
|
|
3
|
|
19
|
use Exporter qw/import/; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
1227
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
our @EXPORT = ( |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
our @EXPORT_OK = ( |
49
|
|
|
|
|
|
|
'sqlstate_codes', |
50
|
|
|
|
|
|
|
'sqlstate_message', |
51
|
|
|
|
|
|
|
'sqlstate_token', |
52
|
|
|
|
|
|
|
'sqlstate_class_codes', |
53
|
|
|
|
|
|
|
'sqlstate_class_message', |
54
|
|
|
|
|
|
|
'sqlstate_class_token', |
55
|
|
|
|
|
|
|
'sqlstate_default_message', |
56
|
|
|
|
|
|
|
'sqlstate_default_token', |
57
|
|
|
|
|
|
|
'sqlstate_class_codes', |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
61
|
|
|
|
|
|
|
message => [ |
62
|
|
|
|
|
|
|
'sqlstate_message', |
63
|
|
|
|
|
|
|
'sqlstate_class_message', |
64
|
|
|
|
|
|
|
'sqlstate_default_message', |
65
|
|
|
|
|
|
|
], |
66
|
|
|
|
|
|
|
token => [ |
67
|
|
|
|
|
|
|
'sqlstate_token', |
68
|
|
|
|
|
|
|
'sqlstate_class_token', |
69
|
|
|
|
|
|
|
'sqlstate_default_token', |
70
|
|
|
|
|
|
|
], |
71
|
|
|
|
|
|
|
); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
my %SQLstate = (); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub sqlstate_message ($) { |
80
|
236
|
50
|
|
236
|
1
|
364
|
return unless defined $_[0]; |
81
|
236
|
|
|
|
|
471
|
return $SQLstate{$_[0]}; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub sqlstate_token ($) { |
85
|
0
|
|
|
0
|
1
|
0
|
return tokenize( sqlstate_message(shift) ); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub sqlstate_class ($) { |
89
|
236
|
50
|
|
236
|
1
|
374
|
return unless defined $_[0]; |
90
|
236
|
|
|
|
|
468
|
return substr($_[0],0,2); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub sqlstate_class_message ($) { |
94
|
4
|
50
|
|
4
|
1
|
12
|
return unless defined $_[0]; |
95
|
4
|
|
|
|
|
12
|
return +{ sqlstate_class_codes() }->{sqlstate_class($_[0])}; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub sqlstate_class_token ($) { |
99
|
0
|
|
|
0
|
1
|
0
|
return tokenize( sqlstate_class_message(shift) ); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub sqlstate_default_message () { |
103
|
4
|
|
|
4
|
1
|
13
|
return $DEFAULT_MESSAGE; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub sqlstate_default_token () { |
107
|
0
|
|
|
0
|
1
|
0
|
return tokenize( sqlstate_default_message ); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub sqlstate_codes () { |
111
|
4
|
|
|
4
|
0
|
914
|
return %SQLstate; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub sqlstate_known_codes () { |
115
|
3
|
|
|
3
|
|
3415
|
use DBIx::SQLstate::wikipedia; |
|
3
|
|
|
|
|
12
|
|
|
3
|
|
|
|
|
1629
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
return ( |
118
|
3
|
|
|
3
|
0
|
355
|
%DBIx::SQLstate::wikipedia::SQLstate, |
119
|
|
|
|
|
|
|
); |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub sqlstate_class_codes () { |
123
|
|
|
|
|
|
|
my %sqlstate_class_codes = map { |
124
|
232
|
|
|
|
|
338
|
sqlstate_class($_) => sqlstate_message($_) |
125
|
4
|
|
|
4
|
0
|
8
|
} grep { /..000/ } keys %{{ sqlstate_codes() }}; |
|
1172
|
|
|
|
|
1909
|
|
|
4
|
|
|
|
|
11
|
|
126
|
|
|
|
|
|
|
|
127
|
4
|
|
|
|
|
217
|
return %sqlstate_class_codes; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub tokenize ($) { |
133
|
1
|
50
|
|
1
|
0
|
4
|
return if !defined $_[0]; |
134
|
|
|
|
|
|
|
|
135
|
1
|
|
|
|
|
17
|
my $text = shift; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# remove rubish first |
138
|
1
|
|
|
|
|
3
|
$text =~ s/,/ /ig; |
139
|
1
|
|
|
|
|
4
|
$text =~ s/-/ /ig; |
140
|
1
|
|
|
|
|
3
|
$text =~ s/_/ /ig; |
141
|
1
|
|
|
|
|
3
|
$text =~ s/\//_/ig; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# create special cases |
144
|
1
|
|
|
|
|
4
|
$text =~ s/sql /sql_/ig; |
145
|
1
|
|
|
|
|
3
|
$text =~ s/xml /xml_/ig; |
146
|
1
|
|
|
|
|
2
|
$text =~ s/cli /cli_/ig; |
147
|
1
|
|
|
|
|
3
|
$text =~ s/fdw /fdw_/ig; |
148
|
1
|
|
|
|
|
2
|
$text =~ s/null /null_/ig; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
1
|
|
|
|
|
5
|
$text = join qq(_), map { lc } split /_/, $text; |
|
1
|
|
|
|
|
6
|
|
152
|
1
|
50
|
33
|
|
|
9
|
$text = join qq(), map { ucfirst(lc($_)) } grep { $_ ne 'a' and $_ ne 'an' and $_ ne 'the' } split /\s+/, $text; |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
31
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# fix special cases |
155
|
1
|
|
|
|
|
4
|
$text =~ s/sql_/SQL/ig; |
156
|
1
|
|
|
|
|
3
|
$text =~ s/xml_/XML/ig; |
157
|
1
|
|
|
|
|
3
|
$text =~ s/cli_/CLI/ig; |
158
|
1
|
|
|
|
|
2
|
$text =~ s/fdw_/FDW/ig; |
159
|
1
|
|
|
|
|
2
|
$text =~ s/null_/NULL/ig; |
160
|
1
|
|
|
|
|
3
|
$text =~ s/xquery/XQuery/ig; |
161
|
|
|
|
|
|
|
|
162
|
1
|
|
|
|
|
8
|
return $text; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
%SQLstate = sqlstate_known_codes(); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 DESCRIPTION |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Database Management Systems, and L have their own way of reporting errors. |
174
|
|
|
|
|
|
|
Very often, errors are quit expressive in what happened. Many SQL based systems |
175
|
|
|
|
|
|
|
do also include a SQL-State with each request. This module turns the SQL-State 5 |
176
|
|
|
|
|
|
|
byte code into human readable strings. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head1 SQLSTATE Classes and Sub-Classes |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Programs calling a database which accords to the SQL standard receive an |
181
|
|
|
|
|
|
|
indication about the success or failure of the call. This return code - which is |
182
|
|
|
|
|
|
|
called SQLSTATE - consists of 5 bytes. They are divided into two parts: the |
183
|
|
|
|
|
|
|
first and second bytes contain a class and the following three a subclass. Each |
184
|
|
|
|
|
|
|
class belongs to one of four categories: "S" denotes "Success" (class 00), "W" |
185
|
|
|
|
|
|
|
denotes "Warning" (class 01), "N" denotes "No data" (class 02) and "X" denotes |
186
|
|
|
|
|
|
|
"Exception" (all other classes). |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=cut |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head1 CLASS METHODS |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
The following two class methods have been added for the programmer convenience: |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head2 C |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Returns a subclass-message or class-message for a given and exisitng SQLstate, |
199
|
|
|
|
|
|
|
or the default C<'Unkown SQL-state'>. |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
my $message = DBIx::SQLstate->message("25006"); |
202
|
|
|
|
|
|
|
# |
203
|
|
|
|
|
|
|
# "read-only SQL-transaction" |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 C |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Returns the tokenized (See L) version of the message from above. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$sqlstate = "22XXX"; # non existing code |
210
|
|
|
|
|
|
|
$LOG->error(DBIx::SQLstate->token $sqlstate) |
211
|
|
|
|
|
|
|
# |
212
|
|
|
|
|
|
|
# logs an error with "DataException" |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=cut |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=head1 EXPORT_OK SUBROUTINES |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head2 C |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
Returns the human readable message defined for the given SQL-State code. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
my $sqlstate = '25006'; |
225
|
|
|
|
|
|
|
say sqlstate_message(); |
226
|
|
|
|
|
|
|
# |
227
|
|
|
|
|
|
|
# prints "read-only SQL-transaction" |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head2 C |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Returns a tokenized string (See L). |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
my $sqlstate = '01007'; |
234
|
|
|
|
|
|
|
$LOG->warn sqlstate_token($sqlstate); |
235
|
|
|
|
|
|
|
# |
236
|
|
|
|
|
|
|
# logs a warning message with "PrivilegeNotGranted" |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head2 C |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
Returns the 2-byte SQL-state class code. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head2 C |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Returns the human readable message for the SQL-state class. This might be useful |
245
|
|
|
|
|
|
|
reduce the amount of variations of log-messages. But since not all SQLstate |
246
|
|
|
|
|
|
|
codes might be present in the current table, this will provide a decent fallback |
247
|
|
|
|
|
|
|
message. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
my $sqlstate = '22X00'; # a madeup code |
250
|
|
|
|
|
|
|
my $m = sqlstate_message($sqlstate) // sqlstate_class_message($sqlstate); |
251
|
|
|
|
|
|
|
say $m; |
252
|
|
|
|
|
|
|
# |
253
|
|
|
|
|
|
|
# prints "data exception" |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head2 C |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Returns the tokenized string for the above L. See |
258
|
|
|
|
|
|
|
L. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=head2 C |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Returns a default message. The value can be set with |
263
|
|
|
|
|
|
|
C, and defaults to C<'Unkown SQL-state'>. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head2 C |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Returns the tokenized version of the default message. |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=head1 Tokenization |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
The tokenized strings can be useful in logging, or for L ( or |
272
|
|
|
|
|
|
|
L) object creations etc. These are mostly camel-case. However, |
273
|
|
|
|
|
|
|
for some common abreviations, like 'SQL', 'XML' or 'XQuery' this module tries to |
274
|
|
|
|
|
|
|
correct the charactercase-folding. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
For now, do not rely on the consitent case-folding, it may change in the future. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=cut |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub message ($) { |
283
|
4
|
|
|
4
|
1
|
94
|
my $class = shift; |
284
|
4
|
|
|
|
|
9
|
my $sqlstate = shift; |
285
|
|
|
|
|
|
|
|
286
|
4
|
|
|
|
|
13
|
for ( |
287
|
|
|
|
|
|
|
sqlstate_message($sqlstate), |
288
|
|
|
|
|
|
|
sqlstate_class_message($sqlstate), |
289
|
|
|
|
|
|
|
sqlstate_default_message(), |
290
|
7
|
100
|
|
|
|
37
|
) { return $_ if defined $_ } |
291
|
|
|
|
|
|
|
; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub token ($) { |
295
|
1
|
|
|
1
|
1
|
92
|
my $class = shift; |
296
|
1
|
|
|
|
|
2
|
my $sqlstate = shift; |
297
|
|
|
|
|
|
|
|
298
|
1
|
|
|
|
|
6
|
my $message = $class->message($sqlstate); |
299
|
|
|
|
|
|
|
|
300
|
1
|
|
|
|
|
3
|
return tokenize($message); |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
1; |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=head1 AUTHOR |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
Theo van Hoesel |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
'DBIx::SQLstate' |
318
|
|
|
|
|
|
|
is Copyright (C) 2023, Perceptyx Inc |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it under |
321
|
|
|
|
|
|
|
the terms of the Artistic License 2.0. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
This package is distributed in the hope that it will be useful, but it is |
324
|
|
|
|
|
|
|
provided "as is" and without any express or implied warranties. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
For details, see the full text of the license in the file LICENSE. |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=cut |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
__END__ |