Author: timbo
Date: Mon Jan 2 06:26:47 2012
New Revision: 15059
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/t/30subclass.t
Log:
Fixed $dbh->clone({}) RT73250
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Mon Jan 2 06:26:47 2012
@@ -12,6 +12,8 @@
Fixed the definition of ArrayTupleStatus and remove confusion over
rows affected in list context of execute_array (Martin J. Evans)
Fixed sql_type_cast example and typo in errors (Martin J. Evans)
+ Fixed Gofer error handling for keeperr methods like ping (Tim Bunce)
+ Fixed $dbh->clone({}) RT73250 (Tim Bunce)
Enhanced and standardized driver trace level mechanism (Tim Bunce)
Removed old code that was an inneffective attempt to detect
@@ -22,6 +24,7 @@
Added TXN trace flags and applied CON and TXN to relevant methods (Tim Bunce)
Added some more fetchall_arrayref(..., $maxrows) tests (Tim Bunce)
Clarified docs for fetchall_arrayref called on an inactive handle.
+ Clarified docs for clone method (Tim Bunce)
Reserved spatialite_ as a driver prefix for DBD::Spatialite
Reserved mo_ as a driver prefix for DBD::MO
Updated link to the SQL Reunion 95 docs, RT69577 (Ash Daminato)
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Mon Jan 2 06:26:47 2012
@@ -1511,8 +1511,11 @@
sub clone {
my ($old_dbh, $attr) = @_;
- my $closure = $old_dbh->{dbi_connect_closure} or return;
- unless ($attr) {
+
+ my $closure = $old_dbh->{dbi_connect_closure}
+ or return $old_dbh->set_err($DBI::stderr, "Can't clone handle");
+
+ unless ($attr) { # XXX deprecated, caller should always pass a hash ref
# copy attributes visible in the attribute cache
keys %$old_dbh; # reset iterator
while ( my ($k, $v) = each %$old_dbh ) {
@@ -1528,6 +1531,7 @@
ShowErrorStatement TaintIn TaintOut
));
}
+
# use Data::Dumper; warn Dumper([$old_dbh, $attr]);
my $new_dbh = &$closure($old_dbh, $attr);
unless ($new_dbh) {
@@ -1535,6 +1539,7 @@
my $drh = $old_dbh->{Driver};
return $old_dbh->set_err($drh->err, $drh->errstr, $drh->state);
}
+ $new_dbh->{dbi_connect_closure} = $closure;
return $new_dbh;
}
@@ -4307,31 +4312,26 @@
=head3 C<clone>
- $new_dbh = $dbh->clone();
$new_dbh = $dbh->clone(\%attr);
The C<clone> method duplicates the $dbh connection by connecting
with the same parameters ($dsn, $user, $password) as originally used.
The attributes for the cloned connect are the same as those used
-for the original connect, with some other attributes merged over
-them depending on the \%attr parameter.
-
-If \%attr is given then the attributes it contains are merged into
-the original attributes and override any with the same names.
-Effectively the same as doing:
+for the I<original> connect, with any other attributes in C<\%attr>
+merged over them. Effectively the same as doing:
%attribues_used = ( %original_attributes, %attr );
If \%attr is not given then it defaults to a hash containing all
the attributes in the attribute cache of $dbh excluding any non-code
references, plus the main boolean attributes (RaiseError, PrintError,
-AutoCommit, etc.). This behaviour is subject to change.
+AutoCommit, etc.). I<This behaviour is unreliable and so use of clone without
+an argument is deprecated.>
The clone method can be used even if the database handle is disconnected.
-The C<clone> method was added in DBI 1.33. It is very new and likely
-to change.
+The C<clone> method was added in DBI 1.33.
=head3 C<data_sources>
Modified: dbi/trunk/t/30subclass.t
==============================================================================
--- dbi/trunk/t/30subclass.t (original)
+++ dbi/trunk/t/30subclass.t Mon Jan 2 06:26:47 2012
@@ -66,7 +66,7 @@
# =================================================
package main;
-use Test::More tests => 36;
+use Test::More tests => 43;
BEGIN {
use_ok( 'DBI' );
@@ -139,13 +139,24 @@
is($dbh2 != $dbh, 1);
is($dbh2->{CompatMode}, 1);
-my $dbh3 = $dbh->clone;
+my $dbh3 = $dbh->clone({});
isa_ok( $dbh3, 'MyDBI::db', 'Clone B' );
is($dbh3 != $dbh, 1);
is($dbh3 != $dbh2, 1);
isa_ok( $dbh3, 'MyDBI::db');
is($dbh3->{CompatMode}, 1);
+my $dbh2c = $dbh2->clone;
+isa_ok( $dbh2c, 'MyDBI::db', "Clone of clone A" );
+is($dbh2c != $dbh2, 1);
+is($dbh2c->{CompatMode}, 1);
+
+my $dbh3c = $dbh3->clone({ CompatMode => 0 });
+isa_ok( $dbh3c, 'MyDBI::db', 'Clone of clone B' );
+is((grep { $dbh3c == $_ } $dbh, $dbh2, $dbh3), 0);
+isa_ok( $dbh3c, 'MyDBI::db');
+ok(!$dbh3c->{CompatMode});
+
$tmp = $dbh->sponge_test_installed_method('foo','bar');
isa_ok( $tmp, "ARRAY", "installed method" );
is_deeply( $tmp, [qw( foo bar )] );
