Exception-Class-DBI-1.00/0000755000076600007660000000000011015164132013775 5ustar daviddavidException-Class-DBI-1.00/Build.PL0000444000076600007660000000110511015164132015264 0ustar daviddaviduse Module::Build; my $build = Module::Build->new( module_name => 'Exception::Class::DBI', license => 'perl', create_makefile_pl => 'passthrough', configure_requires => { 'Module::Build' => '0.2701' }, recommends => { 'Test::Pod' => '1.20' }, build_requires => { 'Module::Build' => '0.2701', 'Test::More' => '0.17', 'Test::Harness' => '2.03', }, requires => { 'DBI' => '1.28', 'Exception::Class' => '1.02', }, ); $build->create_build_script; Exception-Class-DBI-1.00/Changes0000444000076600007660000000602111015164132015265 0ustar daviddavidRevision history for Perl extension Exception::Class::DBI. 1.00 2008-05-22T03:28:50 - Fixed a test failure on Perl 5.5. Reported by Slaven Rezic. 0.99 2008-05-15T03:31:30 - Fixed another Perl 5.6.2 test error. Reported by Slaven Rezic. 0.98 2008-05-06T17:53:25 - Fixed strange test failures on Perl 5.6.2. Somehow tests are getting run more than once, resulting in strange failures. I got 'round this issue by putting an explicit `exit;` at the end of each test script. Reported by David Cantrell. 0.97 2008-05-05T19:10:05 - Updated copyright. - Added a link to the Subversion repository. - Fixed test failures on Perl 5.6.2. 0.96 2007-10-26T19:01:36 - Fixed test failure due to the change in value of $dbh->err in DBI 1.601. First reported by Andreas J. König; fix suggested by Tim Bunce. - Added the "configure_requires", and "recommends" parameters to Build.PL. - Updated the POD test to properly make use of Test::POD 1.20 or newer. 0.95 2006-07-18T22:14:41 - Fixed test failure for localized error messages. Reported by Jens Maier with a fix from Daniel Brook. - Updated tests to use is($foo, $bar) instead of ok($foo == $bar) Spotted by Andy Lester. 0.94 2006-06-30T00:04:32 - The handler() method now always returns the same code referernce each time it's called for a given subclass. This behavior prevents the DBI connect_cached() method from caching a new database handle every time it's called, which could otherwise be pretty annoying. 0.93 2006-06-10T02:09:14 - Reformatted some of the code and documentation so that it's easier to read. - Added 'handle' attribute to store the DBI handle for which the exception was thrown. - Switched to explicit accessors that reach in to the cached database handle stored. Suggested by Tim Bunce ages ago! - Added support for subclassing Exception::Class::DBI and its subclasses. 0.92 2004-06-17T17:42:37 - Fixed test that was breaking with newer versions of DBI. 0.91 Tue Aug 26 02:25:56 2003 - Switched to Module::Build. - Throwing exceptions with the "throw()" method, rather than die'ing with the construction of exceptions with the "new()" constructor. - Added POD tests. 0.90 Thu Dec 12 20:16:14 2002 - Updated tests for Changes in DBI 1.30. Connection failures can now throw exceptions! - Removed TODO tests in sth.t. Tim has said that DBI attributes that return ARRAYs or HASHes will return undef when they're empty, rather than return emtpy ARRAYs or HASHes. - Incremented version to 0.90 to indicate high level of stability. 0.02 Tue Sep 17 03:33:56 2002 - Documentation tweaks. - Fixed test to pass with Perl 5.6.1 and earlier. 0.01 Fri Aug 23 19:50:45 2002 - Initial Release to the CPAN. Exception-Class-DBI-1.00/lib/0000755000076600007660000000000011015164132014543 5ustar daviddavidException-Class-DBI-1.00/lib/Exception/0000755000076600007660000000000011015164132016501 5ustar daviddavidException-Class-DBI-1.00/lib/Exception/Class/0000755000076600007660000000000011015164132017546 5ustar daviddavidException-Class-DBI-1.00/lib/Exception/Class/DBI.pm0000444000076600007660000005105111015164132020502 0ustar daviddavidpackage Exception::Class::DBI; # $Id: DBI.pm 3906 2008-05-15 03:28:13Z david $ use 5.00500; use strict; use Exception::Class; use vars qw($VERSION); $VERSION = '1.00'; use Exception::Class ( 'Exception::Class::DBI' => { description => 'DBI exception', fields => [qw(err errstr state retval handle)] }, 'Exception::Class::DBI::Unknown' => { isa => 'Exception::Class::DBI', description => 'DBI unknown exception' }, 'Exception::Class::DBI::H' => { isa => 'Exception::Class::DBI', description => 'DBI handle exception', }, 'Exception::Class::DBI::DRH' => { isa => 'Exception::Class::DBI::H', description => 'DBI driver handle exception', }, 'Exception::Class::DBI::DBH' => { isa => 'Exception::Class::DBI::H', description => 'DBI database handle exception', }, 'Exception::Class::DBI::STH' => { isa => 'Exception::Class::DBI::H', description => 'DBI statment handle exception', } ); my %handlers; sub handler { my $pkg = shift; return $handlers{$pkg} if $handlers{$pkg}; # Support subclasses. my %class_for = map { $_ => do { my $class = "$pkg\::$_"; my $base = __PACKAGE__ . "::$_"; no strict 'refs'; # Try to load the subclass and check its inheritance. eval "require $class" unless @{"$class\::ISA"}; my $isa = \@{"$class\::ISA"}; die "$class is not a subclass of $base" if $isa && !$class->isa($base); # If subclass exists and inherits, use it. Otherwise use default. $isa ? $class : $base; } } qw(H DRH DBH STH Unknown); return $handlers{$pkg} = sub { my ($err, $dbh, $retval) = @_; # No handle, no choice. $pkg->throw( error => $err, retval => $retval ) unless ref($dbh ||= $DBI::lasth); # Assemble arguments for a handle exception. my @params = ( error => $err, errstr => $dbh->errstr, err => $dbh->err, state => $dbh->state, retval => $retval, handle => $dbh, ); # Throw the proper exception. $class_for{STH}->throw(@params) if eval { $dbh->isa('DBI::st') }; $class_for{DBH}->throw(@params) if eval { $dbh->isa('DBI::db') }; $class_for{DRH}->throw(@params) if eval { $dbh->isa('DBI::dr') }; # Unknown exception. This shouldn't happen. $class_for{Unknown}->throw(@params); }; } package Exception::Class::DBI::H; sub warn { shift->handle->{Warn} } sub active { shift->handle->{Active} } sub kids { shift->handle->{Kids} } sub active_kids { shift->handle->{ActiveKids} } sub compat_mode { shift->handle->{CompatMode} } sub inactive_destroy { shift->handle->{InactiveDestroy} } sub trace_level { shift->handle->{TraceLevel} } sub fetch_hash_key_name { shift->handle->{FetchHashKeyName} } sub chop_blanks { shift->handle->{ChopBlanks} } sub long_read_len { shift->handle->{LongReadLen} } sub long_trunc_ok { shift->handle->{LongTruncOk} } sub taint { shift->handle->{Taint} } package Exception::Class::DBI::DBH; sub auto_commit { shift->handle->{AutoCommit} } sub db_name { shift->handle->{Name} } sub statement { shift->handle->{Statement} } sub row_cache_size { shift->handle->{RowCacheSize} } package Exception::Class::DBI::STH; sub num_of_fields { shift->handle->{NUM_OF_FIELDS} } sub num_of_params { shift->handle->{NUM_OF_PARAMS} } sub field_names { shift->handle->{NAME} } sub type { shift->handle->{TYPE} } sub precision { shift->handle->{PRECISION} } sub scale { shift->handle->{SCALE} } sub nullable { shift->handle->{NULLABLE} } sub cursor_name { shift->handle->{CursorName} } sub param_values { shift->handle->{ParamValues} } sub statement { shift->handle->{Statement} } sub rows_in_cache { shift->handle->{RowsInCache} } 1; __END__ =begin comment Fake-out Module::Build. Delete if it ever changes to support =head1 headers other than all uppercase. =head1 NAME Exception::Class::DBI - DBI Exception objects =end comment =head1 Name Exception::Class::DBI - DBI Exception objects =head1 Synopsis use DBI; use Exception::Class::DBI; my $dbh = DBI->connect($dsn, $user, $pass, { PrintError => 0, RaiseError => 0, HandleError => Exception::Class::DBI->handler, }); eval { $dbh->do($sql) }; if (my $ex = $@) { print STDERR "DBI Exception:\n"; print STDERR " Exception Type: ", ref $ex, "\n"; print STDERR " Error: ", $ex->error, "\n"; print STDERR " Err: ", $ex->err, "\n"; print STDERR " Errstr: ", $ex->errstr, "\n"; print STDERR " State: ", $ex->state, "\n"; print STDERR " Return Value: ", ($ex->retval || 'undef'), "\n"; } =head1 Description This module offers a set of DBI-specific exception classes. They inherit from Exception::Class, the base class for all exception objects created by the L module from the CPAN. Exception::Class::DBI itself offers a single class method, C, that returns a code reference appropriate for passing to the DBI C attribute. The exception classes created by Exception::Class::DBI are designed to be thrown in certain DBI contexts; the code reference returned by C and passed to the DBI C attribute determines the context and throws the apopropriate exception. Each of the Exception::Class::DBI classes offers a set of object accessor methods in addition to those provided by Exception::Class. These can be used to output detailed diagnostic information in the event of an exception. =head1 Interface Exception::Class::DBI inherits from Exception::Class, and thus its entire interface. Refer to the Exception::Class documentation for details. =head2 Class Method =over 4 =item C my $dbh = DBI->connect($data_source, $username, $auth, { PrintError => 0, RaiseError => 0, HandleError => Exception::Class::DBI->handler }); This method returns a code reference appropriate for passing to the DBI C attribute. When DBI encounters an error, it checks its C, C, and C attributes to decide what to do about it. When C has been set to a code reference, DBI executes it, passing it the error string that would be printed for C, the DBI handle object that was executing the method call that triggered the error, and the return value of that method call (usually C). Using these arguments, the code reference provided by C determines what type of exception to throw. Exception::Class::DBI contains the subclasses detailed below, each relevant to the DBI handle that triggered the error. =back =head1 Classes Exception::Class::DBI creates a number of exception classes, each one specific to a particular DBI error context. Most of the object methods described below correspond to like-named attributes in the DBI itself. Thus the documentation below summarizes the DBI attribute documentation, so you should refer to L itself for more in-depth information. =head2 Exception::Class::DBI All of the Exception::Class::DBI classes documented below inherit from Exception::Class::DBI. It offers the several object methods in addition to those it inherits from I parent, Exception::Class. These methods correspond to the L, as well as to the values passed to the C exception handler via the DBI C attribute. Exceptions of this base class are only thrown when there is no DBI handle object executing, e.g. in the DBI C method. B This functionality is not yet implemented in DBI -- see the discusion that starts here: L. =over 4 =item C my $error = $ex->error; Exception::Class::DBI actually inherits this method from Exception::Class. It contains the error string that DBI prints when its C attribute is enabled, or Cs with when its attribute is enabled. =item C my $err = $ex->err; Corresponds to the C<$DBI::err> dynamic attribute. Returns the native database engine error code from the last driver method called. =item C my $errstr = $ex->errstr; Corresponds to the C<$DBI::errstr> dynamic attribute. Returns the native database engine error message from the last driver method called. =item C my $state = $ex->state; Corresponds to the C<$DBI::state> dynamic attribute. Returns an error code in the standard SQLSTATE five character format. =item C my $retval = $ex->retval; The first value being returned by the DBI method that failed (typically C). =item C my $db_handle = $ex->handle; The DBI handle appropriate to the exception class. For Exception::Class::DBI::DRH, it will be a driver handle. For Exception::Class::DBI::DBH it will be a database handle. And for Exception::Class::DBI::STH it will be a statement handle. If there is no handle thrown in the exception (because, say, the exception was thrown before a driver handle could be created), the C will be C. =back =head2 Exception::Class::DBI::H This class inherits from L, and is the base class for all DBI handle exceptions (see below). It will not be thrown directly. Its methods correspond to the L. =over 4 =item C my $warn = $ex->warn; Boolean value indicating whether DBI warnings have been enabled. Corresponds to the DBI C attribute. =item C my $active = $ex->active; Boolean value indicating whether the DBI handle that encountered the error is active. Corresponds to the DBI C attribute. =item C my $kids = $ex->kids; For a driver handle, Kids is the number of currently existing database handles that were created from that driver handle. For a database handle, Kids is the number of currently existing statement handles that were created from that database handle. Corresponds to the DBI C attribute. =item C my $active_kids = $ex->active_kids; Like C, but only counting those that are C (as above). Corresponds to the DBI C attribute. =item C my $compat_mode = $ex->compat_mode; Boolean value indicating whether an emulation layer (such as Oraperl) enables compatible behavior in the underlying driver (e.g., DBD::Oracle) for this handle. Corresponds to the DBI C attribute. =item C my $inactive_destroy = $ex->inactive_destroy; Boolean value indicating whether the DBI has disabled the database engine related effect of Cing a handle. Corresponds to the DBI C attribute. =item C my $trace_level = $ex->trace_level; Returns the DBI trace level set on the handle that encountered the error. Corresponds to the DBI C attribute. =item C my $fetch_hash_key_name = $ex->fetch_hash_key_name; Returns the attribute name the DBI C method should use to get the field names for the hash keys. Corresponds to the DBI C attribute. =item C my $chop_blanks = $ex->chop_blanks; Boolean value indicating whether DBI trims trailing space characters from fixed width character (CHAR) fields. Corresponds to the DBI C attribute. =item C my $long_read_len = $ex->long_read_len; Returns the maximum length of long fields ("blob", "memo", etc.) which the DBI driver will read from the database automatically when it fetches each row of data. Corresponds to the DBI C attribute. =item C my $long_trunc_ok = $ex->long_trunc_ok; Boolean value indicating whether the DBI will truncate values it retrieves from long fields that are longer than the value returned by C. Corresponds to the DBI C attribute. =item C my $taint = $ex->taint; Boolean value indicating whether data fetched from the database is considered tainted. Corresponds to the DBI C attribute. =back =head2 Exception::Class::DBI::DRH DBI driver handle exceptions objects. This class inherits from L, and offers no extra methods of its own. =head2 Exception::Class::DBI::DBH DBI database handle exceptions objects. This class inherits from L Its methods correspond to the L. =over 4 =item C my $auto_commit = $ex->auto_commit; Returns true if the database handle C attribute is enabled. meaning that database changes cannot be rolled back. Corresponds to the DBI database handle C attribute. =item C my $db_name = $ex->db_name; Returns the "name" of the database. Corresponds to the DBI database handle C attribute. =item C my $statement = $ex->statement; Returns the statement string passed to the most recent call to the DBI C method in this database handle. If it was the C method that encountered the error and triggered the exception, the statement string will be the statement passed to C. Corresponds to the DBI database handle C attribute. =item C my $row_cache_size = $ex->row_cache_size; Returns the hint to the database driver indicating the size of the local row cache that the application would like the driver to use for future C statements. Corresponds to the DBI statement handle C attribute. =back =head2 Exception::Class::DBI::Unknown Exceptions of this class are thrown when the context for a DBI error cannot be determined. Inherits from L, but implements no methods of its own. =head1 Note B Not I of the attributes offered by the DBI are exploited by these exception classes. For example, the C and C attributes seemed redundant. But if folks think it makes sense to include the missing attributes for the sake of completeness, let me know. Enough interest will motivate me to get them in. =head1 Subclassing It is possible to subclass Exception::Class::DBI. The trick is to subclass its subclasses, too. Similar to subclassing DBI itself, this means that the handle subclasses should exist as subnamespaces of your base subclass. It's easier to explain with an example. Say that you wanted to add a new method to all DBI exceptions that outputs a nicely formatted error message. You might do it like this: package MyApp::Ex::DBI; use base 'Exception::Class::DBI'; sub full_message { my $self = shift; return $self->SUPER::full_message unless $self->can('statement'); return $self->SUPER::full_message . ' [for Statement "' . $self->statement . '"]'; } You can then use this subclass just like Exception::Class::DBI itself: my $dbh = DBI->connect($dsn, $user, $pass, { PrintError => 0, RaiseError => 0, HandleError => MyApp::Ex::DBI->handler, }); And that's all well and good, except that none of Exception::Class::DBI's own subclasses inherit from your class, so most exceptions won't be able to use your spiffy new method. The solution is to create subclasses of both the Exception::Class::DBI subclasses and your own base subclass, as long as they each use the same package name as your subclass, plus "H", "DRH", "DBH", "STH", and "Unknown". Here's what it looks like: package MyApp::Ex::DBI::H; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::H'; package MyApp::Ex::DBI::DRH; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DRH'; package MyApp::Ex::DBI::DBH; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DBH'; package MyApp::Ex::DBI::STH; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::STH'; package MyApp::Ex::DBI::Unknown; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::Unknown'; And then things should work just spiffy! Of course, you probably don't need the H subclass unless you want to add other methods for the DRH, DBH, and STH classes to inherit from. =head1 To Do =over 4 =item * I need to figure out a non-database specific way of testing STH exceptions. DBD::ExampleP works well for DRH and DBH exceptions, but not so well for STH exceptions. =back =head1 Support This module is stored in an open repository at the following address: L Patches against Exception::Class::DBI are welcome. Please send bug reports to . =head1 Author =begin comment Fake-out Module::Build. Delete if it ever changes to support =head1 headers other than all uppercase. =head1 AUTHOR =end comment David Wheeler =head1 See Also You should really only be using this module in conjunction with Tim Bunce's L, so it pays to be familiar with its documentation. See the documentation for Dave Rolsky's L module for details on the methods this module's classes inherit from it. There's lots more information in these exception objects, so use them! =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2008, David Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Exception-Class-DBI-1.00/Makefile.PL0000444000076600007660000000212211015164132015742 0ustar daviddavid# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01 unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; Module::Build::Compat->run_build_pl(args => \@ARGV); require Module::Build; Module::Build::Compat->write_makefile(build_class => 'Module::Build'); Exception-Class-DBI-1.00/MANIFEST0000444000076600007660000000023511015164132015124 0ustar daviddavidBuild.PL Changes lib/Exception/Class/DBI.pm Makefile.PL MANIFEST This list of files META.yml README t/dbh.t t/dbi.t t/drh.t t/sth.t t/subclass.t t/z_pod.t Exception-Class-DBI-1.00/META.yml0000444000076600007660000000146211015164132015247 0ustar daviddavid--- name: Exception-Class-DBI version: 1.00 author: - 'David Wheeler ' abstract: DBI Exception objects license: perl resources: license: http://dev.perl.org/licenses/ configure_requires: Module::Build: 0.2701 requires: DBI: 1.28 Exception::Class: 1.02 build_requires: Module::Build: 0.2701 Test::Harness: 2.03 Test::More: 0.17 recommends: Test::Pod: 1.20 provides: Exception::Class::DBI: file: lib/Exception/Class/DBI.pm version: 1.00 Exception::Class::DBI::DBH: file: lib/Exception/Class/DBI.pm Exception::Class::DBI::H: file: lib/Exception/Class/DBI.pm Exception::Class::DBI::STH: file: lib/Exception/Class/DBI.pm generated_by: Module::Build version 0.280801 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Exception-Class-DBI-1.00/README0000444000076600007660000000311411015164132014652 0ustar daviddavidException/Class/DBI version 1.00 ================================ This module offers a set of DBI-specific exception classes. They inherit from Exception::Class::Base, the base class for all exception objects created by the Exception::Class module from the CPAN. Exception::Class::DBI itself offers a single class method, C, that returns a code reference appropriate for passing the DBI C attribute. The exception classes created by Exception::Class::DBI are designed to be thrown in certain DBI contexts; the code reference returned by handler() and passed to the DBI C attribute determines the context, assembles the necessary metadata, and throws the apopropriate exception. Each of the Exception::Class::DBI classes offers a set of object accessor methods in addition to those provided by Exception::Class::Base. These can be used to output detailed output in the event of an exception. INSTALLATION To install this module, type the following: perl Build.PL ./Build ./Build test ./Build install Or, if you don't have Module::Build installed, type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: DBI 1.28 or later (1.30 or later strongly recommended). Exception::Class 1.02 or later (1.05 or later strongly recommended). Test::Simple 0.40 (for testing). COPYRIGHT AND LICENCE Copyright (c) 2002-2008, David Wheeler. Some Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Exception-Class-DBI-1.00/t/0000755000076600007660000000000011015164132014240 5ustar daviddavidException-Class-DBI-1.00/t/dbh.t0000444000076600007660000000474611015164132015173 0ustar daviddavid#!/usr/bin/perl -w # $Id: dbh.t 3917 2008-05-15 17:06:33Z david $ use strict; use Test::More tests => 27; BEGIN { use_ok('Exception::Class::DBI') or die } use DBI; ok( my $dbh = DBI->connect( 'dbi:ExampleP:dummy', '', '', { PrintError => 0, RaiseError => 0, HandleError => Exception::Class::DBI->handler }), 'Connect to database' ); END { $dbh->disconnect if $dbh }; # Check that the error_handler has been installed. isa_ok( $dbh->{HandleError}, 'CODE' ); # Trigger an exception. eval { $dbh->do('select foo from foo'); }; # Make sure we got the proper exception. ok( my $err = $@, "Get exception" ); isa_ok( $err, 'Exception::Class::DBI' ); isa_ok( $err, 'Exception::Class::DBI::H' ); isa_ok( $err, 'Exception::Class::DBI::DBH' ); # Check the accessor values. NOWARN: { # Prevent Perl 5.6 from complaining about usng $DBI::stderr only once. local $^W; is( $err->err, $DBI::stderr || 1, "Check err" ); } is( $err->errstr, 'Unknown field names: foo', "Check errstr" ); is( $err->error, 'DBD::ExampleP::db do failed: Unknown field names: foo', "Check error" ); is( $err->state, 'S1000', "Check state" ); ok( ! defined $err->retval, "Check retval" ); is( $err->warn, 1, "Check warn" ); is( $err->active, 1, "Check active" ); # For some reason, under perl < 5.6.2, $dbh->{Kids} returns a different value # inside the HandleError scope than it does outside that scope. So we're # checking for the perl version here to cover our butts on this test. This may # be fixed in the DBI soon. I'm using the old form of the Perl version number # as it seems safer with older Perls. See # http://groups.google.com/group/perl.dbi.dev/browse_thread/thread/6a1903e2eb251d45 # for details. is( $err->kids, ($] < 5.006_002 ? 1 : 0), "Check kids" ); is( $err->active_kids, 0, "Check active_kids" ); ok( ! $err->inactive_destroy, "Check inactive_destroy" ); is( $err->trace_level, 0, "Check trace_level" ); is( $err->fetch_hash_key_name, 'NAME', "Check fetch_hash_key_name" ); ok( ! $err->chop_blanks, "Check chop_blanks" ); is( $err->long_read_len, 80, "Check long_read_len" ); ok( ! $err->long_trunc_ok, "Check long_trunc_ok" ); ok( ! $err->taint, "Check taint" ); ok( $err->auto_commit, "Check auto_commit" ); is( $err->db_name, 'dummy', "Check db_name" ); is( $err->statement, 'select foo from foo', "Check statement" ); ok( ! defined $err->row_cache_size, "Check row_cache_size" ); # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it # does that. :-( exit; Exception-Class-DBI-1.00/t/dbi.t0000444000076600007660000000467311015164132015173 0ustar daviddavid#!/usr/bin/perl -w # $Id: dbi.t 3831 2008-05-06 17:49:25Z david $ use strict; use Test::More tests => 14; BEGIN { use_ok('Exception::Class::DBI') or die } use DBI; eval { DBI->connect( 'dbi:Bogus', '', '', { PrintError => 0, RaiseError => 0, HandleError => Exception::Class::DBI->handler }); }; ok( my $err = $@, "Catch exception" ); SKIP: { # Remove this skip when DBI->connect uses exceptions. skip 'HandleError not yet fully supported by DBI->connect', 12 unless ref $@; isa_ok( $err, 'Exception::Class::DBI' ); like( $err->error, qr{Can't connect\(dbi:Bogus HASH\([^\)]+\)\), no database driver specified and DBI_DSN env var not set}, "Check error" ); ok( ! defined $err->err, "Check err" ); ok( ! defined $err->errstr, "Check errstr" ); ok( ! defined $err->state, "Check state" ); ok( ! defined $err->retval, "Check retval" ); # Try to trigger a usage exception. eval { DBI->connect('', '', {}, # uh-oh, referenced password. { PrintError => 0, RaiseError => 0, HandleError => Exception::Class::DBI->handler }); }; ok( $err = $@, "Catch usage exception" ); isa_ok( $err, 'Exception::Class::DBI' ); is( $err->error, 'Usage: $class->connect([$dsn [,$user [,$passwd ' . '[,\%attr]]]])', "Check usage error" ); TODO: { # Remove this TODO when DBI->install_driver uses exceptions. local $TODO = "DBI->install_driver doesn't use HandleError Yet"; # Try to trigger a install driver error. eval { DBI->connect('dbi:dummy:foo', '', '', # dummy driver. { PrintError => 0, RaiseError => 0, HandleError => Exception::Class::DBI->handler }); }; ok( $err = $@, "Catch usage exception" ); isa_ok( $err, 'Exception::Class::DBI' ); SKIP: { # Remove this SKIP when DBI->install_driver uses exceptions. skip 'HandleError not logic not yet used by DBI->install_driver', 1 unless ref $err; # Can take out "ref $err" when the TODO is completed. is( $err->error, 'panic: $class->install_driver(dummy) failed', "Check driver error" ); } } } # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it # does that. :-( exit; Exception-Class-DBI-1.00/t/drh.t0000444000076600007660000000352011015164132015200 0ustar daviddavid#!/usr/bin/perl -w # $Id: drh.t 3831 2008-05-06 17:49:25Z david $ use strict; use Test::More tests => 21; BEGIN { use_ok('Exception::Class::DBI') } use DBI; { # Fake out DBD::ExampleP's connect method. Take the opportunity # to set the dynamic attributes. use DBD::ExampleP; local $^W; *DBD::ExampleP::dr::connect = sub { $_[0]->set_err(7, 'Dammit Jim!', 'ABCDE') }; } eval { DBI->connect('dbi:ExampleP:dummy', '', '', { PrintError => 0, RaiseError => 0, HandleError => Exception::Class::DBI->handler }); }; SKIP: { skip 'HandleError not logic not yet used by DBI->connect', 20 unless $DBI::VERSION gt '1.30'; ok( my $err = $@, "Caught exception" ); isa_ok( $err, 'Exception::Class::DBI' ); isa_ok( $err, 'Exception::Class::DBI::H' ); isa_ok( $err, 'Exception::Class::DBI::DRH' ); is( $err->err, 7, "Check err" ); is( $err->error, "DBI connect('dummy','',...) failed: Dammit Jim!", 'Check error' ); is( $err->errstr, 'Dammit Jim!', 'Check errstr' ); is( $err->state, 'ABCDE', 'Check state' ); ok( ! defined $err->retval, "Check retval" ); is( $err->warn, 1, "Check warn" ); is( $err->active, 1, "Check active" ); is( $err->kids, 0, "Check kids" ); is( $err->active_kids, 0, "Check acitive_kids" ); ok( ! $err->inactive_destroy, "Check inactive_destroy" ); is( $err->trace_level, 0, "Check trace_level" ); is( $err->fetch_hash_key_name, 'NAME', "Check fetch_hash_key_name" ); ok( ! $err->chop_blanks, "Check chop_blanks" ); is( $err->long_read_len, 80, "Check long_read_len" ); ok( ! $err->long_trunc_ok, "Check long_trunc_ok" ); ok( ! $err->taint, "Check taint" ); } # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it # does that. :-( exit; Exception-Class-DBI-1.00/t/sth.t0000444000076600007660000000563411015164132015231 0ustar daviddavid#!/usr/bin/perl -w # $Id: sth.t 3831 2008-05-06 17:49:25Z david $ use strict; use Test::More tests => 35; BEGIN { use_ok('Exception::Class::DBI') or die } # Use PurePerl to get around CursorName bug. BEGIN { $ENV{DBI_PUREPERL} = 2 } use DBI; ok( my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '', { PrintError => 0, RaiseError => 0, HandleError => Exception::Class::DBI->handler }), "Connect to database" ); END { $dbh->disconnect if $dbh }; # Check that the error_handler has been installed. isa_ok( $dbh->{HandleError}, 'CODE' ); # Trigger an exception. eval { my $sth = $dbh->prepare("select * from foo"); $sth->execute; }; # Make sure we got the proper exception. ok( my $err = $@, "Get exception" ); my $bang = $!; isa_ok( $err, 'Exception::Class::DBI' ); isa_ok( $err, 'Exception::Class::DBI::H' ); isa_ok( $err, 'Exception::Class::DBI::STH' ); is( $err->err, 2, "Check err" ); is( $err->errstr, "opendir(foo): $bang", "Check errstr" ); like( $err->error, qr/^DBD::ExampleP::st execute failed: opendir\(foo\): \E$bang/, "Check error" ); is( $err->state, 'S1000', "Check state" ); ok( ! defined $err->retval, "Check retval" ); is( $err->warn, 1, 'Check warn' ); ok( !$err->active, 'Check active' ); is( $err->kids, 0, 'Check kids' ); is( $err->active_kids, 0, 'Check active_kids' ); ok( ! $err->compat_mode, 'Check compat_mode' ); ok( ! $err->inactive_destroy, 'Check inactive_destroy' ); { # PurePerl->{TraceLevel} should return an integer, but it doesn't. It # returns undef instead. local $^W; cmp_ok( $err->trace_level, '==', 0, 'Check trace_level' ); } is( $err->fetch_hash_key_name, 'NAME', 'Check fetch_hash_key_name' ); ok( ! $err->chop_blanks, 'Check chop_blanks' ); is( $err->long_read_len, 80, 'Check long_read_len' ); ok( ! $err->long_trunc_ok, 'Check long_trunc_ok' ); ok( ! $err->taint, 'Check taint' ); is( $err->num_of_fields, 14, 'Check num_of_fields' ); is( $err->num_of_params, 0, 'Check num_of_params' ); is( ref $err->field_names, 'ARRAY', "Check field_names" ); # These tend to return undef. Probably ought to try to add tests to make # sure that they have array refs when they're supposed to. ok( ! defined $err->type, "Check type" ); # isa ARRAY ok( ! defined $err->precision, "Check precision" ); # isa ARRAY isa_ok( $err->scale, 'ARRAY', "Check scale" ); ok( ! defined $err->param_values, "Check praram_values" ); # isa HASH is( ref $err->nullable, 'ARRAY', "Check nullable" ); # ExampleP fails to get the CursorName attribute under DBI. Which is # why this test is using PurePerl, instead. ok( ! defined $err->cursor_name, "Check cursor_name" ); is( $err->statement, 'select * from foo', 'Check statement' ); ok( ! defined $err->rows_in_cache, "Check rows_in_cache" ); # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it # does that. :-( exit; Exception-Class-DBI-1.00/t/subclass.t0000444000076600007660000000373011015164132016245 0ustar daviddavid#!/usr/bin/perl -w use strict; use Test::More tests => 12; BEGIN { use_ok('Exception::Class::DBI') } SUBCLASSES: { package MyApp::Ex::DBI; use base 'Exception::Class::DBI'; package MyApp::Ex::DBI::H; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::H'; package MyApp::Ex::DBI::DRH; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DRH'; package MyApp::Ex::DBI::DBH; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::DBH'; package MyApp::Ex::DBI::STH; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::STH'; package MyApp::Ex::DBI::Unknown; use base 'MyApp::Ex::DBI', 'Exception::Class::DBI::Unknown'; } use DBI; # Make sure that the same handler is used every time. is +MyApp::Ex::DBI->handler, MyApp::Ex::DBI->handler, 'The handler code ref should always be the same for the subclass'; is +Exception::Class::DBI->handler, Exception::Class::DBI->handler, 'The base class handler should always be the same code ref'; isnt +MyApp::Ex::DBI->handler, Exception::Class::DBI->handler, 'The subclass handler should be different from the base class handler'; ok my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '', { PrintError => 0, RaiseError => 0, HandleError => MyApp::Ex::DBI->handler, }), 'Connect to database'; END { $dbh->disconnect if $dbh }; # Check that the error_handler has been installed. isa_ok $dbh->{HandleError}, 'CODE', 'The HandleError attribute'; # Trigger an exception. eval { my $sth = $dbh->prepare('select * from foo'); $sth->execute; }; # Make sure we got the proper exception. ok my $err = $@, 'Catch exception'; isa_ok $err, 'Exception::Class::DBI', 'The exception'; isa_ok $err, 'Exception::Class::DBI::H', 'The exception'; isa_ok $err, 'Exception::Class::DBI::STH', 'The exception'; isa_ok $err, 'MyApp::Ex::DBI::STH', 'The exception'; isa_ok $err, 'MyApp::Ex::DBI', 'The exception'; # This keeps Perl 5.6.2 from trying to run tests again. I've no idea why it # does that. :-( exit; Exception-Class-DBI-1.00/t/z_pod.t0000444000076600007660000000031211015164132015532 0ustar daviddavid#!perl -w # $Id: z_pod.t 3713 2008-05-02 20:25:02Z david $ use strict; use Test::More; eval "use Test::Pod 1.20"; plan skip_all => "Test::Pod 1.20 required for testing POD" if $@; all_pod_files_ok();