Codebase list libexception-class-dbi-perl / upstream/1.00
[svn-inject] Installing original source of libexception-class-dbi-perl (1.00) Nicholas Bamber 13 years ago
13 changed file(s) with 1231 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
0 use Module::Build;
1
2 my $build = Module::Build->new(
3 module_name => 'Exception::Class::DBI',
4 license => 'perl',
5 create_makefile_pl => 'passthrough',
6 configure_requires => { 'Module::Build' => '0.2701' },
7 recommends => { 'Test::Pod' => '1.20' },
8 build_requires => {
9 'Module::Build' => '0.2701',
10 'Test::More' => '0.17',
11 'Test::Harness' => '2.03',
12 },
13 requires => {
14 'DBI' => '1.28',
15 'Exception::Class' => '1.02',
16 },
17 );
18 $build->create_build_script;
0 Revision history for Perl extension Exception::Class::DBI.
1
2 1.00 2008-05-22T03:28:50
3 - Fixed a test failure on Perl 5.5. Reported by Slaven Rezic.
4
5 0.99 2008-05-15T03:31:30
6 - Fixed another Perl 5.6.2 test error. Reported by Slaven Rezic.
7
8 0.98 2008-05-06T17:53:25
9 - Fixed strange test failures on Perl 5.6.2. Somehow tests are getting
10 run more than once, resulting in strange failures. I got 'round this
11 issue by putting an explicit `exit;` at the end of each test script.
12 Reported by David Cantrell.
13
14 0.97 2008-05-05T19:10:05
15 - Updated copyright.
16 - Added a link to the Subversion repository.
17 - Fixed test failures on Perl 5.6.2.
18
19 0.96 2007-10-26T19:01:36
20 - Fixed test failure due to the change in value of $dbh->err in DBI
21 1.601. First reported by Andreas J. König; fix suggested by Tim
22 Bunce.
23 - Added the "configure_requires", and "recommends" parameters to
24 Build.PL.
25 - Updated the POD test to properly make use of Test::POD 1.20 or
26 newer.
27
28 0.95 2006-07-18T22:14:41
29 - Fixed test failure for localized error messages. Reported by Jens
30 Maier with a fix from Daniel Brook.
31 - Updated tests to use is($foo, $bar) instead of ok($foo == $bar)
32 Spotted by Andy Lester.
33
34 0.94 2006-06-30T00:04:32
35 - The handler() method now always returns the same code referernce
36 each time it's called for a given subclass. This behavior prevents
37 the DBI connect_cached() method from caching a new database handle
38 every time it's called, which could otherwise be pretty annoying.
39
40 0.93 2006-06-10T02:09:14
41 - Reformatted some of the code and documentation so that it's
42 easier to read.
43 - Added 'handle' attribute to store the DBI handle for which the
44 exception was thrown.
45 - Switched to explicit accessors that reach in to the cached database
46 handle stored. Suggested by Tim Bunce ages ago!
47 - Added support for subclassing Exception::Class::DBI and its
48 subclasses.
49
50 0.92 2004-06-17T17:42:37
51 - Fixed test that was breaking with newer versions of DBI.
52
53 0.91 Tue Aug 26 02:25:56 2003
54 - Switched to Module::Build.
55 - Throwing exceptions with the "throw()" method, rather than
56 die'ing with the construction of exceptions with the "new()"
57 constructor.
58 - Added POD tests.
59
60 0.90 Thu Dec 12 20:16:14 2002
61 - Updated tests for Changes in DBI 1.30. Connection failures
62 can now throw exceptions!
63 - Removed TODO tests in sth.t. Tim has said that DBI attributes
64 that return ARRAYs or HASHes will return undef when they're
65 empty, rather than return emtpy ARRAYs or HASHes.
66 - Incremented version to 0.90 to indicate high level of stability.
67
68 0.02 Tue Sep 17 03:33:56 2002
69 - Documentation tweaks.
70 - Fixed test to pass with Perl 5.6.1 and earlier.
71
72 0.01 Fri Aug 23 19:50:45 2002
73 - Initial Release to the CPAN.
74
0 Build.PL
1 Changes
2 lib/Exception/Class/DBI.pm
3 Makefile.PL
4 MANIFEST This list of files
5 META.yml
6 README
7 t/dbh.t
8 t/dbi.t
9 t/drh.t
10 t/sth.t
11 t/subclass.t
12 t/z_pod.t
0 ---
1 name: Exception-Class-DBI
2 version: 1.00
3 author:
4 - 'David Wheeler <david@kineticode.com>'
5 abstract: DBI Exception objects
6 license: perl
7 resources:
8 license: http://dev.perl.org/licenses/
9 configure_requires:
10 Module::Build: 0.2701
11 requires:
12 DBI: 1.28
13 Exception::Class: 1.02
14 build_requires:
15 Module::Build: 0.2701
16 Test::Harness: 2.03
17 Test::More: 0.17
18 recommends:
19 Test::Pod: 1.20
20 provides:
21 Exception::Class::DBI:
22 file: lib/Exception/Class/DBI.pm
23 version: 1.00
24 Exception::Class::DBI::DBH:
25 file: lib/Exception/Class/DBI.pm
26 Exception::Class::DBI::H:
27 file: lib/Exception/Class/DBI.pm
28 Exception::Class::DBI::STH:
29 file: lib/Exception/Class/DBI.pm
30 generated_by: Module::Build version 0.280801
31 meta-spec:
32 url: http://module-build.sourceforge.net/META-spec-v1.2.html
33 version: 1.2
0 # Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
1
2 unless (eval "use Module::Build::Compat 0.02; 1" ) {
3 print "This module requires Module::Build to install itself.\n";
4
5 require ExtUtils::MakeMaker;
6 my $yn = ExtUtils::MakeMaker::prompt
7 (' Install Module::Build now from CPAN?', 'y');
8
9 unless ($yn =~ /^y/i) {
10 die " *** Cannot install without Module::Build. Exiting ...\n";
11 }
12
13 require Cwd;
14 require File::Spec;
15 require CPAN;
16
17 # Save this 'cause CPAN will chdir all over the place.
18 my $cwd = Cwd::cwd();
19
20 CPAN::Shell->install('Module::Build::Compat');
21 CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
22 or die "Couldn't install Module::Build, giving up.\n";
23
24 chdir $cwd or die "Cannot chdir() back to $cwd: $!";
25 }
26 eval "use Module::Build::Compat 0.02; 1" or die $@;
27
28 Module::Build::Compat->run_build_pl(args => \@ARGV);
29 require Module::Build;
30 Module::Build::Compat->write_makefile(build_class => 'Module::Build');
0 Exception/Class/DBI version 1.00
1 ================================
2
3 This module offers a set of DBI-specific exception classes. They inherit from
4 Exception::Class::Base, the base class for all exception objects created by
5 the Exception::Class module from the CPAN. Exception::Class::DBI itself offers
6 a single class method, C<handler()>, that returns a code reference appropriate
7 for passing the DBI C<HandleError> attribute.
8
9 The exception classes created by Exception::Class::DBI are designed to be
10 thrown in certain DBI contexts; the code reference returned by handler() and
11 passed to the DBI C<HandleError> attribute determines the context, assembles
12 the necessary metadata, and throws the apopropriate exception.
13
14 Each of the Exception::Class::DBI classes offers a set of object accessor
15 methods in addition to those provided by Exception::Class::Base. These can be
16 used to output detailed output in the event of an exception.
17
18 INSTALLATION
19
20 To install this module, type the following:
21
22 perl Build.PL
23 ./Build
24 ./Build test
25 ./Build install
26
27 Or, if you don't have Module::Build installed, type the following:
28
29 perl Makefile.PL
30 make
31 make test
32 make install
33
34 DEPENDENCIES
35
36 This module requires these other modules and libraries:
37
38 DBI 1.28 or later (1.30 or later strongly recommended).
39 Exception::Class 1.02 or later (1.05 or later strongly recommended).
40 Test::Simple 0.40 (for testing).
41
42 COPYRIGHT AND LICENCE
43
44 Copyright (c) 2002-2008, David Wheeler. Some Rights Reserved.
45
46 This module is free software; you can redistribute it and/or modify it under
47 the same terms as Perl itself.
48
0 package Exception::Class::DBI;
1
2 # $Id: DBI.pm 3906 2008-05-15 03:28:13Z david $
3
4 use 5.00500;
5 use strict;
6 use Exception::Class;
7 use vars qw($VERSION);
8 $VERSION = '1.00';
9
10 use Exception::Class (
11 'Exception::Class::DBI' => {
12 description => 'DBI exception',
13 fields => [qw(err errstr state retval handle)]
14 },
15
16 'Exception::Class::DBI::Unknown' => {
17 isa => 'Exception::Class::DBI',
18 description => 'DBI unknown exception'
19 },
20
21 'Exception::Class::DBI::H' => {
22 isa => 'Exception::Class::DBI',
23 description => 'DBI handle exception',
24 },
25
26 'Exception::Class::DBI::DRH' => {
27 isa => 'Exception::Class::DBI::H',
28 description => 'DBI driver handle exception',
29 },
30
31 'Exception::Class::DBI::DBH' => {
32 isa => 'Exception::Class::DBI::H',
33 description => 'DBI database handle exception',
34 },
35
36 'Exception::Class::DBI::STH' => {
37 isa => 'Exception::Class::DBI::H',
38 description => 'DBI statment handle exception',
39 }
40 );
41
42 my %handlers;
43 sub handler {
44 my $pkg = shift;
45 return $handlers{$pkg} if $handlers{$pkg};
46
47 # Support subclasses.
48 my %class_for = map {
49 $_ => do {
50 my $class = "$pkg\::$_";
51 my $base = __PACKAGE__ . "::$_";
52 no strict 'refs';
53 # Try to load the subclass and check its inheritance.
54 eval "require $class" unless @{"$class\::ISA"};
55 my $isa = \@{"$class\::ISA"};
56 die "$class is not a subclass of $base"
57 if $isa && !$class->isa($base);
58 # If subclass exists and inherits, use it. Otherwise use default.
59 $isa ? $class : $base;
60 }
61 } qw(H DRH DBH STH Unknown);
62
63 return $handlers{$pkg} = sub {
64 my ($err, $dbh, $retval) = @_;
65
66 # No handle, no choice.
67 $pkg->throw(
68 error => $err,
69 retval => $retval
70 ) unless ref($dbh ||= $DBI::lasth);
71
72 # Assemble arguments for a handle exception.
73 my @params = (
74 error => $err,
75 errstr => $dbh->errstr,
76 err => $dbh->err,
77 state => $dbh->state,
78 retval => $retval,
79 handle => $dbh,
80 );
81
82 # Throw the proper exception.
83 $class_for{STH}->throw(@params) if eval { $dbh->isa('DBI::st') };
84 $class_for{DBH}->throw(@params) if eval { $dbh->isa('DBI::db') };
85 $class_for{DRH}->throw(@params) if eval { $dbh->isa('DBI::dr') };
86
87 # Unknown exception. This shouldn't happen.
88 $class_for{Unknown}->throw(@params);
89 };
90 }
91
92 package Exception::Class::DBI::H;
93 sub warn { shift->handle->{Warn} }
94 sub active { shift->handle->{Active} }
95 sub kids { shift->handle->{Kids} }
96 sub active_kids { shift->handle->{ActiveKids} }
97 sub compat_mode { shift->handle->{CompatMode} }
98 sub inactive_destroy { shift->handle->{InactiveDestroy} }
99 sub trace_level { shift->handle->{TraceLevel} }
100 sub fetch_hash_key_name { shift->handle->{FetchHashKeyName} }
101 sub chop_blanks { shift->handle->{ChopBlanks} }
102 sub long_read_len { shift->handle->{LongReadLen} }
103 sub long_trunc_ok { shift->handle->{LongTruncOk} }
104 sub taint { shift->handle->{Taint} }
105
106 package Exception::Class::DBI::DBH;
107 sub auto_commit { shift->handle->{AutoCommit} }
108 sub db_name { shift->handle->{Name} }
109 sub statement { shift->handle->{Statement} }
110 sub row_cache_size { shift->handle->{RowCacheSize} }
111
112 package Exception::Class::DBI::STH;
113 sub num_of_fields { shift->handle->{NUM_OF_FIELDS} }
114 sub num_of_params { shift->handle->{NUM_OF_PARAMS} }
115 sub field_names { shift->handle->{NAME} }
116 sub type { shift->handle->{TYPE} }
117 sub precision { shift->handle->{PRECISION} }
118 sub scale { shift->handle->{SCALE} }
119 sub nullable { shift->handle->{NULLABLE} }
120 sub cursor_name { shift->handle->{CursorName} }
121 sub param_values { shift->handle->{ParamValues} }
122 sub statement { shift->handle->{Statement} }
123 sub rows_in_cache { shift->handle->{RowsInCache} }
124
125 1;
126 __END__
127
128 =begin comment
129
130 Fake-out Module::Build. Delete if it ever changes to support =head1 headers
131 other than all uppercase.
132
133 =head1 NAME
134
135 Exception::Class::DBI - DBI Exception objects
136
137 =end comment
138
139 =head1 Name
140
141 Exception::Class::DBI - DBI Exception objects
142
143 =head1 Synopsis
144
145 use DBI;
146 use Exception::Class::DBI;
147
148 my $dbh = DBI->connect($dsn, $user, $pass, {
149 PrintError => 0,
150 RaiseError => 0,
151 HandleError => Exception::Class::DBI->handler,
152 });
153
154 eval { $dbh->do($sql) };
155
156 if (my $ex = $@) {
157 print STDERR "DBI Exception:\n";
158 print STDERR " Exception Type: ", ref $ex, "\n";
159 print STDERR " Error: ", $ex->error, "\n";
160 print STDERR " Err: ", $ex->err, "\n";
161 print STDERR " Errstr: ", $ex->errstr, "\n";
162 print STDERR " State: ", $ex->state, "\n";
163 print STDERR " Return Value: ", ($ex->retval || 'undef'), "\n";
164 }
165
166 =head1 Description
167
168 This module offers a set of DBI-specific exception classes. They inherit from
169 Exception::Class, the base class for all exception objects created by the
170 L<Exception::Class|Exception::Class> module from the CPAN.
171 Exception::Class::DBI itself offers a single class method, C<handler()>, that
172 returns a code reference appropriate for passing to the DBI C<HandleError>
173 attribute.
174
175 The exception classes created by Exception::Class::DBI are designed to be
176 thrown in certain DBI contexts; the code reference returned by C<handler()>
177 and passed to the DBI C<HandleError> attribute determines the context and
178 throws the apopropriate exception.
179
180 Each of the Exception::Class::DBI classes offers a set of object accessor
181 methods in addition to those provided by Exception::Class. These can be used
182 to output detailed diagnostic information in the event of an exception.
183
184 =head1 Interface
185
186 Exception::Class::DBI inherits from Exception::Class, and thus its entire
187 interface. Refer to the Exception::Class documentation for details.
188
189 =head2 Class Method
190
191 =over 4
192
193 =item C<handler>
194
195 my $dbh = DBI->connect($data_source, $username, $auth, {
196 PrintError => 0,
197 RaiseError => 0,
198 HandleError => Exception::Class::DBI->handler
199 });
200
201 This method returns a code reference appropriate for passing to the DBI
202 C<HandleError> attribute. When DBI encounters an error, it checks its
203 C<PrintError>, C<RaiseError>, and C<HandleError> attributes to decide what to
204 do about it. When C<HandleError> has been set to a code reference, DBI
205 executes it, passing it the error string that would be printed for
206 C<PrintError>, the DBI handle object that was executing the method call that
207 triggered the error, and the return value of that method call (usually
208 C<undef>). Using these arguments, the code reference provided by C<handler()>
209 determines what type of exception to throw. Exception::Class::DBI contains the
210 subclasses detailed below, each relevant to the DBI handle that triggered the
211 error.
212
213 =back
214
215 =head1 Classes
216
217 Exception::Class::DBI creates a number of exception classes, each one specific
218 to a particular DBI error context. Most of the object methods described below
219 correspond to like-named attributes in the DBI itself. Thus the documentation
220 below summarizes the DBI attribute documentation, so you should refer to
221 L<DBI|DBI> itself for more in-depth information.
222
223 =head2 Exception::Class::DBI
224
225 All of the Exception::Class::DBI classes documented below inherit from
226 Exception::Class::DBI. It offers the several object methods in addition to
227 those it inherits from I<its> parent, Exception::Class. These methods
228 correspond to the L<DBI dynamic attributes|DBI/"DBI Dynamic Attributes">, as
229 well as to the values passed to the C<handler()> exception handler via the DBI
230 C<HandleError> attribute. Exceptions of this base class are only thrown when
231 there is no DBI handle object executing, e.g. in the DBI C<connect()>
232 method. B<Note:> This functionality is not yet implemented in DBI -- see the
233 discusion that starts here:
234 L<http://archive.develooper.com/dbi-dev@perl.org/msg01438.html>.
235
236 =over 4
237
238 =item C<error>
239
240 my $error = $ex->error;
241
242 Exception::Class::DBI actually inherits this method from Exception::Class. It
243 contains the error string that DBI prints when its C<PrintError> attribute is
244 enabled, or C<die>s with when its <RaiseError> attribute is enabled.
245
246 =item C<err>
247
248 my $err = $ex->err;
249
250 Corresponds to the C<$DBI::err> dynamic attribute. Returns the native database
251 engine error code from the last driver method called.
252
253 =item C<errstr>
254
255 my $errstr = $ex->errstr;
256
257 Corresponds to the C<$DBI::errstr> dynamic attribute. Returns the native
258 database engine error message from the last driver method called.
259
260 =item C<state>
261
262 my $state = $ex->state;
263
264 Corresponds to the C<$DBI::state> dynamic attribute. Returns an error code in
265 the standard SQLSTATE five character format.
266
267 =item C<retval>
268
269 my $retval = $ex->retval;
270
271 The first value being returned by the DBI method that failed (typically
272 C<undef>).
273
274 =item C<handle>
275
276 my $db_handle = $ex->handle;
277
278 The DBI handle appropriate to the exception class. For
279 Exception::Class::DBI::DRH, it will be a driver handle. For
280 Exception::Class::DBI::DBH it will be a database handle. And for
281 Exception::Class::DBI::STH it will be a statement handle. If there is no
282 handle thrown in the exception (because, say, the exception was thrown before
283 a driver handle could be created), the C<handle> will be C<undef>.
284
285 =back
286
287 =head2 Exception::Class::DBI::H
288
289 This class inherits from L<Exception::Class::DBI|"Exception::Class::DBI">, and
290 is the base class for all DBI handle exceptions (see below). It will not be
291 thrown directly. Its methods correspond to the L<DBI attributes common to all
292 handles|DBI/"ATTRIBUTES COMMON TO ALL HANDLES">.
293
294 =over 4
295
296 =item C<warn>
297
298 my $warn = $ex->warn;
299
300 Boolean value indicating whether DBI warnings have been enabled. Corresponds
301 to the DBI C<Warn> attribute.
302
303 =item C<active>
304
305 my $active = $ex->active;
306
307 Boolean value indicating whether the DBI handle that encountered the error is
308 active. Corresponds to the DBI C<Active> attribute.
309
310 =item C<kids>
311
312 my $kids = $ex->kids;
313
314 For a driver handle, Kids is the number of currently existing database handles
315 that were created from that driver handle. For a database handle, Kids is the
316 number of currently existing statement handles that were created from that
317 database handle. Corresponds to the DBI C<Kids> attribute.
318
319 =item C<active_kids>
320
321 my $active_kids = $ex->active_kids;
322
323 Like C<kids>, but only counting those that are C<active> (as
324 above). Corresponds to the DBI C<ActiveKids> attribute.
325
326 =item C<compat_mode>
327
328 my $compat_mode = $ex->compat_mode;
329
330 Boolean value indicating whether an emulation layer (such as Oraperl) enables
331 compatible behavior in the underlying driver (e.g., DBD::Oracle) for this
332 handle. Corresponds to the DBI C<CompatMode> attribute.
333
334 =item C<inactive_destroy>
335
336 my $inactive_destroy = $ex->inactive_destroy;
337
338 Boolean value indicating whether the DBI has disabled the database engine
339 related effect of C<DESTROY>ing a handle. Corresponds to the DBI
340 C<InactiveDestroy> attribute.
341
342 =item C<trace_level>
343
344 my $trace_level = $ex->trace_level;
345
346 Returns the DBI trace level set on the handle that encountered the
347 error. Corresponds to the DBI C<TraceLevel> attribute.
348
349 =item C<fetch_hash_key_name>
350
351 my $fetch_hash_key_name = $ex->fetch_hash_key_name;
352
353 Returns the attribute name the DBI C<fetchrow_hashref()> method should use to
354 get the field names for the hash keys. Corresponds to the DBI
355 C<FetchHashKeyName> attribute.
356
357 =item C<chop_blanks>
358
359 my $chop_blanks = $ex->chop_blanks;
360
361 Boolean value indicating whether DBI trims trailing space characters from
362 fixed width character (CHAR) fields. Corresponds to the DBI C<ChopBlanks>
363 attribute.
364
365 =item C<long_read_len>
366
367 my $long_read_len = $ex->long_read_len;
368
369 Returns the maximum length of long fields ("blob", "memo", etc.) which the DBI
370 driver will read from the database automatically when it fetches each row of
371 data. Corresponds to the DBI C<LongReadLen> attribute.
372
373 =item C<long_trunc_ok>
374
375 my $long_trunc_ok = $ex->long_trunc_ok;
376
377 Boolean value indicating whether the DBI will truncate values it retrieves from
378 long fields that are longer than the value returned by
379 C<long_read_len()>. Corresponds to the DBI C<LongTruncOk> attribute.
380
381 =item C<taint>
382
383 my $taint = $ex->taint;
384
385 Boolean value indicating whether data fetched from the database is considered
386 tainted. Corresponds to the DBI C<Taint> attribute.
387
388 =back
389
390 =head2 Exception::Class::DBI::DRH
391
392 DBI driver handle exceptions objects. This class inherits from
393 L<Exception::Class::DBI::H|"Exception::Class::DBI::H">, and offers no extra
394 methods of its own.
395
396 =head2 Exception::Class::DBI::DBH
397
398 DBI database handle exceptions objects. This class inherits from
399 L<Exception::Class::DBI::H|"Exception::Class::DBI::H"> Its methods correspond
400 to the L<DBI database handle attributes|DBI/"Database Handle Attributes">.
401
402 =over 4
403
404 =item C<auto_commit>
405
406 my $auto_commit = $ex->auto_commit;
407
408 Returns true if the database handle C<AutoCommit> attribute is
409 enabled. meaning that database changes cannot be rolled back. Corresponds to
410 the DBI database handle C<AutoCommit> attribute.
411
412 =item C<db_name>
413
414 my $db_name = $ex->db_name;
415
416 Returns the "name" of the database. Corresponds to the DBI database handle
417 C<Name> attribute.
418
419 =item C<statement>
420
421 my $statement = $ex->statement;
422
423 Returns the statement string passed to the most recent call to the DBI
424 C<prepare()> method in this database handle. If it was the C<prepare()> method
425 that encountered the error and triggered the exception, the statement string
426 will be the statement passed to C<prepare()>. Corresponds to the DBI database
427 handle C<Statement> attribute.
428
429 =item C<row_cache_size>
430
431 my $row_cache_size = $ex->row_cache_size;
432
433 Returns the hint to the database driver indicating the size of the local row
434 cache that the application would like the driver to use for future C<SELECT>
435 statements. Corresponds to the DBI database handle C<RowCacheSize> attribute.
436
437 =back
438
439 =head2 Exception::Class::DBI::STH
440
441 DBI statement handle exceptions objects. This class inherits from
442 L<Exception::Class::DBI::H|"Exception::Class::DBI::H"> Its methods correspond
443 to the L<DBI statement handle attributes|DBI/"Statement Handle Attributes">.
444
445 =over 4
446
447 =item C<num_of_fields>
448
449 my $num_of_fields = $ex->num_of_fields;
450
451 Returns the number of fields (columns) the prepared statement will
452 return. Corresponds to the DBI statement handle C<NUM_OF_FIELDS> attribute.
453
454 =item C<num_of_params>
455
456 my $num_of_params = $ex->num_of_params;
457
458 Returns the number of parameters (placeholders) in the prepared
459 statement. Corresponds to the DBI statement handle C<NUM_OF_PARAMS> attribute.
460
461 =item C<field_names>
462
463 my $field_names = $ex->field_names;
464
465 Returns a reference to an array of field names for each column. Corresponds to
466 the DBI statement handle C<NAME> attribute.
467
468 =item C<type>
469
470 my $type = $ex->type;
471
472 Returns a reference to an array of integer values for each column. The value
473 indicates the data type of the corresponding column. Corresponds to the DBI
474 statement handle C<TYPE> attribute.
475
476 =item C<precision>
477
478 my $precision = $ex->precision;
479
480 Returns a reference to an array of integer values for each column. For
481 non-numeric columns, the value generally refers to either the maximum length
482 or the defined length of the column. For numeric columns, the value refers to
483 the maximum number of significant digits used by the data type (without
484 considering a sign character or decimal point). Corresponds to the DBI
485 statement handle C<PRECISION> attribute.
486
487 =item C<scale>
488
489 my $scale = $ex->scale;
490
491 Returns a reference to an array of integer values for each column. Corresponds
492 to the DBI statement handle C<SCALE> attribute.
493
494 =item C<nullable>
495
496 my $nullable = $ex->nullable;
497
498 Returns a reference to an array indicating the possibility of each column
499 returning a null. Possible values are 0 (or an empty string) = no, 1 = yes, 2
500 = unknown. Corresponds to the DBI statement handle C<NULLABLE> attribute.
501
502 =item C<cursor_name>
503
504 my $cursor_name = $ex->cursor_name;
505
506 Returns the name of the cursor associated with the statement handle, if
507 available. Corresponds to the DBI statement handle C<CursorName> attribute.
508
509 =item C<param_values>
510
511 my $param_values = $ex->param_values;
512
513 Returns a reference to a hash containing the values currently bound to
514 placeholders. Corresponds to the DBI statement handle C<ParamValues>
515 attribute.
516
517 =item C<statement>
518
519 my $statement = $ex->statement;
520
521 Returns the statement string passed to the DBI C<prepare()>
522 method. Corresponds to the DBI statement handle C<Statement> attribute.
523
524 =item C<rows_in_cache>
525
526 my $rows_in_cache = $ex->rows_in_cache;
527
528 the number of unfetched rows in the cache if the driver supports a local row
529 cache for C<SELECT> statements. Corresponds to the DBI statement handle
530 C<RowsInCache> attribute.
531
532 =back
533
534 =head2 Exception::Class::DBI::Unknown
535
536 Exceptions of this class are thrown when the context for a DBI error cannot be
537 determined. Inherits from L<Exception::Class::DBI|"Exception::Class::DBI">,
538 but implements no methods of its own.
539
540 =head1 Note
541
542 B<Note:> Not I<all> of the attributes offered by the DBI are exploited by
543 these exception classes. For example, the C<PrintError> and C<RaiseError>
544 attributes seemed redundant. But if folks think it makes sense to include the
545 missing attributes for the sake of completeness, let me know. Enough interest
546 will motivate me to get them in.
547
548 =head1 Subclassing
549
550 It is possible to subclass Exception::Class::DBI. The trick is to subclass its
551 subclasses, too. Similar to subclassing DBI itself, this means that the handle
552 subclasses should exist as subnamespaces of your base subclass.
553
554 It's easier to explain with an example. Say that you wanted to add a new
555 method to all DBI exceptions that outputs a nicely formatted error message.
556 You might do it like this:
557
558 package MyApp::Ex::DBI;
559 use base 'Exception::Class::DBI';
560
561 sub full_message {
562 my $self = shift;
563 return $self->SUPER::full_message unless $self->can('statement');
564 return $self->SUPER::full_message
565 . ' [for Statement "'
566 . $self->statement . '"]';
567 }
568
569 You can then use this subclass just like Exception::Class::DBI itself:
570
571 my $dbh = DBI->connect($dsn, $user, $pass, {
572 PrintError => 0,
573 RaiseError => 0,
574 HandleError => MyApp::Ex::DBI->handler,
575 });
576
577 And that's all well and good, except that none of Exception::Class::DBI's own
578 subclasses inherit from your class, so most exceptions won't be able to use
579 your spiffy new method.
580
581 The solution is to create subclasses of both the Exception::Class::DBI
582 subclasses and your own base subclass, as long as they each use the same
583 package name as your subclass, plus "H", "DRH", "DBH", "STH", and "Unknown".
584 Here's what it looks like:
585
586 package MyApp::Ex::DBI::H;
587 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::H';
588
589 package MyApp::Ex::DBI::DRH;
590 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DRH';
591
592 package MyApp::Ex::DBI::DBH;
593 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DBH';
594
595 package MyApp::Ex::DBI::STH;
596 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::STH';
597
598 package MyApp::Ex::DBI::Unknown;
599 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::Unknown';
600
601 And then things should work just spiffy! Of course, you probably don't need
602 the H subclass unless you want to add other methods for the DRH, DBH, and STH
603 classes to inherit from.
604
605 =head1 To Do
606
607 =over 4
608
609 =item *
610
611 I need to figure out a non-database specific way of testing STH exceptions.
612 DBD::ExampleP works well for DRH and DBH exceptions, but not so well for
613 STH exceptions.
614
615 =back
616
617 =head1 Support
618
619 This module is stored in an open repository at the following address:
620
621 L<https://svn.kineticode.com/Exception-Class-DBI/trunk/>
622
623 Patches against Exception::Class::DBI are welcome. Please send bug reports to
624 <bug-exception-class-dbi@rt.cpan.org>.
625
626 =head1 Author
627
628 =begin comment
629
630 Fake-out Module::Build. Delete if it ever changes to support =head1 headers
631 other than all uppercase.
632
633 =head1 AUTHOR
634
635 =end comment
636
637 David Wheeler <david@kineticode.com>
638
639 =head1 See Also
640
641 You should really only be using this module in conjunction with Tim Bunce's
642 L<DBI|DBI>, so it pays to be familiar with its documentation.
643
644 See the documentation for Dave Rolsky's L<Exception::Class|Exception::Class>
645 module for details on the methods this module's classes inherit from
646 it. There's lots more information in these exception objects, so use them!
647
648 =head1 COPYRIGHT AND LICENSE
649
650 Copyright (c) 2002-2008, David Wheeler. Some Rights Reserved.
651
652 This module is free software; you can redistribute it and/or modify it under
653 the same terms as Perl itself.
654
655 =cut
0 #!/usr/bin/perl -w
1
2 # $Id: dbh.t 3917 2008-05-15 17:06:33Z david $
3
4 use strict;
5 use Test::More tests => 27;
6 BEGIN { use_ok('Exception::Class::DBI') or die }
7 use DBI;
8
9 ok( my $dbh = DBI->connect(
10 'dbi:ExampleP:dummy', '', '',
11 {
12 PrintError => 0,
13 RaiseError => 0,
14 HandleError => Exception::Class::DBI->handler
15 }),
16 'Connect to database' );
17
18 END { $dbh->disconnect if $dbh };
19
20 # Check that the error_handler has been installed.
21 isa_ok( $dbh->{HandleError}, 'CODE' );
22
23 # Trigger an exception.
24 eval {
25 $dbh->do('select foo from foo');
26 };
27
28 # Make sure we got the proper exception.
29 ok( my $err = $@, "Get exception" );
30 isa_ok( $err, 'Exception::Class::DBI' );
31 isa_ok( $err, 'Exception::Class::DBI::H' );
32 isa_ok( $err, 'Exception::Class::DBI::DBH' );
33
34 # Check the accessor values.
35 NOWARN: {
36 # Prevent Perl 5.6 from complaining about usng $DBI::stderr only once.
37 local $^W;
38 is( $err->err, $DBI::stderr || 1, "Check err" );
39 }
40 is( $err->errstr, 'Unknown field names: foo', "Check errstr" );
41 is( $err->error, 'DBD::ExampleP::db do failed: Unknown field names: foo',
42 "Check error" );
43 is( $err->state, 'S1000', "Check state" );
44 ok( ! defined $err->retval, "Check retval" );
45 is( $err->warn, 1, "Check warn" );
46 is( $err->active, 1, "Check active" );
47 # For some reason, under perl < 5.6.2, $dbh->{Kids} returns a different value
48 # inside the HandleError scope than it does outside that scope. So we're
49 # checking for the perl version here to cover our butts on this test. This may
50 # be fixed in the DBI soon. I'm using the old form of the Perl version number
51 # as it seems safer with older Perls. See
52 # http://groups.google.com/group/perl.dbi.dev/browse_thread/thread/6a1903e2eb251d45
53 # for details.
54 is( $err->kids, ($] < 5.006_002 ? 1 : 0), "Check kids" );
55 is( $err->active_kids, 0, "Check active_kids" );
56 ok( ! $err->inactive_destroy, "Check inactive_destroy" );
57 is( $err->trace_level, 0, "Check trace_level" );
58 is( $err->fetch_hash_key_name, 'NAME', "Check fetch_hash_key_name" );
59 ok( ! $err->chop_blanks, "Check chop_blanks" );
60 is( $err->long_read_len, 80, "Check long_read_len" );
61 ok( ! $err->long_trunc_ok, "Check long_trunc_ok" );
62 ok( ! $err->taint, "Check taint" );
63 ok( $err->auto_commit, "Check auto_commit" );
64 is( $err->db_name, 'dummy', "Check db_name" );
65 is( $err->statement, 'select foo from foo', "Check statement" );
66 ok( ! defined $err->row_cache_size, "Check row_cache_size" );
67
68 # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it
69 # does that. :-(
70 exit;
0 #!/usr/bin/perl -w
1
2 # $Id: dbi.t 3831 2008-05-06 17:49:25Z david $
3
4 use strict;
5 use Test::More tests => 14;
6 BEGIN { use_ok('Exception::Class::DBI') or die }
7 use DBI;
8
9 eval {
10 DBI->connect( 'dbi:Bogus', '', '', {
11 PrintError => 0,
12 RaiseError => 0,
13 HandleError => Exception::Class::DBI->handler
14 });
15 };
16
17 ok( my $err = $@, "Catch exception" );
18 SKIP: {
19 # Remove this skip when DBI->connect uses exceptions.
20 skip 'HandleError not yet fully supported by DBI->connect', 12
21 unless ref $@;
22 isa_ok( $err, 'Exception::Class::DBI' );
23 like( $err->error, qr{Can't connect\(dbi:Bogus HASH\([^\)]+\)\), no database driver specified and DBI_DSN env var not set},
24 "Check error" );
25 ok( ! defined $err->err, "Check err" );
26 ok( ! defined $err->errstr, "Check errstr" );
27 ok( ! defined $err->state, "Check state" );
28 ok( ! defined $err->retval, "Check retval" );
29
30 # Try to trigger a usage exception.
31 eval {
32 DBI->connect('', '', {}, # uh-oh, referenced password.
33 { PrintError => 0,
34 RaiseError => 0,
35 HandleError => Exception::Class::DBI->handler
36 });
37 };
38 ok( $err = $@, "Catch usage exception" );
39 isa_ok( $err, 'Exception::Class::DBI' );
40 is( $err->error, 'Usage: $class->connect([$dsn [,$user [,$passwd ' .
41 '[,\%attr]]]])', "Check usage error" );
42
43 TODO: {
44 # Remove this TODO when DBI->install_driver uses exceptions.
45 local $TODO = "DBI->install_driver doesn't use HandleError Yet";
46 # Try to trigger a install driver error.
47 eval {
48 DBI->connect('dbi:dummy:foo', '', '', # dummy driver.
49 { PrintError => 0,
50 RaiseError => 0,
51 HandleError => Exception::Class::DBI->handler
52 });
53 };
54 ok( $err = $@, "Catch usage exception" );
55 isa_ok( $err, 'Exception::Class::DBI' );
56 SKIP: {
57 # Remove this SKIP when DBI->install_driver uses exceptions.
58 skip 'HandleError not logic not yet used by DBI->install_driver', 1
59 unless ref $err;
60 # Can take out "ref $err" when the TODO is completed.
61 is( $err->error, 'panic: $class->install_driver(dummy) failed',
62 "Check driver error" );
63 }
64 }
65 }
66
67 # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it
68 # does that. :-(
69 exit;
0 #!/usr/bin/perl -w
1
2 # $Id: drh.t 3831 2008-05-06 17:49:25Z david $
3
4 use strict;
5 use Test::More tests => 21;
6 BEGIN { use_ok('Exception::Class::DBI') }
7 use DBI;
8
9 {
10 # Fake out DBD::ExampleP's connect method. Take the opportunity
11 # to set the dynamic attributes.
12 use DBD::ExampleP;
13 local $^W;
14 *DBD::ExampleP::dr::connect =
15 sub { $_[0]->set_err(7, 'Dammit Jim!', 'ABCDE') };
16 }
17
18 eval {
19 DBI->connect('dbi:ExampleP:dummy', '', '',
20 { PrintError => 0,
21 RaiseError => 0,
22 HandleError => Exception::Class::DBI->handler
23 });
24 };
25
26 SKIP: {
27 skip 'HandleError not logic not yet used by DBI->connect', 20
28 unless $DBI::VERSION gt '1.30';
29 ok( my $err = $@, "Caught exception" );
30 isa_ok( $err, 'Exception::Class::DBI' );
31 isa_ok( $err, 'Exception::Class::DBI::H' );
32 isa_ok( $err, 'Exception::Class::DBI::DRH' );
33 is( $err->err, 7, "Check err" );
34 is( $err->error, "DBI connect('dummy','',...) failed: Dammit Jim!",
35 'Check error' );
36 is( $err->errstr, 'Dammit Jim!', 'Check errstr' );
37 is( $err->state, 'ABCDE', 'Check state' );
38 ok( ! defined $err->retval, "Check retval" );
39 is( $err->warn, 1, "Check warn" );
40 is( $err->active, 1, "Check active" );
41 is( $err->kids, 0, "Check kids" );
42 is( $err->active_kids, 0, "Check acitive_kids" );
43 ok( ! $err->inactive_destroy, "Check inactive_destroy" );
44 is( $err->trace_level, 0, "Check trace_level" );
45 is( $err->fetch_hash_key_name, 'NAME', "Check fetch_hash_key_name" );
46 ok( ! $err->chop_blanks, "Check chop_blanks" );
47 is( $err->long_read_len, 80, "Check long_read_len" );
48 ok( ! $err->long_trunc_ok, "Check long_trunc_ok" );
49 ok( ! $err->taint, "Check taint" );
50 }
51
52 # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it
53 # does that. :-(
54 exit;
0 #!/usr/bin/perl -w
1
2 # $Id: sth.t 3831 2008-05-06 17:49:25Z david $
3
4 use strict;
5 use Test::More tests => 35;
6 BEGIN { use_ok('Exception::Class::DBI') or die }
7 # Use PurePerl to get around CursorName bug.
8 BEGIN { $ENV{DBI_PUREPERL} = 2 }
9 use DBI;
10
11 ok( my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
12 { PrintError => 0,
13 RaiseError => 0,
14 HandleError => Exception::Class::DBI->handler
15 }),
16 "Connect to database" );
17
18 END { $dbh->disconnect if $dbh };
19
20 # Check that the error_handler has been installed.
21 isa_ok( $dbh->{HandleError}, 'CODE' );
22
23 # Trigger an exception.
24 eval {
25 my $sth = $dbh->prepare("select * from foo");
26 $sth->execute;
27 };
28
29 # Make sure we got the proper exception.
30 ok( my $err = $@, "Get exception" );
31 my $bang = $!;
32 isa_ok( $err, 'Exception::Class::DBI' );
33 isa_ok( $err, 'Exception::Class::DBI::H' );
34 isa_ok( $err, 'Exception::Class::DBI::STH' );
35
36 is( $err->err, 2, "Check err" );
37 is( $err->errstr, "opendir(foo): $bang",
38 "Check errstr" );
39 like( $err->error,
40 qr/^DBD::ExampleP::st execute failed: opendir\(foo\): \E$bang/,
41 "Check error" );
42 is( $err->state, 'S1000', "Check state" );
43 ok( ! defined $err->retval, "Check retval" );
44
45 is( $err->warn, 1, 'Check warn' );
46 ok( !$err->active, 'Check active' );
47 is( $err->kids, 0, 'Check kids' );
48 is( $err->active_kids, 0, 'Check active_kids' );
49 ok( ! $err->compat_mode, 'Check compat_mode' );
50 ok( ! $err->inactive_destroy, 'Check inactive_destroy' );
51
52 {
53 # PurePerl->{TraceLevel} should return an integer, but it doesn't. It
54 # returns undef instead.
55 local $^W;
56 cmp_ok( $err->trace_level, '==', 0, 'Check trace_level' );
57 }
58
59 is( $err->fetch_hash_key_name, 'NAME', 'Check fetch_hash_key_name' );
60 ok( ! $err->chop_blanks, 'Check chop_blanks' );
61 is( $err->long_read_len, 80, 'Check long_read_len' );
62 ok( ! $err->long_trunc_ok, 'Check long_trunc_ok' );
63 ok( ! $err->taint, 'Check taint' );
64 is( $err->num_of_fields, 14, 'Check num_of_fields' );
65 is( $err->num_of_params, 0, 'Check num_of_params' );
66 is( ref $err->field_names, 'ARRAY', "Check field_names" );
67
68 # These tend to return undef. Probably ought to try to add tests to make
69 # sure that they have array refs when they're supposed to.
70 ok( ! defined $err->type, "Check type" ); # isa ARRAY
71 ok( ! defined $err->precision, "Check precision" ); # isa ARRAY
72 isa_ok( $err->scale, 'ARRAY', "Check scale" );
73 ok( ! defined $err->param_values, "Check praram_values" ); # isa HASH
74
75 is( ref $err->nullable, 'ARRAY', "Check nullable" );
76 # ExampleP fails to get the CursorName attribute under DBI. Which is
77 # why this test is using PurePerl, instead.
78 ok( ! defined $err->cursor_name, "Check cursor_name" );
79 is( $err->statement, 'select * from foo', 'Check statement' );
80 ok( ! defined $err->rows_in_cache, "Check rows_in_cache" );
81
82 # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it
83 # does that. :-(
84 exit;
0 #!/usr/bin/perl -w
1
2 use strict;
3 use Test::More tests => 12;
4 BEGIN { use_ok('Exception::Class::DBI') }
5
6 SUBCLASSES: {
7 package MyApp::Ex::DBI;
8 use base 'Exception::Class::DBI';
9
10 package MyApp::Ex::DBI::H;
11 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::H';
12
13 package MyApp::Ex::DBI::DRH;
14 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DRH';
15
16 package MyApp::Ex::DBI::DBH;
17 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DBH';
18
19 package MyApp::Ex::DBI::STH;
20 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::STH';
21
22 package MyApp::Ex::DBI::Unknown;
23 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::Unknown';
24 }
25
26 use DBI;
27
28 # Make sure that the same handler is used every time.
29 is +MyApp::Ex::DBI->handler, MyApp::Ex::DBI->handler,
30 'The handler code ref should always be the same for the subclass';
31 is +Exception::Class::DBI->handler, Exception::Class::DBI->handler,
32 'The base class handler should always be the same code ref';
33 isnt +MyApp::Ex::DBI->handler, Exception::Class::DBI->handler,
34 'The subclass handler should be different from the base class handler';
35
36 ok my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '', {
37 PrintError => 0,
38 RaiseError => 0,
39 HandleError => MyApp::Ex::DBI->handler,
40 }), 'Connect to database';
41
42 END { $dbh->disconnect if $dbh };
43
44 # Check that the error_handler has been installed.
45 isa_ok $dbh->{HandleError}, 'CODE', 'The HandleError attribute';
46
47 # Trigger an exception.
48 eval {
49 my $sth = $dbh->prepare('select * from foo');
50 $sth->execute;
51 };
52
53 # Make sure we got the proper exception.
54 ok my $err = $@, 'Catch exception';
55 isa_ok $err, 'Exception::Class::DBI', 'The exception';
56 isa_ok $err, 'Exception::Class::DBI::H', 'The exception';
57 isa_ok $err, 'Exception::Class::DBI::STH', 'The exception';
58 isa_ok $err, 'MyApp::Ex::DBI::STH', 'The exception';
59 isa_ok $err, 'MyApp::Ex::DBI', 'The exception';
60
61 # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it
62 # does that. :-(
63 exit;
0 #!perl -w
1
2 # $Id: z_pod.t 3713 2008-05-02 20:25:02Z david $
3
4 use strict;
5 use Test::More;
6 eval "use Test::Pod 1.20";
7 plan skip_all => "Test::Pod 1.20 required for testing POD" if $@;
8 all_pod_files_ok();