[Bast-commits] r3657 - in DBIx-Class/0.08/trunk: .
lib/DBIx/Class/Storage t
aherzog at dev.catalyst.perl.org
aherzog at dev.catalyst.perl.org
Tue Aug 7 19:51:00 GMT 2007
Author: aherzog
Date: 2007-08-07 19:50:59 +0100 (Tue, 07 Aug 2007)
New Revision: 3657
Modified:
DBIx-Class/0.08/trunk/Changes
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/trunk/t/91debug.t
Log:
Fix bind params debugging output; consolidate some related, duplicated code.
Modified: DBIx-Class/0.08/trunk/Changes
===================================================================
--- DBIx-Class/0.08/trunk/Changes 2007-08-07 15:26:32 UTC (rev 3656)
+++ DBIx-Class/0.08/trunk/Changes 2007-08-07 18:50:59 UTC (rev 3657)
@@ -1,4 +1,6 @@
Revision history for DBIx::Class
+ - fixes bind params in debug statements
+ (original test from abraxxa)
- fixed storage->connected fork bug
(test and fix from Radu Greab)
- add 1; to AccessorGroup.pm for stuff that still uses it
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2007-08-07 15:26:32 UTC (rev 3656)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2007-08-07 18:50:59 UTC (rev 3657)
@@ -744,9 +744,9 @@
# if on-connect sql statements are given execute them
foreach my $sql_statement (@{$self->on_connect_do || []}) {
- $self->debugobj->query_start($sql_statement) if $self->debug();
+ $self->_query_start($sql_statement);
$self->_dbh->do($sql_statement);
- $self->debugobj->query_end($sql_statement) if $self->debug();
+ $self->_query_end($sql_statement);
}
$self->_conn_pid($$);
@@ -868,6 +868,40 @@
return ($sql, \@bind);
}
+sub _fix_bind_params {
+ my ($self, @bind) = @_;
+
+ ### Turn @bind from something like this:
+ ### ( [ "artist", 1 ], [ "cdid", 1, 3 ] )
+ ### to this:
+ ### ( "'1'", "'1'", "'3'" )
+ return
+ map {
+ if ( defined( $_ && $_->[1] ) ) {
+ map { qq{'$_'}; } @{$_}[ 1 .. $#$_ ];
+ }
+ else { q{'NULL'}; }
+ } @bind;
+}
+
+sub _query_start {
+ my ( $self, $sql, @bind ) = @_;
+
+ if ( $self->debug ) {
+ @bind = $self->_fix_bind_params(@bind);
+ $self->debugobj->query_start( $sql, @bind );
+ }
+}
+
+sub _query_end {
+ my ( $self, $sql, @bind ) = @_;
+
+ if ( $self->debug ) {
+ @bind = $self->_fix_bind_params(@bind);
+ $self->debugobj->query_end( $sql, @bind );
+ }
+}
+
sub _dbh_execute {
my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
@@ -877,11 +911,7 @@
my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
- if ($self->debug) {
- my @debug_bind =
- map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind;
- $self->debugobj->query_start($sql, @debug_bind);
- }
+ $self->_query_start( $sql, @$bind );
my $sth = $self->sth($sql,$op);
@@ -908,11 +938,7 @@
my $rv = $sth->execute();
$self->throw_exception($sth->errstr) if !$rv;
- if ($self->debug) {
- my @debug_bind =
- map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @$bind;
- $self->debugobj->query_end($sql, @debug_bind);
- }
+ $self->_query_end( $sql, @$bind );
return (wantarray ? ($rv, $sth, @$bind) : $rv);
}
@@ -944,10 +970,7 @@
@colvalues{@$cols} = (0..$#$cols);
my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
- if ($self->debug) {
- my @debug_bind = map { defined $_->[1] ? qq{$_->[1]} : q{'NULL'} } @bind;
- $self->debugobj->query_start($sql, @debug_bind);
- }
+ $self->_query_start( $sql, @bind );
my $sth = $self->sth($sql);
# @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
@@ -985,10 +1008,7 @@
my $rv = $sth->execute_array({ArrayTupleStatus => $tuple_status});
$self->throw_exception($sth->errstr) if !$rv;
- if ($self->debug) {
- my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
- $self->debugobj->query_end($sql, @debug_bind);
- }
+ $self->_query_end( $sql, @bind );
return (wantarray ? ($rv, $sth, @bind) : $rv);
}
@@ -1418,14 +1438,14 @@
next if($line =~ /^BEGIN TRANSACTION/m);
next if($line =~ /^COMMIT/m);
next if $line =~ /^\s+$/; # skip whitespace only
- $self->debugobj->query_start($line) if $self->debug;
+ $self->_query_start($line);
eval {
$self->dbh->do($line); # shouldn't be using ->dbh ?
};
if ($@) {
warn qq{$@ (running "${line}")};
}
- $self->debugobj->query_end($line) if $self->debug;
+ $self->_query_end($line);
}
}
}
Modified: DBIx-Class/0.08/trunk/t/91debug.t
===================================================================
--- DBIx-Class/0.08/trunk/t/91debug.t 2007-08-07 15:26:32 UTC (rev 3656)
+++ DBIx-Class/0.08/trunk/t/91debug.t 2007-08-07 18:50:59 UTC (rev 3657)
@@ -7,7 +7,7 @@
my $schema = DBICTest->init_schema();
-plan tests => 5;
+plan tests => 6;
ok ( $schema->storage->debug(1), 'debug' );
ok ( defined(
@@ -47,4 +47,17 @@
ok($@, 'Died on closed FH');
open(STDERR, '>&STDERRCOPY');
+# test trace output correctness for bind params
+{
+ my $sql = '';
+ $schema->storage->debugcb( sub { $sql = $_[1] } );
+
+ my @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } );
+ like(
+ $sql,
+ qr/\QSELECT me.cdid, me.artist, me.title, me.year FROM cd me WHERE ( artist = ? AND cdid BETWEEN ? AND ? ): '1', '1', '3'\E/,
+ 'got correct SQL with all bind parameters'
+ );
+}
+
1;
More information about the Bast-commits
mailing list