Codebase list libexception-class-dbi-perl / 95d363d
Incremented version number to 0.93. Reformatted some code and docs. David Wheeler 19 years ago
3 changed file(s) with 95 addition(s) and 83 deletion(s). Raw diff Collapse all Expand all
+4
-0
Changes less more
00 Revision history for Perl extension Exception::Class::DBI.
1
2 0.93
3 - Reformatted some of the code and documentation so that it's
4 easier to read.
15
26 0.92 2004-06-17T17:42:37
37 - Fixed test that was breaking with newer versions of DBI.
+2
-2
README less more
0 Exception/Class/DBI version 0.92
0 Exception/Class/DBI version 0.93
11 ================================
22
33 This module offers a set of DBI-specific exception classes. They inherit from
4141
4242 COPYRIGHT AND LICENCE
4343
44 Copyright (c) 2002-2003, David Wheeler. All Rights Reserved.
44 Copyright (c) 2002-2005, 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.
+89
-81
lib/Exception/Class/DBI.pm less more
55 use strict;
66 use Exception::Class;
77 use vars qw($VERSION);
8 $VERSION = '0.92';
9
10 use Exception::Class ( 'Exception::Class::DBI' =>
11 { description => 'DBI exception',
12 fields => [qw(err errstr state retval)]
13 },
14 'Exception::Class::DBI::Unknown' =>
15 { isa => 'Exception::Class::DBI',
16 description => 'DBI unknown exception'
17 },
18 'Exception::Class::DBI::H' =>
19 { isa => 'Exception::Class::DBI',
20 description => 'DBI handle exception',
21 fields => [qw(warn active kids active_kids compat_mode
22 inactive_destroy trace_level
23 fetch_hash_key_name chop_blanks
24 long_read_len long_trunc_ok taint)]
25 },
26 'Exception::Class::DBI::DRH' =>
27 { isa => 'Exception::Class::DBI::H',
28 description => 'DBI driver handle exception',
29 },
30 'Exception::Class::DBI::DBH' =>
31 { isa => 'Exception::Class::DBI::H',
32 description => 'DBI database handle exception',
33 fields => [qw(auto_commit db_name statement
34 row_cache_size)]
35 },
36 'Exception::Class::DBI::STH' =>
37 { isa => 'Exception::Class::DBI::H',
38 description => 'DBI statment handle exception',
39 fields => [qw(num_of_fields num_of_params field_names
40 type precision scale nullable
41 cursor_name param_values statement
42 rows_in_cache)]
43 }
44 );
8 $VERSION = '0.93';
9
10 use Exception::Class (
11 'Exception::Class::DBI' => {
12 description => 'DBI exception',
13 fields => [qw(err errstr state retval)]
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 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 )]
28 },
29
30 'Exception::Class::DBI::DRH' => {
31 isa => 'Exception::Class::DBI::H',
32 description => 'DBI driver handle exception',
33 },
34
35 'Exception::Class::DBI::DBH' => {
36 isa => 'Exception::Class::DBI::H',
37 description => 'DBI database handle exception',
38 fields => [qw(auto_commit db_name statement row_cache_size)]
39 },
40
41 'Exception::Class::DBI::STH' => {
42 isa => 'Exception::Class::DBI::H',
43 description => 'DBI statment handle exception',
44 fields => [qw(num_of_fields num_of_params field_names type precision
45 scale nullable cursor_name param_values statement
46 rows_in_cache
47 )]
48 }
49 );
4550
4651 sub handler {
4752 sub {
4853 my ($err, $dbh, $retval) = @_;
4954 if (ref $dbh) {
5055 # Assemble arguments for a handle exception.
51 my @params = ( error => $err,
52 errstr => $dbh->errstr,
53 err => $dbh->err,
54 state => $dbh->state,
55 retval => $retval,
56 warn => $dbh->{Warn},
57 active => $dbh->{Active},
58 kids => $dbh->{Kids},
59 active_kids => $dbh->{ActiveKids},
60 compat_mode => $dbh->{CompatMode},
61 inactive_destroy => $dbh->{InactiveDestroy},
62 trace_level => $dbh->{TraceLevel},
63 fetch_hash_key_name => $dbh->{FetchHashKeyName},
64 chop_blanks => $dbh->{ChopBlanks},
65 long_read_len => $dbh->{LongReadLen},
66 long_trunc_ok => $dbh->{LongTruncOk},
67 taint => $dbh->{Taint},
68 );
56 my @params = (
57 error => $err,
58 errstr => $dbh->errstr,
59 err => $dbh->err,
60 state => $dbh->state,
61 retval => $retval,
62 warn => $dbh->{Warn},
63 active => $dbh->{Active},
64 kids => $dbh->{Kids},
65 active_kids => $dbh->{ActiveKids},
66 compat_mode => $dbh->{CompatMode},
67 inactive_destroy => $dbh->{InactiveDestroy},
68 trace_level => $dbh->{TraceLevel},
69 fetch_hash_key_name => $dbh->{FetchHashKeyName},
70 chop_blanks => $dbh->{ChopBlanks},
71 long_read_len => $dbh->{LongReadLen},
72 long_trunc_ok => $dbh->{LongTruncOk},
73 taint => $dbh->{Taint},
74 );
6975 if (UNIVERSAL::isa($dbh, 'DBI::dr')) {
7076 # Just throw a driver exception. It has no extra attributes.
7177 Exception::Class::DBI::DRH->throw(@params);
7278 } elsif (UNIVERSAL::isa($dbh, 'DBI::db')) {
7379 # Throw a database handle exception.
74 Exception::Class::DBI::DBH->throw
75 ( @params,
80 Exception::Class::DBI::DBH->throw(
81 @params,
7682 auto_commit => $dbh->{AutoCommit},
7783 db_name => $dbh->{Name},
7884 statement => $dbh->{Statement},
7985 row_cache_size => $dbh->{RowCacheSize}
80 );
86 );
8187 } elsif (UNIVERSAL::isa($dbh, 'DBI::st')) {
8288 # Throw a statement handle exception.
83 Exception::Class::DBI::STH->throw
84 ( @params,
89 Exception::Class::DBI::STH->throw(
90 @params,
8591 num_of_fields => $dbh->{NUM_OF_FIELDS},
8692 num_of_params => $dbh->{NUM_OF_PARAMS},
8793 field_names => $dbh->{NAME},
9399 param_values => $dbh->{ParamValues},
94100 statement => $dbh->{Statement},
95101 rows_in_cache => $dbh->{RowsInCache}
96 );
102 );
97103 } else {
98104 # Unknown exception. This shouldn't happen.
99105 Exception::Class::DBI::Unknown->throw(@params);
107113 if ($DBI::lasth) {
108114 # There was a handle. Get the errors. This may be superfluous,
109115 # since the handle ought to be in $dbh.
110 $exc->throw( error => $err,
111 errstr => $DBI::errstr,
112 err => $DBI::err,
113 state => $DBI::state,
114 retval => $retval
115 );
116 $exc->throw(
117 error => $err,
118 errstr => $DBI::errstr,
119 err => $DBI::err,
120 state => $DBI::state,
121 retval => $retval
122 );
116123 } else {
117124 # No handle, no errors.
118 $exc->throw( error => $err,
119 retval => $retval
120 );
125 $exc->throw(
126 error => $err,
127 retval => $retval
128 );
121129 }
122130 }
123131 };
135143 use DBI;
136144 use Exception::Class::DBI;
137145
138 my $dbh = DBI->connect( $data_source, $username, $auth,
139 { PrintError => 0,
140 RaiseError => 0,
141 HandleError => Exception::Class::DBI->handler
142 });
146 my $dbh = DBI->connect($data_source, $username, $auth, {
147 PrintError => 0,
148 RaiseError => 0,
149 HandleError => Exception::Class::DBI->handler
150 });
143151
144152 eval { $dbh->do($sql) };
145153
183191
184192 =item C<handler>
185193
186 my $dbh = DBI->connect( $data_source, $username, $auth,
187 { PrintError => 0,
188 RaiseError => 0,
189 HandleError => Exception::Class::DBI->handler
190 });
194 my $dbh = DBI->connect($data_source, $username, $auth, {
195 PrintError => 0,
196 RaiseError => 0,
197 HandleError => Exception::Class::DBI->handler
198 });
191199
192200 This method returns a code reference appropriate for passing to the DBI
193201 C<HandleError> attribute. When DBI encounters an error, it checks its
562570
563571 =head1 COPYRIGHT AND LICENSE
564572
565 Copyright (c) 2002-2004, David Wheeler. All Rights Reserved.
573 Copyright (c) 2002-2005, David Wheeler. All Rights Reserved.
566574
567575 This module is free software; you can redistribute it and/or modify it under
568576 the same terms as Perl itself.