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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
#!perl -w
# vim:sw=4:ts=8
use strict;
# 66 tests originally
use Test::More tests => 66;
## ----------------------------------------------------------------------------
## 09trace.t
## ----------------------------------------------------------------------------
#
## ----------------------------------------------------------------------------
BEGIN {
use_ok( 'DBI' );
}
$|=1;
## ----------------------------------------------------------------------------
# Connect to the example driver.
my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
{ PrintError => 0,
RaiseError => 1,
PrintWarn => 1,
});
isa_ok( $dbh, 'DBI::db' );
# Clean up when we're done.
END { $dbh->disconnect if $dbh };
## ----------------------------------------------------------------------------
# Check the database handle attributes.
cmp_ok($dbh->{TraceLevel}, '==', $DBI::dbi_debug & 0xF, '... checking TraceLevel attribute');
my $trace_file = "dbitrace.log";
1 while unlink $trace_file;
$dbh->trace(0, $trace_file);
ok( -f $trace_file, '... trace file successfully created');
my @names = qw(
SQL
foo bar baz boo bop
);
my %flag;
my $all_flags = 0;
foreach my $name (@names) {
print "parse_trace_flag $name\n";
ok( my $flag1 = $dbh->parse_trace_flag($name) );
ok( my $flag2 = $dbh->parse_trace_flags($name) );
is( $flag1, $flag2 );
$dbh->{TraceLevel} = $flag1;
is( $dbh->{TraceLevel}, $flag1 );
$dbh->{TraceLevel} = 0;
is( $dbh->{TraceLevel}, 0 );
$dbh->trace($flag1);
is $dbh->trace, $flag1;
is $dbh->{TraceLevel}, $flag1;
$dbh->{TraceLevel} = $name; # set by name
$dbh->{TraceLevel} = undef; # check no change on undef
is( $dbh->{TraceLevel}, $flag1 );
$flag{$name} = $flag1;
$all_flags |= $flag1
if defined $flag1; # reduce noise if there's a bug
}
print "parse_trace_flag @names\n";
ok(eq_set([ keys %flag ], [ @names ]), '...');
$dbh->{TraceLevel} = 0;
$dbh->{TraceLevel} = join "|", @names;
is($dbh->{TraceLevel}, $all_flags, '...');
{
print "inherit\n";
my $sth = $dbh->prepare("select ctime, name from foo");
isa_ok( $sth, 'DBI::st' );
is( $sth->{TraceLevel}, $all_flags );
}
$dbh->{TraceLevel} = 0;
ok !$dbh->{TraceLevel};
$dbh->{TraceLevel} = 'ALL';
ok $dbh->{TraceLevel};
{
print "unknown parse_trace_flag\n";
my $warn = 0;
local $SIG{__WARN__} = sub {
if ($_[0] =~ /unknown/i) { ++$warn; print "warn: ",@_ }else{ warn @_ }
};
is $dbh->parse_trace_flag("nonesuch"), undef;
is $warn, 0;
is $dbh->parse_trace_flags("nonesuch"), 0;
is $warn, 1;
is $dbh->parse_trace_flags("nonesuch|SQL|nonesuch2"), $dbh->parse_trace_flag("SQL");
is $warn, 2;
}
$dbh->trace(0);
ok !$dbh->{TraceLevel};
$dbh->trace(undef, "STDERR"); # close $trace_file
ok( -s $trace_file );
1;
# end
|
