1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
#!/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;
|
