Codebase list libexception-class-dbi-perl / 97c1232
Added explicit accessors instead of Exception::Class attributes. This means that extra attributes will not be looked up in DBI until someone actually wants them. Had to add the handle attribute to do it. But this change also freed me to add support for subclassing. W00t! David Wheeler 17 years ago
6 changed file(s) with 215 addition(s) and 150 deletion(s). Raw diff Collapse all Expand all
+6
-0
Changes less more
22 0.93
33 - Reformatted some of the code and documentation so that it's
44 easier to read.
5 - Added 'handle' attribute to store the DBI handle for which the
6 exception was thrown.
7 - Switched to explicit accessors that reach in to the cached database
8 handle stored. Suggested by Tim Bunce ages ago!
9 - Added support for subclassing Exception::Class::DBI and its
10 subclasses.
511
612 0.92 2004-06-17T17:42:37
713 - Fixed test that was breaking with newer versions of DBI.
+16
-5
META.yml less more
0 --- #YAML:1.0
0 ---
11 name: Exception-Class-DBI
2 version: 0.92
2 version: 0.93
33 author:
4 - David Wheeler <david@wheeler.net>
4 - 'David Wheeler <david@kineticode.com>'
55 abstract: DBI Exception objects
66 license: perl
7 resources:
8 license: http://dev.perl.org/licenses/
79 requires:
810 DBI: 1.28
911 Exception::Class: 1.02
1315 provides:
1416 Exception::Class::DBI:
1517 file: lib/Exception/Class/DBI.pm
16 version: 0.92
17 generated_by: Module::Build version 0.25_01
18 version: 0.93
19 Exception::Class::DBI::DBH:
20 file: lib/Exception/Class/DBI.pm
21 Exception::Class::DBI::H:
22 file: lib/Exception/Class/DBI.pm
23 Exception::Class::DBI::STH:
24 file: lib/Exception/Class/DBI.pm
25 generated_by: Module::Build version 0.2801
26 meta-spec:
27 url: http://module-build.sourceforge.net/META-spec-v1.2.html
28 version: 1.2
+5
-5
Makefile.PL less more
1616
1717 # Save this 'cause CPAN will chdir all over the place.
1818 my $cwd = Cwd::cwd();
19 my $makefile = File::Spec->rel2abs($0);
2019
21 CPAN::Shell->install('Module::Build::Compat')
22 or die " *** Cannot install without Module::Build. Exiting ...\n";
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";
2323
2424 chdir $cwd or die "Cannot chdir() back to $cwd: $!";
25 exec $^X, $makefile, @ARGV; # Redo now that we have Module::Build
2625 }
27 use lib '_build/lib';
26 eval "use Module::Build::Compat 0.02; 1" or die $@;
27
2828 Module::Build::Compat->run_build_pl(args => \@ARGV);
2929 require Module::Build;
3030 Module::Build::Compat->write_makefile(build_class => 'Module::Build');
+1
-1
README less more
4141
4242 COPYRIGHT AND LICENCE
4343
44 Copyright (c) 2002-2005, David Wheeler. All Rights Reserved.
44 Copyright (c) 2002-2006, David Wheeler. All Rights Reserved.
4545
4646 This module is free software; you can redistribute it and/or modify it under
4747 the same terms as Perl itself.
+186
-121
lib/Exception/Class/DBI.pm less more
1010 use Exception::Class (
1111 'Exception::Class::DBI' => {
1212 description => 'DBI exception',
13 fields => [qw(err errstr state retval)]
13 fields => [qw(err errstr state retval handle)]
1414 },
1515
1616 'Exception::Class::DBI::Unknown' => {
2121 'Exception::Class::DBI::H' => {
2222 isa => 'Exception::Class::DBI',
2323 description => 'DBI handle exception',
24 fields => [qw(warn active kids active_kids compat_mode
25 inactive_destroy trace_level fetch_hash_key_name
26 chop_blanks long_read_len long_trunc_ok taint
27 )],
2824 },
2925
3026 'Exception::Class::DBI::DRH' => {
3531 'Exception::Class::DBI::DBH' => {
3632 isa => 'Exception::Class::DBI::H',
3733 description => 'DBI database handle exception',
38 fields => [qw(auto_commit db_name statement row_cache_size)]
3934 },
4035
4136 'Exception::Class::DBI::STH' => {
4237 isa => 'Exception::Class::DBI::H',
4338 description => 'DBI statment handle exception',
44 fields => [qw(num_of_fields num_of_params field_names type
45 precision scale nullable cursor_name param_values
46 statement rows_in_cache
47 )],
4839 }
4940 );
5041
5142 sub handler {
5243 my $pkg = shift;
53 my %class_for = map {
54 eval "require $pkg\::$_";
55 $_ => $@ ? __PACKAGE__ . "::$_" : "$pkg\::$_";
44
45 # Support subclasses.
46 my %class_for = map {
47 $_ => do {
48 my $class = "$pkg\::$_";
49 my $base = __PACKAGE__ . "::$_";
50 no strict 'refs';
51 # Try to load the subclass and check its inheritance.
52 eval "require $class" unless @{"$class\::ISA"};
53 my $isa = \@{"$class\::ISA"};
54 die "$class is not a subclass of $base"
55 if $isa && !$class->isa($base);
56 # If subclass exists and inherits, use it. Otherwise use default.
57 $isa ? $class : $base;
58 }
5659 } qw(H DRH DBH STH Unknown);
57 sub {
60
61 return sub {
5862 my ($err, $dbh, $retval) = @_;
59 if (ref $dbh) {
60 # Assemble arguments for a handle exception.
61 my @params = (
62 error => $err,
63 errstr => $dbh->errstr,
64 err => $dbh->err,
65 state => $dbh->state,
66 retval => $retval,
67 warn => $dbh->{Warn},
68 active => $dbh->{Active},
69 kids => $dbh->{Kids},
70 active_kids => $dbh->{ActiveKids},
71 compat_mode => $dbh->{CompatMode},
72 inactive_destroy => $dbh->{InactiveDestroy},
73 trace_level => $dbh->{TraceLevel},
74 fetch_hash_key_name => $dbh->{FetchHashKeyName},
75 chop_blanks => $dbh->{ChopBlanks},
76 long_read_len => $dbh->{LongReadLen},
77 long_trunc_ok => $dbh->{LongTruncOk},
78 taint => $dbh->{Taint},
79 );
80 if (UNIVERSAL::isa($dbh, 'DBI::dr')) {
81 # Just throw a driver exception. It has no extra attributes.
82 $class_for{DRH}->throw(@params);
83 } elsif (UNIVERSAL::isa($dbh, 'DBI::db')) {
84 # Throw a database handle exception.
85 $class_for{DBH}->throw(
86 @params,
87 auto_commit => $dbh->{AutoCommit},
88 db_name => $dbh->{Name},
89 statement => $dbh->{Statement},
90 row_cache_size => $dbh->{RowCacheSize}
91 );
92 } elsif (UNIVERSAL::isa($dbh, 'DBI::st')) {
93 # Throw a statement handle exception.
94 $class_for{STH}->throw(
95 @params,
96 num_of_fields => $dbh->{NUM_OF_FIELDS},
97 num_of_params => $dbh->{NUM_OF_PARAMS},
98 field_names => $dbh->{NAME},
99 type => $dbh->{TYPE},
100 precision => $dbh->{PRECISION},
101 scale => $dbh->{SCALE},
102 nullable => $dbh->{NULLABLE},
103 cursor_name => $dbh->{CursorName},
104 param_values => $dbh->{ParamValues},
105 statement => $dbh->{Statement},
106 rows_in_cache => $dbh->{RowsInCache}
107 );
108 } else {
109 # Unknown exception. This shouldn't happen.
110 $class_for{Unknown}->throw(@params);
111 }
112 } else {
113 # Set up for a base class exception.
114 my $exc = $pkg;
115 # Make it an unknown exception if $dbh isn't a DBI class
116 # name. Probably shouldn't happen.
117 $class_for{Unknown} unless eval { $dbh->isa($dbh, 'DBI') };
118 if ($DBI::lasth) {
119 # There was a handle. Get the errors. This may be superfluous,
120 # since the handle ought to be in $dbh.
121 $exc->throw(
122 error => $err,
123 errstr => $DBI::errstr,
124 err => $DBI::err,
125 state => $DBI::state,
126 retval => $retval
127 );
128 } else {
129 # No handle, no errors.
130 $exc->throw(
131 error => $err,
132 retval => $retval
133 );
134 }
135 }
63
64 # No handle, no choice.
65 $pkg->throw(
66 error => $err,
67 retval => $retval
68 ) unless ref($dbh ||= $DBI::lasth);
69
70 # Assemble arguments for a handle exception.
71 my @params = (
72 error => $err,
73 errstr => $dbh->errstr,
74 err => $dbh->err,
75 state => $dbh->state,
76 retval => $retval,
77 handle => $dbh,
78 );
79
80 # Throw the proper exception.
81 $class_for{STH}->throw(@params) if eval { $dbh->isa('DBI::st') };
82 $class_for{DBH}->throw(@params) if eval { $dbh->isa('DBI::db') };
83 $class_for{DRH}->throw(@params) if eval { $dbh->isa('DBI::dr') };
84
85 # Unknown exception. This shouldn't happen.
86 $class_for{Unknown}->throw(@params);
13687 };
13788 }
13889
90 package Exception::Class::DBI::H;
91 sub warn { shift->handle->{Warn} }
92 sub active { shift->handle->{Active} }
93 sub kids { shift->handle->{Kids} }
94 sub active_kids { shift->handle->{ActiveKids} }
95 sub compat_mode { shift->handle->{CompatMode} }
96 sub inactive_destroy { shift->handle->{InactiveDestroy} }
97 sub trace_level { shift->handle->{TraceLevel} }
98 sub fetch_hash_key_name { shift->handle->{FetchHashKeyName} }
99 sub chop_blanks { shift->handle->{ChopBlanks} }
100 sub long_read_len { shift->handle->{LongReadLen} }
101 sub long_trunc_ok { shift->handle->{LongTruncOk} }
102 sub taint { shift->handle->{Taint} }
103
104 package Exception::Class::DBI::DBH;
105 sub auto_commit { shift->handle->{AutoCommit} }
106 sub db_name { shift->handle->{Name} }
107 sub statement { shift->handle->{Statement} }
108 sub row_cache_size { shift->handle->{RowCacheSize} }
109
110 package Exception::Class::DBI::STH;
111 sub num_of_fields { shift->handle->{NUM_OF_FIELDS} }
112 sub num_of_params { shift->handle->{NUM_OF_PARAMS} }
113 sub field_names { shift->handle->{NAME} }
114 sub type { shift->handle->{TYPE} }
115 sub precision { shift->handle->{PRECISION} }
116 sub scale { shift->handle->{SCALE} }
117 sub nullable { shift->handle->{NULLABLE} }
118 sub cursor_name { shift->handle->{CursorName} }
119 sub param_values { shift->handle->{ParamValues} }
120 sub statement { shift->handle->{Statement} }
121 sub rows_in_cache { shift->handle->{RowsInCache} }
122
139123 1;
140124 __END__
141125
126 =begin comment
127
128 Fake-out Module::Build. Delete if it ever changes to support =head1 headers
129 other than all uppercase.
130
142131 =head1 NAME
143132
144133 Exception::Class::DBI - DBI Exception objects
145134
146 =head1 SYNOPSIS
135 =end comment
136
137 =head1 Name
138
139 Exception::Class::DBI - DBI Exception objects
140
141 =head1 Synopsis
147142
148143 use DBI;
149144 use Exception::Class::DBI;
150145
151 my $dbh = DBI->connect($data_source, $username, $auth, {
146 my $dbh = DBI->connect($dsn, $user, $pass, {
152147 PrintError => 0,
153148 RaiseError => 0,
154149 HandleError => Exception::Class::DBI->handler
159154 if (my $ex = $@) {
160155 print STDERR "DBI Exception:\n";
161156 print STDERR " Exception Type: ", ref $ex, "\n";
162 print STDERR " Error: ", $ex->error, "\n";
163 print STDERR " Err: ", $ex->err, "\n";
164 print STDERR " Errstr: " $ex->errstr, "\n";
165 print STDERR " State: ", $ex->state, "\n";
166 my $ret = $ex->retval;
167 $ret = 'undef' unless defined $ret;
168 print STDERR " Return Value: $ret\n";
157 print STDERR " Error: ", $ex->error, "\n";
158 print STDERR " Err: ", $ex->err, "\n";
159 print STDERR " Errstr: ", $ex->errstr, "\n";
160 print STDERR " State: ", $ex->state, "\n";
161 print STDERR " Return Value: ", ($ex->retval || 'undef'), "\n";
169162 }
170163
171 =head1 DESCRIPTION
164 =head1 Description
172165
173166 This module offers a set of DBI-specific exception classes. They inherit from
174167 Exception::Class, the base class for all exception objects created by the
175 Exception::Class module from the CPAN. Exception::Class::DBI itself offers a
176 single class method, C<handler()>, that returns a code reference appropriate
177 for passing to the DBI C<HandleError> attribute.
168 L<Exception::Class|Exception::Class> module from the CPAN.
169 Exception::Class::DBI itself offers a single class method, C<handler()>, that
170 returns a code reference appropriate for passing to the DBI C<HandleError>
171 attribute.
178172
179173 The exception classes created by Exception::Class::DBI are designed to be
180174 thrown in certain DBI contexts; the code reference returned by C<handler()>
181 and passed to the DBI C<HandleError> attribute determines the context,
182 assembles the necessary metadata, and throws the apopropriate exception.
175 and passed to the DBI C<HandleError> attribute determines the context and
176 throws the apopropriate exception.
183177
184178 Each of the Exception::Class::DBI classes offers a set of object accessor
185179 methods in addition to those provided by Exception::Class. These can be used
186 to output detailed output in the event of an exception.
187
188 =head1 INTERFACE
180 to output detailed diagnostic information in the event of an exception.
181
182 =head1 Interface
189183
190184 Exception::Class::DBI inherits from Exception::Class, and thus its entire
191185 interface. Refer to the Exception::Class documentation for details.
216210
217211 =back
218212
219 =head1 CLASSES
213 =head1 Classes
220214
221215 Exception::Class::DBI creates a number of exception classes, each one specific
222216 to a particular DBI error context. Most of the object methods described below
275269 The first value being returned by the DBI method that failed (typically
276270 C<undef>).
277271
272 =item C<handle>
273
274 my $db_handle = $ex->handle;
275
276 The DBI handle appropriate to the exception class. For
277 Exception::Class::DBI::DRH, it will be a driver handle. For
278 Exception::Class::DBI::DBH it will be a database handle. And for
279 Exception::Class::DBI::STH it will be a statement handle. If there is no
280 handle thrown in the exception (because, say, the exception was thrown before
281 a driver handle could be created), the C<handle> will be C<undef>.
282
278283 =back
279284
280285 =head2 Exception::Class::DBI::H
530535 determined. Inherits from L<Exception::Class::DBI|"Exception::Class::DBI">,
531536 but implements no methods of its own.
532537
533 =head1 NOTE
538 =head1 Note
534539
535540 B<Note:> Not I<all> of the attributes offered by the DBI are exploited by
536541 these exception classes. For example, the C<PrintError> and C<RaiseError>
538543 missing attributes for the sake of completeness, let me know. Enough interest
539544 will motivate me to get them in.
540545
541 =head1 TO DO
546 =head1 Subclassing
547
548 It is possible to subclass Exception::Class::DBI. The trick is to subclass its
549 subclasses, too. Similar to subclassing DBI itself, this means that the handle
550 subclasses should exist as subnamespaces of your base subclass.
551
552 It's easier to explain with an example. Say that you wanted to add a new
553 method to all DBI exceptions that outputs a nicely formatted error message.
554 You might do it like this:
555
556 package MyApp::Ex::DBI;
557 use base 'Exception::Class::DBI';
558
559 sub full_message {
560 my $self = shift;
561 return $self->SUPER::full_message unless $self->can('statement');
562 return $self->SUPER::full_message
563 . ' [for Statement "'
564 . $self->statement . '"]';
565 }
566
567 You can then use this subclass just like Exception::Class::DBI itself:
568
569 my $dbh = DBI->connect($dsn, $user, $pass, {
570 PrintError => 0,
571 RaiseError => 0,
572 HandleError => MyApp::Ex::DBI->handler,
573 });
574
575 And that's all well and good, except that none of Exception::Class::DBI's own
576 subclasses inherit from your class, so most exceptions won't be able to use
577 your spiffy new method.
578
579 The solution is to create subclasses of both the Exception::Class::DBI
580 subclasses and your own base subclass, as long as they each use the same
581 package name as your subclass, plus "H", "DRH", "DBH", "STH", and "Unknown".
582 Here's what it looks like:
583
584 package MyApp::Ex::DBI::H;
585 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::H';
586
587 package MyApp::Ex::DBI::DRH;
588 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DRH';
589
590 package MyApp::Ex::DBI::DBH;
591 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DBH';
592
593 package MyApp::Ex::DBI::STH;
594 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::STH';
595
596 package MyApp::Ex::DBI::Unknown;
597 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::Unknown';
598
599 And then things should work just spiffy! Of course, you probably don't need
600 the H subclass unless you want to add other methods for the DRH, DBH, and STH
601 classes to inherit from.
602
603 =head1 To Do
542604
543605 =over 4
544606
548610 DBD::ExampleP works well for DRH and DBH exceptions, but not so well for
549611 STH exceptions.
550612
551 =item *
552
553 Change the model to merely store a reference to the DBI handle and get its
554 attributes only when methods are called, rather than grabbing them all at once
555 when the exception is created.
556
557613 =back
558614
559 =head1 BUGS
615 =head1 Bugs
560616
561617 Please send bug reports to <bug-exception-class-dbi@rt.cpan.org>.
562618
619 =head1 Author
620
621 =begin comment
622
623 Fake-out Module::Build. Delete if it ever changes to support =head1 headers
624 other than all uppercase.
625
563626 =head1 AUTHOR
564627
628 =end comment
629
565630 David Wheeler <david@kineticode.com>
566631
567 =head1 SEE ALSO
632 =head1 See Also
568633
569634 You should really only be using this module in conjunction with Tim Bunce's
570635 L<DBI|DBI>, so it pays to be familiar with its documentation.
575640
576641 =head1 COPYRIGHT AND LICENSE
577642
578 Copyright (c) 2002-2005, David Wheeler. All Rights Reserved.
643 Copyright (c) 2002-2006, David Wheeler. All Rights Reserved.
579644
580645 This module is free software; you can redistribute it and/or modify it under
581646 the same terms as Perl itself.
+1
-18
t/subclass.t less more
33 use Test::More tests => 9;
44 BEGIN { use_ok('Exception::Class::DBI') }
55
6 DBI: {
6 SUBCLASSES: {
77 package MyApp::Ex::DBI;
88 use base 'Exception::Class::DBI';
9 $INC{'MyApp/Ex/DBI.pm'} = __FILE__;
10 }
119
12 H: {
1310 package MyApp::Ex::DBI::H;
1411 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::H';
15 $INC{'MyApp/Ex/DBI/H.pm'} = __FILE__;
16 }
1712
18 DRH: {
1913 package MyApp::Ex::DBI::DRH;
2014 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DRH';
21 $INC{'MyApp/Ex/DBI/DRH.pm'} = __FILE__;
22 }
2315
24 DBH: {
2516 package MyApp::Ex::DBI::DBH;
2617 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DBH';
27 $INC{'MyApp/Ex/DBI/DBH.pm'} = __FILE__;
28 }
2918
30 STH: {
3119 package MyApp::Ex::DBI::STH;
3220 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::STH';
33 $INC{'MyApp/Ex/DBI/STH.pm'} = __FILE__;
34 }
3521
36 UNKNOWN: {
3722 package MyApp::Ex::DBI::Unknown;
3823 use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::Unknown';
39 $INC{'MyApp/Ex/DBI/Unknown.pm'} = __FILE__;
4024 }
4125
4226 use DBI;
6044
6145 # Make sure we got the proper exception.
6246 ok my $err = $@, 'Catch exception';
63 diag $err;
6447 isa_ok $err, 'Exception::Class::DBI', 'The exception';
6548 isa_ok $err, 'Exception::Class::DBI::H', 'The exception';
6649 isa_ok $err, 'Exception::Class::DBI::STH', 'The exception';