Author: timbo
Date: Mon Jul 26 03:22:45 2010
New Revision: 14285
Modified:
dbi/trunk/DBI.xs
dbi/trunk/DBIXS.h
dbi/trunk/Driver.xst
dbi/trunk/dbixs_rev.h
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/16destroy.t
Log:
Added pid to handle structure. Reuses an existing spare U32 slot to avoid the
pain of
resizing the struct (forcing drivers to be recompiled) or other gymnastics.
Pid field not made public via a macro and not referenced in Driver.xst
so it'll be easier to move later without binary compat issues.
If AutoInactiveDestroy set when DESTROY is dispatched, and the pid has changed,
then set InactiveDestroy.
Added InactiveDestroy and AutoInactiveDestroy support to DBI::PurePerl.
TODO: t/16destroy.t fails. Needs a rewrite as approach isn't workable.
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Mon Jul 26 03:22:45 2010
@@ -1247,6 +1247,7 @@
DBIc_MY_H(imp) = (HV*)SvRV(orv); /* take _copy_ of pointer, not new ref
*/
DBIc_IMP_DATA(imp) = (imp_datasv) ? newSVsv(imp_datasv) : &PL_sv_undef;
+ _imp2com(imp, std.pid) = (U32)PerlProc_getpid();
if (DBIc_TYPE(imp) <= DBIt_ST) {
SV **tmp_svp;
@@ -3200,8 +3201,9 @@
}
}
- if (DBIc_AIADESTROY(imp_xxh)) { /* wants ineffective after fork */
- /* Compare $$ to its value set in constructor ans set IADESTROY if
different. */
+ if (DBIc_AIADESTROY(imp_xxh)) { /* wants ineffective destroy after
fork */
+ if ((U32)PerlProc_getpid() != _imp2com(imp_xxh, std.pid))
+ DBIc_set(imp_xxh, DBIcf_IADESTROY, 1);
}
if (DBIc_IADESTROY(imp_xxh)) { /* wants ineffective destroy */
DBIc_ACTIVE_off(imp_xxh);
@@ -5036,9 +5038,6 @@
D_imp_sth(sth);
ST(0) = &PL_sv_yes;
/* we don't test IMPSET here because this code applies to pure-perl
drivers */
- if (DBIc_AIADESTROY(imp_sth)) { /* wants ineffective after fork */
- /* Compare $$ to its value set in constructor ans set IADESTROY if
different. */
- }
if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
DBIc_ACTIVE_off(imp_sth);
if (DBIc_DBISTATE(imp_sth)->debug)
Modified: dbi/trunk/DBIXS.h
==============================================================================
--- dbi/trunk/DBIXS.h (original)
+++ dbi/trunk/DBIXS.h Mon Jul 26 03:22:45 2010
@@ -97,7 +97,7 @@
I32 kids; /* count of db's for dr's, st's for db's etc */
I32 active_kids; /* kids which are currently DBIc_ACTIVE */
- U32 pad; /* keep binary compat */
+ U32 pid; /* pid of process that created handle */
dbistate_t *dbistate;
} dbih_com_std_t;
@@ -176,7 +176,7 @@
} dbih_fdc_t;
-#define _imp2com(p,f) ((p)->com.f)
+#define _imp2com(p,f) ((p)->com.f) /* private */
#define DBIc_FLAGS(imp) _imp2com(imp, std.flags)
#define DBIc_TYPE(imp) _imp2com(imp, std.type)
Modified: dbi/trunk/Driver.xst
==============================================================================
--- dbi/trunk/Driver.xst (original)
+++ dbi/trunk/Driver.xst Mon Jul 26 03:22:45 2010
@@ -350,9 +350,6 @@
SvPV(dbh,lna));
}
else {
- if (DBIc_AIADESTROY(imp_dbh)) { /* wants ineffective after
fork */
- /* Compare $$ to its value set in constructor ans set IADESTROY if
different. */
- }
if (DBIc_IADESTROY(imp_dbh)) { /* wants ineffective destroy
*/
DBIc_ACTIVE_off(imp_dbh);
if (DBIc_DBISTATE(imp_dbh)->debug)
@@ -754,9 +751,6 @@
SvPV(sth,lna));
}
else {
- if (DBIc_AIADESTROY(imp_sth)) { /* wants ineffective after fork */
- /* Compare $$ to its value set in constructor ans set IADESTROY if
different. */
- }
if (DBIc_IADESTROY(imp_sth)) { /* wants ineffective destroy */
DBIc_ACTIVE_off(imp_sth);
if (DBIc_DBISTATE(imp_sth)->debug)
Modified: dbi/trunk/dbixs_rev.h
==============================================================================
--- dbi/trunk/dbixs_rev.h (original)
+++ dbi/trunk/dbixs_rev.h Mon Jul 26 03:22:45 2010
@@ -1,3 +1,4 @@
-/* Mon Jul 26 09:35:19 2010 */
+/* Mon Jul 26 09:56:55 2010 */
+/* Mixed revision working copy (14282M:14283) */
/* Code modified since last checkin */
#define DBIXS_REVISION 14282
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Mon Jul 26 03:22:45 2010
@@ -225,7 +225,13 @@
return if $method_name eq 'can';
push @pre_call_frag, q{
- return if $h_inner; # ignore DESTROY for outer handle
+ # ignore DESTROY for outer handle (DESTROY for inner likely to follow
soon)
+ return if $h_inner;
+ # handle AutoInactiveDestroy and InactiveDestroy
+ $h->{InactiveDestroy} = 1
+ if $h->{AutoInactiveDestroy} and $$ != $h->{dbi_pp_pid};
+ $h->{Active} = 0
+ if $h->{InactiveDestroy};
# copy err/errstr/state up to driver so $DBI::err etc still work
if ($h->{err} and my $drh = $h->{Driver}) {
$drh->{$_} = $h->{$_} for ('err','errstr','state');
@@ -528,6 +534,7 @@
$h_inner->{Type} ||= 'dr';
}
$h_inner->{"dbi_pp_call_depth"} = 0;
+ $h_inner->{"dbi_pp_pid"} = $$;
$h_inner->{ErrCount} = 0;
$h_inner->{Active} = 1;
}
Modified: dbi/trunk/t/16destroy.t
==============================================================================
--- dbi/trunk/t/16destroy.t (original)
+++ dbi/trunk/t/16destroy.t Mon Jul 26 03:22:45 2010
@@ -25,8 +25,10 @@
ok $dbh = DBI->connect($dsn, '', '', { InactiveDestroy => 1 }),
'Create with ActiveDestroy';
ok $dbh->{Active}, 'Should start active';
+#DBI->trace(9);
$dbh->DESTROY;
ok !$dbh->{Active}, 'Should no longer be active';
+#DBI->trace(0);
# Try AutoInactiveDestroy.
ok $dbh = DBI->connect($dsn, '', '', { AutoInactiveDestroy => 1 }),
