Author: timbo
Date: Mon May 10 15:03:45 2004
New Revision: 334
Modified:
dbi/trunk/DBI.xs
dbi/trunk/lib/DBD/ExampleP.pm
dbi/trunk/t/06attrs.t
dbi/trunk/t/40profile.t
Log:
Change "DBI handle cleared whilst ..." to "DBI handle 0x%x cleared whilst ..."
to easy tracing.
Fixed parameter handling in DBD::ExampleP and add 'support' for non-select statements
Fixed t/40profile.t to not do() a select statement
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Mon May 10 15:03:45 2004
@@ -1159,27 +1159,27 @@
if (DBIc_TYPE(imp_xxh) <= DBIt_DB) {
imp_dbh_t *imp_dbh = (imp_dbh_t*)imp_xxh; /* works for DRH also */
if (DBIc_CACHED_KIDS(imp_dbh)) {
- warn("DBI handle cleared whilst still holding %d cached kids",
- HvKEYS(DBIc_CACHED_KIDS(imp_dbh)) );
+ warn("DBI handle 0x%x cleared whilst still holding %d cached kids",
+ DBIc_MY_H(imp_xxh), HvKEYS(DBIc_CACHED_KIDS(imp_dbh)) );
SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); /* may recurse */
DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
}
}
if (DBIc_ACTIVE(imp_xxh)) { /* bad news */
- warn("DBI handle cleared whilst still active");
+ warn("DBI handle 0x%x cleared whilst still active", DBIc_MY_H(imp_xxh));
dump = TRUE;
}
/* check that the implementor has done its own housekeeping */
if (DBIc_IMPSET(imp_xxh)) {
- warn("DBI handle has uncleared implementors data");
+ warn("DBI handle 0x%x has uncleared implementors data",
DBIc_MY_H(imp_xxh));
dump = TRUE;
}
if (DBIc_KIDS(imp_xxh)) {
- warn("DBI handle has %d uncleared child handles",
- (int)DBIc_KIDS(imp_xxh));
+ warn("DBI handle 0x%x has %d uncleared child handles",
+ DBIc_MY_H(imp_xxh), (int)DBIc_KIDS(imp_xxh));
dump = TRUE;
}
}
Modified: dbi/trunk/lib/DBD/ExampleP.pm
==============================================================================
--- dbi/trunk/lib/DBD/ExampleP.pm (original)
+++ dbi/trunk/lib/DBD/ExampleP.pm Mon May 10 15:03:45 2004
@@ -82,34 +82,42 @@
sub prepare {
my($dbh, $statement)= @_;
+ my @fields;
+ my($fields, $dir) = $statement =~ m/^\s*select\s+(.*?)\s+from\s+(\S*)/i;
- my($fields, $dir)
- = $statement =~ m/^\s*select\s+(.*?)\s+from\s+(\S*)/i;
- return $dbh->set_err(1, "Syntax error in select statement (\"$statement\")")
- unless defined $fields and defined $dir;
+ if (defined $fields and defined $dir) {
+ @fields = ($fields eq '*')
+ ? keys %DBD::ExampleP::statnames
+ : split(/\s*,\s*/, $fields);
+ }
+ else {
+ return $dbh->set_err(1, "Syntax error in select statement
(\"$statement\")")
+ unless $statement =~ m/^\s*set\s+/;
+ # the SET syntax is just a hack so the ExampleP driver can
+ # be used to test non-select statements.
+ # No we have DBI::DBM etc ExampleP should be deprecated
+ }
my ($outer, $inner) = DBI::_new_sth($dbh, {
'Statement' => $statement,
}, ['example implementors private data '.__PACKAGE__]);
- my @fields = ($fields eq '*')
- ? keys %DBD::ExampleP::statnames
- : split(/\s*,\s*/, $fields);
-
my @bad = map {
defined $DBD::ExampleP::statnames{$_} ? () : $_
} @fields;
return $dbh->set_err(1, "Unknown field names: @bad")
if @bad;
- $inner->{dbd_param} = [];
- @{ $inner->{'dbd_param'} } = ($dir) if $dir !~ /\?/;
-
- $outer->STORE('NAME' => [EMAIL PROTECTED]);
- $outer->STORE('NULLABLE' => [ (0) x @fields ]);
$outer->STORE('NUM_OF_FIELDS' => scalar(@fields));
- $outer->STORE('NUM_OF_PARAMS' => ($dir !~ /\?/) ? 0 : 1);
- $outer->STORE('SCALE' => [ (0) x @fields ] );
+
+ $inner->{'dbd_ex_dir'} = $dir if defined($dir) && $dir !~ /\?/;
+ $outer->STORE('NUM_OF_PARAMS' => ($dir) ? $dir =~ tr/?/?/ : 0);
+
+ if (@fields) {
+ $outer->STORE('NAME' => [EMAIL PROTECTED]);
+ $outer->STORE('NULLABLE' => [ (0) x @fields ]);
+ $outer->STORE('SCALE' => [ (0) x @fields ]);
+ }
$outer;
}
@@ -285,10 +293,12 @@
}
my $dbd_param = $sth->{'dbd_param'} || [];
- return $sth->set_err(2, @$dbd_param." values bound when 1 expected")
- unless @$dbd_param == 1;
+ return $sth->set_err(2, @$dbd_param." values bound when $sth->{NUM_OF_PARAMS}
expected")
+ unless @$dbd_param == $sth->{NUM_OF_PARAMS};
+
+ return 0 unless $sth->{NUM_OF_FIELDS}; # not a select
- $dir = $dbd_param->[0];
+ $dir = $dbd_param->[0] || $sth->{dbd_ex_dir};
return $sth->set_err(2, "No bind parameter supplied")
unless defined $dir;
Modified: dbi/trunk/t/06attrs.t
==============================================================================
--- dbi/trunk/t/06attrs.t (original)
+++ dbi/trunk/t/06attrs.t Mon May 10 15:03:45 2004
@@ -104,13 +104,13 @@
# ------ Test the statement handle attributes.
# Create a statement handle.
-(ok my $sth = $dbh->prepare("select ctime, name from foo") );
+(ok my $sth = $dbh->prepare("select ctime, name from ?") );
ok( !$sth->{Executed} );
ok( !$dbh->{Executed} );
is( $sth->{ErrCount}, 0 );
# Trigger an exception.
-eval { $sth->execute };
+eval { $sth->execute("foo") };
ok( $err = $@ );
# we don't check actual opendir error msg because of locale differences
like( $err, qr/^DBD::(ExampleP|Multiplex)::st execute failed: opendir\(foo\): /i );
@@ -159,7 +159,7 @@
ok( ! defined $sth->{CursorName} );
is( $sth->{NUM_OF_FIELDS}, 2 );
-is( $sth->{NUM_OF_PARAMS}, 0 );
+is( $sth->{NUM_OF_PARAMS}, 1 );
ok( my $name = $sth->{NAME} );
is( @$name, 2 );
ok( $name->[0] eq 'ctime' );
@@ -199,7 +199,7 @@
ok( my $params = $sth->{ParamValues} );
is( $params->{1}, 'foo' );
-is( $sth->{Statement}, "select ctime, name from foo" );
+is( $sth->{Statement}, "select ctime, name from ?" );
ok( ! defined $sth->{RowsInCache} );
# $h->{TraceLevel} tests are in t/09trace.t
Modified: dbi/trunk/t/40profile.t
==============================================================================
--- dbi/trunk/t/40profile.t (original)
+++ dbi/trunk/t/40profile.t Mon May 10 15:03:45 2004
@@ -25,7 +25,7 @@
}
use Test;
-BEGIN { plan tests => 59; }
+BEGIN { plan tests => 60; }
use Data::Dumper;
$Data::Dumper::Indent = 1;
@@ -137,19 +137,24 @@
$sth = $dbh->prepare($sql);
$sth->execute();
while ( my $hash = $sth->fetchrow_hashref ) {}
-$dbh->do($sql); # check dbh do() gets associated with right statement
+undef $sth; # DESTROY
# check that the resulting tree fits the expected layout
$data = $dbh->{Profile}{Data};
ok($data);
ok(exists $data->{$sql});
-ok(keys %{$data->{$sql}}, 5);
+ok(keys %{$data->{$sql}}, 4);
+print "Profile Data keys: @{[ keys %{$data->{$sql}} ]}\n";
ok(exists $data->{$sql}{prepare});
ok(exists $data->{$sql}{execute});
ok(exists $data->{$sql}{fetchrow_hashref});
-ok(exists $data->{$sql}{do});
ok(exists $data->{$sql}{DESTROY});
+my $do_sql = "set foo=1";
+$dbh->do($do_sql); # check dbh do() gets associated with right statement
+ok(keys %{$data->{$do_sql}}, 2); # XXX extra one is DESTROY
+ok(exists $data->{$do_sql}{do});
+print "Profile Data keys: @{[ keys %{$data->{$do_sql}} ]}\n";
# try a custom path
