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
|
#!/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;
|
