Author: theory
Date: Sun Jul 25 17:12:54 2010
New Revision: 14282
Added:
dbi/trunk/t/16destroy.t
Modified:
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/DBIXS.h
dbi/trunk/Driver.xst
dbi/trunk/dbixs_rev.h
dbi/trunk/lib/DBD/File.pm
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBI/Gofer/Execute.pm
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/06attrs.t
Log:
Add AutoInactiveDestroy.
It doesn't actually work yet, but there is documentation and a failing test.
What it needs is:
* The ability to properly set the attribute
* Caching of $$ on connect (not sure about connect_cached)
* Checking of that cached value to $$ in DESTROY.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Sun Jul 25 17:12:54 2010
@@ -1520,7 +1520,7 @@
# explicitly set attributes which are unlikely to be in the
# attribute cache, i.e., boolean's and some others
$attr->{$_} = $old_dbh->FETCH($_) for (qw(
- AutoCommit ChopBlanks InactiveDestroy
+ AutoCommit ChopBlanks InactiveDestroy AutoInactiveDestroy
LongTruncOk PrintError PrintWarn Profile RaiseError
ShowErrorStatement TaintIn TaintOut
));
@@ -3636,6 +3636,34 @@
level (not handle trace level) is set high enough to show the trace
from the DBI's method dispatcher, e.g. >= 9.
+=head3 C<AutoInactiveDestroy>
+
+Type: boolean
+
+While its best to set C<InactiveDestroy> on a handle when you've C<fork>ed off
+a child process, sometimes you might call code that C<fork>s without your
+knowledge. In such a case, if a the child exits and then the parent tries to
+use the original handle, it might fail, as the child might have closed the
+socket the parent was using.
+
+Use C<AutoInactiveDestroy> to get around this situation. Like
+C<InactiveDestroy>, when set to a true value the handle will be treated by the
+DESTROY as if it was no longer Active, and so the I<database engine> related
+effects of DESTROYing a handle will be skipped. This only happens, however, if
+the DBI detects that the process ID in which the handle is being DESTROYed is
+different than the process ID in which it was created.
+
+This is the example it's designed to deal with:
+
+ my $dbh = DBI->connect(...);
+ some_code_that_forks(); # Perhaps without your knowlege.
+ $dbh->do(...); # dies.
+
+The issue is that C<$dbh> is DESTROYed in the fork and closes the socket from
+the parent, too. Pass a true value for C<AutoInactiveDestroy> and the DBI will
+automatically detect when a forked database handle is being DESTROYed and
+treat the handle as non-active.
+
=head3 C<PrintWarn>
Type: boolean, inherited
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Sun Jul 25 17:12:54 2010
@@ -1866,6 +1866,9 @@
else if (strEQ(key, "Warn")) {
(on) ? DBIc_WARN_on(imp_xxh) : DBIc_WARN_off(imp_xxh);
}
+ else if (strEQ(key, "AutoInactiveDestroy")) {
+ (on) ? DBIc_AIADESTROY_on(imp_xxh) : DBIc_AIADESTROY_off(imp_xxh);
+ }
else if (strEQ(key, "InactiveDestroy")) {
(on) ? DBIc_IADESTROY_on(imp_xxh) : DBIc_IADESTROY_off(imp_xxh);
}
@@ -2226,6 +2229,9 @@
else if (keylen==10 && strEQ(key, "ActiveKids")) {
valuesv = newSViv(DBIc_ACTIVE_KIDS(imp_xxh));
}
+ else if (strEQ(key, "AutoInactiveDestroy")) {
+ valuesv = boolSV(DBIc_AIADESTROY(imp_xxh));
+ }
break;
case 'B':
@@ -3194,7 +3200,10 @@
}
}
- if (DBIc_IADESTROY(imp_xxh)) { /* want's ineffective destroy */
+ if (DBIc_AIADESTROY(imp_xxh)) { /* wants ineffective after fork */
+ /* Compare $$ to its value set in constructor ans set IADESTROY if
different. */
+ }
+ if (DBIc_IADESTROY(imp_xxh)) { /* wants ineffective destroy */
DBIc_ACTIVE_off(imp_xxh);
}
call_depth = 0;
@@ -5027,6 +5036,9 @@
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 Sun Jul 25 17:12:54 2010
@@ -244,6 +244,7 @@
#define DBIcf_IMPSET 0x000002 /* has implementor data to be clear'd
*/
#define DBIcf_ACTIVE 0x000004 /* needs finish/disconnect before
clear */
#define DBIcf_IADESTROY 0x000008 /* do DBIc_ACTIVE_off before DESTROY
*/
+#define DBIcf_AIADESTROY 0x000009 /* autod DBIc_ACTIVE_off before
DESTROY */
#define DBIcf_WARN 0x000010 /* warn about poor practice etc
*/
#define DBIcf_COMPAT 0x000020 /* compat/emulation mode (eg oraperl)
*/
#define DBIcf_ChopBlanks 0x000040 /* rtrim spaces from fetch char
columns */
@@ -265,7 +266,7 @@
/* NOTE: new flags may require clone() to be updated */
#define DBIcf_INHERITMASK /* what NOT to pass on to children */
\
- (U32)( DBIcf_COMSET | DBIcf_IMPSET | DBIcf_ACTIVE | DBIcf_IADESTROY
\
+ (U32)( DBIcf_COMSET | DBIcf_IMPSET | DBIcf_ACTIVE | DBIcf_IADESTROY |
DBIcf_AIADESTROY \
| DBIcf_AutoCommit | DBIcf_BegunWork | DBIcf_Executed | DBIcf_Callbacks )
/* general purpose bit setting and testing macros */
@@ -317,6 +318,10 @@
#define DBIc_IADESTROY_on(imp) (DBIc_FLAGS(imp) |= DBIcf_IADESTROY)
#define DBIc_IADESTROY_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_IADESTROY)
+#define DBIc_AIADESTROY(imp) (DBIc_FLAGS(imp) & DBIcf_AIADESTROY)
+#define DBIc_AIADESTROY_on(imp) (DBIc_FLAGS(imp) |= DBIcf_AIADESTROY)
+#define DBIc_AIADESTROY_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_AIADESTROY)
+
#define DBIc_WARN(imp) (DBIc_FLAGS(imp) & DBIcf_WARN)
#define DBIc_WARN_on(imp) (DBIc_FLAGS(imp) |= DBIcf_WARN)
#define DBIc_WARN_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_WARN)
Modified: dbi/trunk/Driver.xst
==============================================================================
--- dbi/trunk/Driver.xst (original)
+++ dbi/trunk/Driver.xst Sun Jul 25 17:12:54 2010
@@ -350,7 +350,10 @@
SvPV(dbh,lna));
}
else {
- if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective
destroy */
+ 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)
PerlIO_printf(DBIc_LOGPIO(imp_dbh), " DESTROY %s
skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
@@ -751,7 +754,10 @@
SvPV(sth,lna));
}
else {
- if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
+ 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)
PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s
skipped due to InactiveDestroy\n", SvPV_nolen(sth));
Modified: dbi/trunk/dbixs_rev.h
==============================================================================
--- dbi/trunk/dbixs_rev.h (original)
+++ dbi/trunk/dbixs_rev.h Sun Jul 25 17:12:54 2010
@@ -1,3 +1,3 @@
-/* Thu Apr 15 13:40:28 2010 */
+/* Sun Jul 25 16:30:05 2010 */
/* Code modified since last checkin */
-#define DBIXS_REVISION 13903
+#define DBIXS_REVISION 14281
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Sun Jul 25 17:12:54 2010
@@ -1085,6 +1085,7 @@
CachedKids
CompatMode (Not used)
InactiveDestroy
+ AutoInactiveDestroy
Kids
PrintError
RaiseError
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Sun Jul 25 17:12:54 2010
@@ -29,6 +29,7 @@
FetchHashKeyName
HandleError HandleSetErr
InactiveDestroy
+ AutoInactiveDestroy
PrintError PrintWarn
Profile
RaiseError
Modified: dbi/trunk/lib/DBI/Gofer/Execute.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Execute.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Execute.pm Sun Jul 25 17:12:54 2010
@@ -166,7 +166,7 @@
# delete attributes we don't want to affect the server-side
# (Could just do this on client-side and trust the client. DoS?)
- delete @{$attr}{qw(Profile InactiveDestroy HandleError HandleSetErr
TraceLevel Taint TaintIn TaintOut)};
+ delete @{$attr}{qw(Profile InactiveDestroy AutoInactiveDestroy HandleError
HandleSetErr TraceLevel Taint TaintIn TaintOut)};
$dsn = $self->forced_connect_dsn || $dsn || $self->default_connect_dsn
or die "No forced_connect_dsn, requested dsn, or default_connect_dsn
for request";
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Sun Jul 25 17:12:54 2010
@@ -143,6 +143,7 @@
TaintIn
TaintOut
InactiveDestroy
+ AutoInactiveDestroy
LongTruncOk
MultiThread
PrintError
@@ -1168,6 +1169,7 @@
ActiveKids
InactiveDestroy
+ AutoInactiveDestroy
Kids
Taint
TaintIn
Modified: dbi/trunk/t/06attrs.t
==============================================================================
--- dbi/trunk/t/06attrs.t (original)
+++ dbi/trunk/t/06attrs.t Sun Jul 25 17:12:54 2010
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 145;
+use Test::More tests => 148;
## ----------------------------------------------------------------------------
## 06attrs.t - ...
@@ -39,6 +39,7 @@
ok( $dbh->{AutoCommit}, '... checking AutoCommit attribute for dbh');
ok(!$dbh->{CompatMode}, '... checking CompatMode attribute for dbh');
ok(!$dbh->{InactiveDestroy}, '... checking InactiveDestory attribute for
dbh');
+ok(!$dbh->{AutoInactiveDestroy}, '... checking AutoInactiveDestory attribute
for dbh');
ok(!$dbh->{PrintError}, '... checking PrintError attribute for dbh');
ok( $dbh->{PrintWarn}, '... checking PrintWarn attribute for dbh');
# true because of perl -w above
ok( $dbh->{RaiseError}, '... checking RaiseError attribute for dbh');
@@ -111,6 +112,7 @@
ok( $drh->{AutoCommit}, '... checking AutoCommit attribute for drh');
ok(!$drh->{CompatMode}, '... checking CompatMode attribute for drh');
ok(!$drh->{InactiveDestroy}, '... checking InactiveDestory attribute for
drh');
+ok(!$drh->{AutoInactiveDestroy}, '... checking AutoInactiveDestory attribute
for drh');
ok(!$drh->{PrintError}, '... checking PrintError attribute for drh');
ok( $drh->{PrintWarn}, '... checking PrintWarn attribute for drh');
# true because of perl -w above
ok(!$drh->{RaiseError}, '... checking RaiseError attribute for drh');
@@ -185,6 +187,7 @@
ok(!$sth->{Active}, '... checking Active attribute for sth');
ok(!$sth->{CompatMode}, '... checking CompatMode attribute for sth');
ok(!$sth->{InactiveDestroy}, '... checking InactiveDestroy attribute for
sth');
+ok(!$sth->{AutoInactiveDestroy}, '... checking AutoInactiveDestroy attribute
for sth');
ok(!$sth->{PrintError}, '... checking PrintError attribute for sth');
ok( $sth->{PrintWarn}, '... checking PrintWarn attribute for sth');
ok( $sth->{RaiseError}, '... checking RaiseError attribute for sth');
@@ -283,7 +286,7 @@
# $h->{TraceLevel} tests are in t/09trace.t
-print "Checking inheritance\n";
+diag "Checking inheritance\n";
SKIP: {
skip "drh->dbh->sth inheritance test skipped with DBI_AUTOPROXY", 2 if
$ENV{DBI_AUTOPROXY};
Added: dbi/trunk/t/16destroy.t
==============================================================================
--- (empty file)
+++ dbi/trunk/t/16destroy.t Sun Jul 25 17:12:54 2010
@@ -0,0 +1,47 @@
+#!perl -w
+
+use strict;
+
+use Test::More tests => 14;
+
+BEGIN{ use_ok( 'DBI' ) }
+
+my $dsn = 'dbi:ExampleP:dummy';
+
+# Connect to the example driver.
+ok my $dbh = DBI->connect($dsn, '', ''),
+ 'Create plain dbh';
+
+isa_ok( $dbh, 'DBI::db' );
+
+# Clean up when we're done.
+END { $dbh->disconnect if $dbh };
+
+ok $dbh->{Active}, 'Should start active';
+$dbh->DESTROY;
+ok $dbh->{Active}, 'Should still be active';
+
+# Try InactiveDestroy.
+ok $dbh = DBI->connect($dsn, '', '', { InactiveDestroy => 1 }),
+ 'Create with ActiveDestroy';
+ok $dbh->{Active}, 'Should start active';
+$dbh->DESTROY;
+ok !$dbh->{Active}, 'Should no longer be active';
+
+# Try AutoInactiveDestroy.
+ok $dbh = DBI->connect($dsn, '', '', { AutoInactiveDestroy => 1 }),
+ 'Create with AutoInactiveDestroy';
+ok $dbh->{Active}, 'Should start active';
+$dbh->DESTROY;
+ok $dbh->{Active}, 'Should still be active';
+
+# Try AutoInactiveDestroy and "fork".
+ok $dbh = DBI->connect($dsn, '', '', { AutoInactiveDestroy => 1 }),
+ 'Create with AutoInactiveDestroy again';
+ok $dbh->{Active}, 'Should start active';
+do {
+ # Fake fork.
+ local $$ = 0;
+ $dbh->DESTROY;
+};
+ok !$dbh->{Active}, 'Should not still be active';
