1#!perl -w 2# vim:sw=4:ts=8 3 4use strict; 5 6use Test::More tests => 99; 7 8## ---------------------------------------------------------------------------- 9## 09trace.t 10## ---------------------------------------------------------------------------- 11# 12## ---------------------------------------------------------------------------- 13 14BEGIN { 15 $ENV{DBI_TRACE} = 0; # for PurePerl - ensure DBI_TRACE is in the env 16 use_ok( 'DBI' ); 17} 18 19$|=1; 20 21 22my $trace_file = "dbitrace$$.log"; 23 241 while unlink $trace_file; 25warn "Can't unlink existing $trace_file: $!" if -e $trace_file; 26 27my $orig_trace_level = DBI->trace; 28DBI->trace(3, $trace_file); # enable trace before first driver load 29 30my $dbh = DBI->connect('dbi:ExampleP(AutoCommit=>1):', undef, undef); 31die "Unable to connect to ExampleP driver: $DBI::errstr" unless $dbh; 32 33isa_ok($dbh, 'DBI::db'); 34 35$dbh->dump_handle("dump_handle test, write to log file", 2); 36 37DBI->trace(0, undef); # turn off and restore to STDERR 38 39SKIP: { 40 skip "cygwin has buffer flushing bug", 1 if ($^O =~ /cygwin/i); 41 ok( -s $trace_file, "trace file size = " . -s $trace_file); 42} 43 44DBI->trace($orig_trace_level); # no way to restore previous outfile XXX 45 46 47# Clean up when we're done. 48END { $dbh->disconnect if $dbh; 49 1 while unlink $trace_file; }; 50 51## ---------------------------------------------------------------------------- 52# Check the database handle attributes. 53 54cmp_ok($dbh->{TraceLevel}, '==', $DBI::dbi_debug & 0xF, '... checking TraceLevel attribute'); 55 561 while unlink $trace_file; 57 58$dbh->trace(0, $trace_file); 59ok( -f $trace_file, '... trace file successfully created'); 60 61my @names = qw( 62 SQL 63 CON 64 ENC 65 DBD 66 TXN 67 foo bar baz boo bop 68); 69my %flag; 70my $all_flags = 0; 71 72foreach my $name (@names) { 73 print "parse_trace_flag $name\n"; 74 ok( my $flag1 = $dbh->parse_trace_flag($name) ); 75 ok( my $flag2 = $dbh->parse_trace_flags($name) ); 76 is( $flag1, $flag2 ); 77 78 $dbh->{TraceLevel} = $flag1; 79 is( $dbh->{TraceLevel}, $flag1 ); 80 81 $dbh->{TraceLevel} = 0; 82 is( $dbh->{TraceLevel}, 0 ); 83 84 $dbh->trace($flag1); 85 is $dbh->trace, $flag1; 86 is $dbh->{TraceLevel}, $flag1; 87 88 $dbh->{TraceLevel} = $name; # set by name 89 $dbh->{TraceLevel} = undef; # check no change on undef 90 is( $dbh->{TraceLevel}, $flag1 ); 91 92 $flag{$name} = $flag1; 93 $all_flags |= $flag1 94 if defined $flag1; # reduce noise if there's a bug 95} 96 97print "parse_trace_flag @names\n"; 98ok(eq_set([ keys %flag ], [ @names ]), '...'); 99$dbh->{TraceLevel} = 0; 100$dbh->{TraceLevel} = join "|", @names; 101is($dbh->{TraceLevel}, $all_flags, '...'); 102 103{ 104 print "inherit\n"; 105 my $sth = $dbh->prepare("select ctime, name from foo"); 106 isa_ok( $sth, 'DBI::st' ); 107 is( $sth->{TraceLevel}, $all_flags ); 108} 109 110$dbh->{TraceLevel} = 0; 111ok !$dbh->{TraceLevel}; 112$dbh->{TraceLevel} = 'ALL'; 113ok $dbh->{TraceLevel}; 114 115{ 116 print "test unknown parse_trace_flag\n"; 117 my $warn = 0; 118 local $SIG{__WARN__} = sub { 119 if ($_[0] =~ /unknown/i) { ++$warn; print "caught warn: ",@_ }else{ warn @_ } 120 }; 121 is $dbh->parse_trace_flag("nonesuch"), undef; 122 is $warn, 0; 123 is $dbh->parse_trace_flags("nonesuch"), 0; 124 is $warn, 1; 125 is $dbh->parse_trace_flags("nonesuch|SQL|nonesuch2"), $dbh->parse_trace_flag("SQL"); 126 is $warn, 2; 127} 128 129$dbh->dump_handle("dump_handle test, write to log file", 2); 130 131$dbh->trace(0); 132ok !$dbh->{TraceLevel}; 133$dbh->trace(undef, "STDERR"); # close $trace_file 134ok( -s $trace_file ); 135 1361; 137# end 138