diff options
Diffstat (limited to 't/19fhtrace.t')
| -rw-r--r-- | t/19fhtrace.t | 306 |
1 files changed, 306 insertions, 0 deletions
diff --git a/t/19fhtrace.t b/t/19fhtrace.t new file mode 100644 index 0000000..d310db4 --- /dev/null +++ b/t/19fhtrace.t @@ -0,0 +1,306 @@ +#!perl -w +# vim:sw=4:ts=8 + +use strict; + +use Test::More tests => 27; + +## ---------------------------------------------------------------------------- +## 09trace.t +## ---------------------------------------------------------------------------- +# +## ---------------------------------------------------------------------------- + +BEGIN { + use_ok( 'DBI' ); +} + +$|=1; + +our $fancylogfn = "fancylog$$.log"; +our $trace_file = "dbitrace$$.log"; + +# Clean up when we're done. +END { 1 while unlink $fancylogfn; + 1 while unlink $trace_file; }; + +package PerlIO::via::TraceDBI; + +our $logline; + +sub OPEN { + return 1; +} + +sub PUSHED +{ + my ($class,$mode,$fh) = @_; + # When writing we buffer the data + my $buf = ''; + return bless \$buf,$class; +} + +sub FILL +{ + my ($obj,$fh) = @_; + return $logline; +} + +sub READLINE +{ + my ($obj,$fh) = @_; + return $logline; +} + +sub WRITE +{ + my ($obj,$buf,$fh) = @_; +# print "\n*** WRITING $buf\n"; + $logline = $buf; + return length($buf); +} + +sub FLUSH +{ + my ($obj,$fh) = @_; + return 0; +} + +sub CLOSE { +# print "\n*** CLOSING!!!\n"; + $logline = "**** CERRADO! ***"; + return -1; +} + +1; + +package PerlIO::via::MyFancyLogLayer; + +sub OPEN { + my ($obj, $path, $mode, $fh) = @_; + $$obj = $path; + return 1; +} + +sub PUSHED +{ + my ($class,$mode,$fh) = @_; + # When writing we buffer the data + my $logger; + return bless \$logger,$class; +} + +sub WRITE +{ + my ($obj,$buf,$fh) = @_; + $$obj->log($buf); + return length($buf); +} + +sub FLUSH +{ + my ($obj,$fh) = @_; + return 0; +} + +sub CLOSE { + my $self = shift; + $$self->close(); + return 0; +} + +1; + +package MyFancyLogger; + +use Symbol qw(gensym); + +sub new +{ + my $self = {}; + my $fh = gensym(); + open $fh, '>', $fancylogfn; + $self->{_fh} = $fh; + $self->{_buf} = ''; + return bless $self, shift; +} + +sub log +{ + my $self = shift; + my $fh = $self->{_fh}; + $self->{_buf} .= shift; + print $fh "At ", scalar localtime(), ':', $self->{_buf}, "\n" and + $self->{_buf} = '' + if $self->{_buf}=~tr/\n//; +} + +sub close { + my $self = shift; + return unless exists $self->{_fh}; + my $fh = $self->{_fh}; + print $fh "At ", scalar localtime(), ':', $self->{_buf}, "\n" and + $self->{_buf} = '' + if $self->{_buf}; + close $fh; + delete $self->{_fh}; +} + +1; + +package main; + +## ---------------------------------------------------------------------------- +# 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'); + +1 while unlink $trace_file; + +my $tracefd; +## ---------------------------------------------------------------------------- +# First use regular filehandle +open $tracefd, '>>', $trace_file; + +my $oldfd = select($tracefd); +$| = 1; +select $oldfd; + +ok(-f $trace_file, '... regular fh: trace file successfully created'); + +$dbh->trace(2, $tracefd); +ok( 1, '... regular fh: filehandle successfully set'); + +# +# read current size of file +# +my $filesz = (stat $tracefd)[7]; +$dbh->trace_msg("First logline\n", 1); +# +# read new file size and verify its different +# +my $newfsz = (stat $tracefd)[7]; +SKIP: { + skip 'on VMS autoflush using select does not work', 1 if $^O eq 'VMS'; + ok(($filesz != $newfsz), '... regular fh: trace_msg'); +} + +$dbh->trace(undef, "STDOUT"); # close $trace_file +ok(-f $trace_file, '... regular fh: file successfully changed'); + +$filesz = (stat $tracefd)[7]; +$dbh->trace_msg("Next logline\n"); +# +# read new file size and verify its same +# +$newfsz = (stat $tracefd)[7]; +ok(($filesz == $newfsz), '... regular fh: trace_msg after changing trace output'); + +#1 while unlink $trace_file; + +$dbh->trace(0); # disable trace + +{ # Open trace to glob. started failing in perl-5.10 + my $tf = "foo.log"; + 1 while unlink $tf; + 1 while unlink "*main::FOO"; + 1 while unlink "*main::STDERR"; + is (-f $tf, undef, "Tracefile removed"); + ok (open (FOO, ">", $tf), "Tracefile FOO opened"); + ok (-f $tf, "Tracefile created"); + DBI->trace (1, *FOO); + is (-f "*main::FOO", undef, "Regression test"); + DBI->trace_msg ("foo\n", 1); + DBI->trace (0, *STDERR); + close FOO; + open my $fh, "<", $tf; + is ((<$fh>)[-1], "foo\n", "Traced message"); + close $fh; + is (-f "*main::STDERR", undef, "Regression test"); + 1 while unlink $tf; + } + +SKIP: { + eval { require 5.008; }; + skip "Layered I/O not available in Perl $^V", 13 + if $@; +## ---------------------------------------------------------------------------- +# Then use layered filehandle +# +open TRACEFD, '+>:via(TraceDBI)', 'layeredtrace.out'; +print TRACEFD "*** Test our layer\n"; +my $result = <TRACEFD>; +is $result, "*** Test our layer\n", "... layered fh: file is layered: $result\n"; + +$dbh->trace(1, \*TRACEFD); +ok( 1, '... layered fh: filehandle successfully set'); + +$dbh->trace_msg("Layered logline\n", 1); + +$result = <TRACEFD>; +is $result, "Layered logline\n", "... layered fh: trace_msg: $result\n"; + +$dbh->trace(1, "STDOUT"); # close $trace_file +$result = <TRACEFD>; +is $result, "Layered logline\n", "... layered fh: close doesn't close: $result\n"; + +$dbh->trace_msg("Next logline\n", 1); +$result = <TRACEFD>; +is $result, "Layered logline\n", "... layered fh: trace_msg after change trace output: $result\n"; + +## ---------------------------------------------------------------------------- +# Then use scalar filehandle +# +my $tracestr; +open TRACEFD, '+>:scalar', \$tracestr; +print TRACEFD "*** Test our layer\n"; +ok 1, "... scalar trace: file is layered: $tracestr\n"; + +$dbh->trace(1, \*TRACEFD); +ok 1, '... scalar trace: filehandle successfully set'; + +$dbh->trace_msg("Layered logline\n", 1); +ok 1, "... scalar trace: $tracestr\n"; + +$dbh->trace(1, "STDOUT"); # close $trace_file +ok 1, "... scalar trace: close doesn't close: $tracestr\n"; + +$dbh->trace_msg("Next logline\n", 1); +ok 1, "... scalar trace: after change trace output: $tracestr\n"; + +## ---------------------------------------------------------------------------- +# Then use fancy logger +# +open my $fh, '>:via(MyFancyLogLayer)', MyFancyLogger->new(); + +$dbh->trace('SQL', $fh); + +$dbh->trace_msg("Layered logline\n", 1); +ok 1, "... logger: trace_msg\n"; + +$dbh->trace(1, "STDOUT"); # close $trace_file +ok 1, "... logger: close doesn't close\n"; + +$dbh->trace_msg("Next logline\n", 1); +ok 1, "... logger: trace_msg after change trace output\n"; + +close $fh; + +} + +1; + +# end |