File Coverage

blib/lib/DBIx/SQLstate.pm
Criterion Covered Total %
statement 57 60 95.0
branch 7 12 58.3
condition 1 3 33.3
subroutine 14 17 82.3
pod 9 13 69.2
total 88 105 83.8


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__