X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fstorage%2Fdebug.t;h=e3cef381ec2154032171b708d4154f9e23d81a54;hb=c0329273268971824784f239f32c7246e68da9c5;hp=cb6dd2c8b62ded3b96ed335cd528d4d87bd64272;hpb=0491b597f9bf7f3731f5a2799041f2596b0f46be;p=dbsrgits%2FDBIx-Class.git diff --git a/t/storage/debug.t b/t/storage/debug.t index cb6dd2c..e3cef38 100644 --- a/t/storage/debug.t +++ b/t/storage/debug.t @@ -1,67 +1,185 @@ +BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } + use strict; -use warnings; +use warnings; +no warnings 'once'; + +BEGIN { + delete @ENV{qw( + DBIC_TRACE + DBIC_TRACE_PROFILE + DBICTEST_SQLITE_USE_FILE + DBICTEST_VIA_REPLICATED + )}; +} use Test::More; -use lib qw(t/lib); +use Test::Exception; +use Try::Tiny; +use File::Spec; + use DBICTest; -use DBIC::DebugObj; -use DBIC::SqlMakerTest; use Path::Class qw/file/; my $schema = DBICTest->init_schema(); +my $lfn = file("t/var/sql-$$.log"); +unlink $lfn or die $! + if -e $lfn; -ok ( $schema->storage->debug(1), 'debug' ); -$schema->storage->debugfh(file('t/var/sql.log')->openw); +# make sure we are testing the vanilla debugger and not ::PrettyPrint +require DBIx::Class::Storage::Statistics; +$schema->storage->debugobj(DBIx::Class::Storage::Statistics->new); +ok ( $schema->storage->debug(1), 'debug' ); +$schema->storage->debugfh($lfn->openw); $schema->storage->debugfh->autoflush(1); -my $rs = $schema->resultset('CD')->search({}); -$rs->count(); +$schema->resultset('CD')->count; -my $log = file('t/var/sql.log')->openr; -my $line = <$log>; -$log->close(); -ok($line =~ /^SELECT COUNT/, 'Log success'); +my @loglines = $lfn->slurp; +is (@loglines, 1, 'one line of log'); +like($loglines[0], qr/^SELECT COUNT/, 'File log via debugfh success'); $schema->storage->debugfh(undef); -$ENV{'DBIC_TRACE'} = '=t/var/foo.log'; -$rs = $schema->resultset('CD')->search({}); -$rs->count(); -$log = file('t/var/foo.log')->openr; -$line = <$log>; -$log->close(); -ok($line =~ /^SELECT COUNT/, 'Log success'); -$schema->storage->debugobj->debugfh(undef); -delete($ENV{'DBIC_TRACE'}); + +{ + local $ENV{DBIC_TRACE} = "=$lfn"; + unlink $lfn; + + $schema->resultset('CD')->count; + + my $schema2 = DBICTest->init_schema(no_deploy => 1); + $schema2->storage->_do_query('SELECT 1'); # _do_query() logs via standard mechanisms + + my @loglines = $lfn->slurp; + is(@loglines, 2, '2 lines of log'); + like($loglines[0], qr/^SELECT COUNT/, 'Env log from schema1 success'); + like($loglines[1], qr/^SELECT 1:/, 'Env log from schema2 success'); + + $schema->storage->debugobj->debugfh(undef) +} + +END { + unlink $lfn; +} + open(STDERRCOPY, '>&STDERR'); -stat(STDERRCOPY); # nop to get warnings quiet -close(STDERR); -eval { - $rs = $schema->resultset('CD')->search({}); - $rs->count(); + +my $exception_line_number; +# STDERR will be closed, no T::B diag in blocks +my $exception = try { + close(STDERR); + $exception_line_number = __LINE__ + 1; # important for test, do not reformat + $schema->resultset('CD')->search({})->count; +} catch { + $_ +} finally { + # restore STDERR + open(STDERR, '>&STDERRCOPY'); }; -ok($@, 'Died on closed FH'); -open(STDERR, '>&STDERRCOPY'); -# test trace output correctness for bind params +ok $exception =~ / + \QDuplication of STDERR for debug output failed (perhaps your STDERR is closed?)\E + .+ + \Qat @{[__FILE__]} line $exception_line_number\E$ +/xms + or diag "Unexpected exception text:\n\n$exception\n"; + +my @warnings; +$exception = try { + local $SIG{__WARN__} = sub { push @warnings, @_ if $_[0] =~ /character/i }; + close STDERR; + open(STDERR, '>', File::Spec->devnull) or die $!; + $schema->resultset('CD')->search({ title => "\x{1f4a9}" })->count; + ''; +} catch { + $_; +} finally { + # restore STDERR + close STDERR; + open(STDERR, '>&STDERRCOPY'); +}; + +die "How did that fail... $exception" + if $exception; + +is_deeply(\@warnings, [], 'No warnings with unicode on STDERR'); + +# test debugcb and debugobj protocol +{ + my $rs = $schema->resultset('CD')->search( { + artist => 1, + cdid => { -between => [ 1, 3 ] }, + title => { '!=' => \[ '?', undef ] } + }); + + my $sql_trace = 'SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( ( artist = ? AND ( cdid BETWEEN ? AND ? ) AND title != ? ) )'; + my @bind_trace = qw( '1' '1' '3' NULL ); # quotes are in fact part of the trace + + + my @args; + $schema->storage->debugcb(sub { push @args, @_ } ); + + $rs->all; + + is_deeply( \@args, [ + "SELECT", + sprintf( "%s: %s\n", $sql_trace, join ', ', @bind_trace ), + ]); + + { + package DBICTest::DebugObj; + our @ISA = 'DBIx::Class::Storage::Statistics'; + + sub query_start { + my $self = shift; + ( $self->{_traced_sql}, @{$self->{_traced_bind}} ) = @_; + } + } + + my $do = $schema->storage->debugobj(DBICTest::DebugObj->new); + + $rs->all; + + is( $do->{_traced_sql}, $sql_trace ); + + is_deeply ( $do->{_traced_bind}, \@bind_trace ); +} + +# recreate test as seen in DBIx::Class::QueryLog +# the rationale is that if someone uses a non-IO::Handle object +# on CPAN, many are *bound* to use one on darkpan. Thus this +# test to ensure there is no future silent breakage { - my ($sql, @bind); - $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind)); - - my @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } ); - is_same_sql_bind( - $sql, \@bind, - "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( artist = ? AND (cdid BETWEEN ? AND ?) )", - [qw/'1' '1' '3'/], - 'got correct SQL with all bind parameters (debugcb)' - ); - - @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } ); - is_same_sql_bind( - $sql, \@bind, - "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( artist = ? AND (cdid BETWEEN ? AND ?) )", ["'1'", "'1'", "'3'"], - 'got correct SQL with all bind parameters (debugobj)' - ); + my $output = ""; + + { + package DBICTest::_Printable; + + sub print { + my ($self, @args) = @_; + $output .= join('', @args); + } + } + + $schema->storage->debugobj(undef); + $schema->storage->debug(1); + $schema->storage->debugfh( bless {}, "DBICTest::_Printable" ); + $schema->storage->txn_do( sub { $schema->resultset('Artist')->count } ); + + like ( + $output, + qr/ + \A + ^ \QBEGIN WORK\E \s*? + ^ \QSELECT COUNT( * ) FROM artist me:\E \s*? + ^ \QCOMMIT\E \s*? + \z + /xm + ); + + $schema->storage->debug(0); + $schema->storage->debugfh(undef); } done_testing;