Author: timbo
Date: Sun Nov 27 16:32:13 2005
New Revision: 2282
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/Driver.xst
dbi/trunk/t/03handle.t
dbi/trunk/t/40profile.t
Log:
Fixed take_imp_data to be more practical. Yeah!
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Sun Nov 27 16:32:13 2005
@@ -15,8 +15,7 @@ DBI::Changes - List of significant chang
Fixed dangling ref in $sth after parent $dbh destroyed
with thanks to [EMAIL PROTECTED] for the bug report #13151
Fixed prerequisites to include Storable thanks to Michael Schwern.
-
-XXX TODO: take_imp_data
+ Fixed take_imp_data to be more practical.
Change to require perl 5.6.1 (as advertised in 2003) not 5.6.0.
Changed internals to be more strictly coded thanks to Andy Lester.
@@ -33,7 +32,8 @@ XXX TODO: take_imp_data
when certain methods are called. For example:
$dbh->{Callbacks}->{prepare} = sub { ... };
With thanks to David Wheeler for the kick start.
- Added $h->{ChildHandles} (using weakrefs) thanks to Sam Tregar.
+ Added $h->{ChildHandles} (using weakrefs) thanks to Sam Tregar
+ I've recoded it in C so there's no significant performance impact.
Added $h->{Type} docs (returns 'dr', 'db', or 'st')
Adding trace message in DESTROY if InactiveDestroy enabled.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Sun Nov 27 16:32:13 2005
@@ -5020,7 +5020,7 @@ will generate a warning and return undef
Why would you want to do this? You don't, forget I even mentioned it.
Unless, that is, you're implementing something advanced like a
-multi-threaded connection pool.
+multi-threaded connection pool. See L<DBI::Pool>.
The returned $imp_data can be passed as a C<dbi_imp_data> attribute
to a later connect() call, even in a separate thread in the same
@@ -5032,12 +5032,15 @@ Some things to keep in mind...
B<*> the $imp_data holds the only reference to the underlying
database API connection data. That connection is still 'live' and
won't be cleaned up properly unless the $imp_data is used to create
-a new $dbh which can then disconnect() normally.
+a new $dbh which is then allowed to disconnect() normally.
B<*> using the same $imp_data to create more than one other new
$dbh at a time may well lead to unpleasant problems. Don't do that.
-The C<take_imp_data> method was added in DBI 1.36.
+Any child statement handles are effectively destroyed when take_imp_data() is
+called.
+
+The C<take_imp_data> method was added in DBI 1.36 but wasn't useful till 1.49.
=back
@@ -6894,12 +6897,12 @@ An old variable that should no longer be
=head2 DBI_PROFILE
The DBI_PROFILE environment variable can be used to enable profiling
-of DBI method calls. See <DBI::Profile> for more information.
+of DBI method calls. See L<DBI::Profile> for more information.
=head2 DBI_PUREPERL
The DBI_PUREPERL environment variable can be used to enable the
-use of DBI::PurePerl. See <DBI::PurePerl> for more information.
+use of DBI::PurePerl. See L<DBI::PurePerl> for more information.
=head1 WARNING AND ERROR MESSAGES
@@ -7322,7 +7325,7 @@ DBI::ProxyServer are part of the DBI dis
=item SQL Parser
-See also the SQL::Statement module, SQL parser and engine.
+See also the L<SQL::Statement> module, SQL parser and engine.
=back
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Sun Nov 27 16:32:13 2005
@@ -3878,6 +3878,7 @@ take_imp_data(h)
D_imp_xxh(h);
MAGIC *mg;
SV *imp_xxh_sv;
+ SV **tmp_svp;
CODE:
(void)cv; /* unused */
/*
@@ -3918,16 +3919,46 @@ take_imp_data(h)
* AutoCommit) match the state of the underlying connection.
*/
+ if (!DBIc_ACTIVE(imp_xxh)) {/* sanity check, may be relaxed later */
+ set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle
that's not Active", 0, "take_imp_data");
+ XSRETURN(0);
+ }
+
+ /* Ideally there should be no child statement handles existing when
+ * take_imp_data is called because when those statement handles are
+ * destroyed they may need to interact with the 'zombie' parent dbh.
+ * So we do our best to kill neautralize them.
+ */
if (DBIc_TYPE(imp_xxh) <= DBIt_DB && DBIc_CACHED_KIDS((imp_dbh_t*)imp_xxh))
clear_cached_kids(h, imp_xxh, "take_imp_data", 0);
- if (DBIc_KIDS(imp_xxh)) { /* safety check, may be relaxed later to
DBIc_ACTIVE_KIDS */
- set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle while
it still has kids", 0, "take_imp_data");
- XSRETURN(0);
+ if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) &&
SvROK(*tmp_svp)) {
+ AV *av = (AV*)SvRV(*tmp_svp);
+ HV *zombie_stash = gv_stashpv("DBI::zombie", GV_ADDWARN);
+ I32 kidslots;
+ for (kidslots = AvFILL(av); kidslots >= 0; --kidslots) {
+ SV **hp = av_fetch(av, kidslots, FALSE);
+ if (hp && SvROK(*hp) && SvMAGICAL(SvRV(*hp))) {
+ sv_unmagic(SvRV(*hp), 'P'); /* untie */
+ sv_bless(*hp, zombie_stash); /* neutralise */
+ }
+ }
}
- if (!DBIc_ACTIVE(imp_xxh)) {/* sanity check, may be relaxed later */
- set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle
that's not Active", 0, "take_imp_data");
+ /* The above measures may not be sufficient if weakrefs aren't available
+ * or something has a reference to the inner-handle of an sth.
+ * We'll require no Active kids, but just warn about others.
+ */
+ if (DBIc_ACTIVE_KIDS(imp_xxh)) {
+ set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle while
it still has Active kids", 0, "take_imp_data");
XSRETURN(0);
}
+ if (DBIc_KIDS(imp_xxh))
+ warn("take_imp_data from handle while it still has kids");
+
+ /* it may be better here to return a copy and poison the original
+ * rather than detatching and returning the original
+ */
+
+ /* --- perform the surgery */
dbih_getcom2(h, &mg); /* get the MAGIC so we can change it */
imp_xxh_sv = mg->mg_obj; /* take local copy of the imp_data pointer */
mg->mg_obj = Nullsv; /* sever the link from handle to imp_xxh */
Modified: dbi/trunk/Driver.xst
==============================================================================
--- dbi/trunk/Driver.xst (original)
+++ dbi/trunk/Driver.xst Sun Nov 27 16:32:13 2005
@@ -422,7 +422,7 @@ _prepare(sth, statement, attribs=Nullsv)
#ifdef dbd_st_prepare_sv
ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &sv_yes :
&sv_no;
#else
- ST(0) = dbd_st_prepare(sth, imp_sth, SVPV_nolen(statement), attribs) ?
&sv_yes : &sv_no;
+ ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ?
&sv_yes : &sv_no;
#endif
}
Modified: dbi/trunk/t/03handle.t
==============================================================================
--- dbi/trunk/t/03handle.t (original)
+++ dbi/trunk/t/03handle.t Sun Nov 27 16:32:13 2005
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 128;
+use Test::More tests => 135;
## ----------------------------------------------------------------------------
## 03handle.t - tests handles
@@ -258,13 +258,25 @@ SKIP: {
# handle take_imp_data test
SKIP: {
- skip "take_imp_data test not supported under DBI::PurePerl", 12 if
$DBI::PurePerl;
+ skip "take_imp_data test not supported under DBI::PurePerl", 19 if
$DBI::PurePerl;
my $dbh = DBI->connect("dbi:$driver:", '', '');
isa_ok($dbh, "DBI::db");
cmp_ok($drh->{Kids}, '==', 1, '... our Driver should have 1 Kid(s) here');
+ $dbh->prepare("select name from ?"); # destroyed at once
+ my $sth2 = $dbh->prepare("select name from ?"); # inactive
+ my $sth3 = $dbh->prepare("select name from ?"); # active:
+ $sth3->execute(".");
+ is $sth3->{Active}, 1;
+ is $dbh->{ActiveKids}, 1;
+
+ my $ChildHandles = $dbh->{ChildHandles};
+ ok $ChildHandles, 'we need weakrefs for take_imp_data to work safely with
child handles';
+ is @$ChildHandles, 3, 'should have 3 entries (implementation detail)';
+ is grep({ defined } @$ChildHandles), 2, 'should have 2 defined handles';
+
my $imp_data = $dbh->take_imp_data;
ok($imp_data, '... we got some imp_data to test');
# generally length($imp_data) = 112 for 32bit, 116 for 64 bit
@@ -275,6 +287,10 @@ SKIP: {
cmp_ok($drh->{Kids}, '==', 0, '... our Driver should have 0 Kid(s) after
calling take_imp_data');
+ is ref $sth3, 'DBI::zombie', 'sth should be reblessed';
+ eval { $sth3->finish };
+ like $@, qr/Can't locate object method/;
+
{
my $warn;
local $SIG{__WARN__} = sub { ++$warn if $_[0] =~ /after take_imp_data/
};
Modified: dbi/trunk/t/40profile.t
==============================================================================
--- dbi/trunk/t/40profile.t (original)
+++ dbi/trunk/t/40profile.t Sun Nov 27 16:32:13 2005
@@ -100,7 +100,7 @@ if ($shortest < 0) {
warn "Perhaps you have time sync software (like NTP) that adjusted the
clock\n";
warn "backwards by more than $shortest seconds during the test. PLEASE
RETRY.\n";
# Don't treat very small negative amounts as a failure - it's always been
due
- # due to NTP of buggy multiprocessor systems.
+ # due to NTP or buggy multiprocessor systems.
$shortest = 0 if $shortest > -0.008;
}
ok($count > 3);
