Author: timbo
Date: Fri Feb 13 16:30:25 2004
New Revision: 58
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/DBIXS.h
dbi/trunk/Driver.xst
Log:
Add new $h->{Executed} attribute and use it to control the
rollback warning issued when an active non-autocommit dbh is destroyed.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Fri Feb 13 16:30:25 2004
@@ -6,9 +6,9 @@
=head1 CHANGES
-Change to let drivers use set_err to record errors
Drivers to change how they get debug level (with masked bits).
Extra hooks in Driver.xst for bind_col etc
+Add tests for $h->{Executed}
Fixed execute_for_array() so tuple_status parameter is optional
as per docs, thanks to Ed Avis.
@@ -33,6 +33,7 @@
point that an error, warn, or info state is recorded.
The code can alter the err, errstr, and state values
(e.g., to promote an error to a warning, or the reverse).
+ Added $h->{Executed} attribute set if do()/execute() called.
Added details of DBI::Const::GetInfoType module to get_info() docs.
Added ref count of inner handle to "DESTROY ignored for outer" msg.
Added Win32 build config checks to DBI::DBD thanks to Andy Hassall.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Fri Feb 13 16:30:25 2004
@@ -389,7 +389,7 @@
begin_work => { U =>[1,2,'[ \%attr ]'], O=>0x0400 },
commit => { U =>[1,1], O=>0x0480|0x0800 },
rollback => { U =>[1,1], O=>0x0480|0x0800 },
- 'do' => { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'],
O=>0x0200 },
+ 'do' => { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'],
O=>0x1200 },
last_insert_id => { U =>[3,4,'$table_name, $field_name [, \%attr ]'],
O=>0x0100 },
preparse => { }, # XXX
prepare => { U =>[2,3,'$statement [, \%attr]'], O=>0x0200 },
@@ -423,12 +423,12 @@
bind_columns => { U =>[2,0,'\\$var1 [, \\$var2, ...]'] },
bind_param => { U =>[3,4,'$parameter, $var [, \%attr]'] },
bind_param_inout=> { U =>[4,5,'$parameter, \\$var, $maxlen, [, \%attr]'] },
- execute => { U =>[1,0,'[EMAIL PROTECTED]'], O=>0x40 },
+ execute => { U =>[1,0,'[EMAIL PROTECTED]'], O=>0x1040 },
bind_param_array => { U =>[3,4,'$parameter, $var [, \%attr]'] },
bind_param_inout_array => { U =>[4,5,'$parameter, [EMAIL PROTECTED], $maxlen,
[, \%attr]'] },
- execute_array => { U =>[2,0,'\\%attribs [, @args]'] },
- execute_for_fetch => { U =>[2,3,'$fetch_sub [, $tuple_status]'] },
+ execute_array => { U =>[2,0,'\\%attribs [, @args]'], O=>0x1040 },
+ execute_for_fetch => { U =>[2,3,'$fetch_sub [, $tuple_status]'], O=>0x1040 },
fetch => undef, # alias for fetchrow_arrayref
fetchrow_arrayref => undef,
@@ -2815,6 +2815,20 @@
that may have more data to fetch. (Fetching all the data or calling
C<$sth-E<gt>finish>
sets C<Active> off.)
+=item C<Executed> (boolean)
+
+The C<Executed> attribute is true if the handle object has been "executed".
+Currently only the $dbh do() method and the $sth execute(), execute_array(),
+and execute_for_fetch() methods set the C<Executed> attribute.
+
+When it's on a handle it is also set on the parent handle at the
+same time. So calling execute() on a $sth also sets the C<Executed>
+attribute on the parent $dbh.
+
+The C<Executed> attribute for a $dbh is cleared by the commit() and
+rollback() methods. (The C<Executed> attribute of any child statement
+handles are not cleared.)
+
=item C<Kids> (integer, read-only)
For a driver handle, C<Kids> is the number of currently existing database
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Fri Feb 13 16:30:25 2004
@@ -110,6 +110,7 @@
#define IMA_CLEAR_STMT 0x0200 /* clear Statement before call */
#define IMA_PROF_EMPTY_STMT 0x0400 /* profile as empty Statement */
#define IMA_NOT_FOUND_OKAY 0x0800 /* no error if not found */
+#define IMA_EXECUTE 0x1000 /* do/execute: DBIcf_Executed */
#define DBIc_STATE_adjust(imp_xxh, state) \
(SvOK(state) /* SQLSTATE is implemented by driver */ \
@@ -1298,13 +1299,7 @@
PerlIO_printf(DBILOGFP," STORE %s %s => %s\n",
neatsvpv(h,0), neatsvpv(keysv,0), neatsvpv(valuesv,0));
- if (strEQ(key, "CompatMode")) {
- (on) ? DBIc_COMPAT_on(imp_xxh) : DBIc_COMPAT_off(imp_xxh);
- }
- else if (strEQ(key, "Warn")) {
- (on) ? DBIc_WARN_on(imp_xxh) : DBIc_WARN_off(imp_xxh);
- }
- else if (internal && strEQ(key, "Active")) {
+ if (internal && strEQ(key, "Active")) {
if (on) {
D_imp_sth(h);
DBIc_ACTIVE_on(imp_xxh);
@@ -1317,22 +1312,31 @@
DBIc_ACTIVE_off(imp_xxh);
}
}
- else if (strEQ(key, "InactiveDestroy")) {
- (on) ? DBIc_IADESTROY_on(imp_xxh) : DBIc_IADESTROY_off(imp_xxh);
- }
else if (strEQ(key, "FetchHashKeyName")) {
if (htype >= DBIt_ST)
croak("Can't set FetchHashKeyName for a statement handle, set in parent
before prepare()");
cacheit = 1; /* just save it */
}
+ else if (strEQ(key, "CompatMode")) {
+ (on) ? DBIc_COMPAT_on(imp_xxh) : DBIc_COMPAT_off(imp_xxh);
+ }
+ else if (strEQ(key, "Warn")) {
+ (on) ? DBIc_WARN_on(imp_xxh) : DBIc_WARN_off(imp_xxh);
+ }
+ else if (strEQ(key, "InactiveDestroy")) {
+ (on) ? DBIc_IADESTROY_on(imp_xxh) : DBIc_IADESTROY_off(imp_xxh);
+ }
else if (strEQ(key, "RootClass")) {
cacheit = 1; /* just save it */
}
else if (strEQ(key, "RowCacheSize")) {
cacheit = 0; /* ignore it */
}
+ else if (strEQ(key, "Executed")) {
+ DBIc_set(imp_xxh, DBIcf_Executed, on);
+ }
else if (strEQ(key, "ChopBlanks")) {
- DBIc_set(imp_xxh,DBIcf_ChopBlanks, on);
+ DBIc_set(imp_xxh, DBIcf_ChopBlanks, on);
}
else if (strEQ(key, "LongReadLen")) {
if (SvNV(valuesv) < 0 || SvNV(valuesv) > MAX_LongReadLen)
@@ -1661,6 +1665,12 @@
}
break;
+ case 'E':
+ if (strEQ(key, "Executed")) {
+ valuesv = boolSV(DBIc_is(imp_xxh, DBIcf_Executed));
+ }
+ break;
+
case 'I':
if (strEQ(key, "InactiveDestroy")) {
valuesv = boolSV(DBIc_IADESTROY(imp_xxh));
@@ -2295,7 +2305,7 @@
/* Check method call against Internal Method Attributes */
if (ima) {
- if (ima->flags &
(IMA_STUB|IMA_FUNC_REDIRECT|IMA_KEEP_ERR|IMA_KEEP_ERR_SUB|IMA_CLEAR_STMT)) {
+ if (ima->flags &
(IMA_STUB|IMA_FUNC_REDIRECT|IMA_KEEP_ERR|IMA_KEEP_ERR_SUB|IMA_CLEAR_STMT|IMA_EXECUTE))
{
if (ima->flags & IMA_STUB) {
if (*meth_name == 'c' && strEQ(meth_name,"can")) {
@@ -2328,6 +2338,12 @@
neatsvpv(h,0), meth_name, neatsvpv(meth_name_sv,0));
meth_name = SvPV(meth_name_sv, lna);
}
+ if (ima->flags & IMA_EXECUTE) {
+ imp_xxh_t *parent = DBIc_PARENT_COM(imp_xxh);
+ DBIc_on(imp_xxh, DBIcf_Executed);
+ if (parent)
+ DBIc_on(parent, DBIcf_Executed);
+ }
if (ima->flags & IMA_KEEP_ERR)
keep_error = TRUE;
if (ima->flags & IMA_KEEP_ERR_SUB
@@ -2648,6 +2664,8 @@
}
if (ima && ima->flags & IMA_END_WORK) { /* commit() or rollback() */
+ DBIc_off(imp_xxh, DBIcf_Executed);
+
if (DBIc_has(imp_xxh, DBIcf_BegunWork)) {
DBIc_off(imp_xxh, DBIcf_BegunWork);
if (!DBIc_has(imp_xxh, DBIcf_AutoCommit)) {
Modified: dbi/trunk/DBIXS.h
==============================================================================
--- dbi/trunk/DBIXS.h (original)
+++ dbi/trunk/DBIXS.h Fri Feb 13 16:30:25 2004
@@ -239,12 +239,13 @@
#define DBIcf_Profile 0x010000 /* profile activity on this handle */
#define DBIcf_TaintIn 0x020000 /* check inputs for taintedness */
#define DBIcf_TaintOut 0x040000 /* taint outgoing data */
+#define DBIcf_Executed 0x080000 /* do/execute called since commit/rollb */
/* 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 \
/* These are for dbh only: */ \
- | DBIcf_AutoCommit | DBIcf_BegunWork )
+ | DBIcf_AutoCommit | DBIcf_BegunWork | DBIcf_Executed )
/* general purpose bit setting and testing macros */
#define DBIbf_is( bitset,flag) ((bitset) & (flag))
Modified: dbi/trunk/Driver.xst
==============================================================================
--- dbi/trunk/Driver.xst (original)
+++ dbi/trunk/Driver.xst Fri Feb 13 16:30:25 2004
@@ -345,7 +345,10 @@
/* Perl will call DESTROY on the dbh and, if we don't rollback, */
/* the server may automatically commit! Bham! Corrupt database! */
if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
- if (DBIc_WARN(imp_dbh) && (!dirty || DBIc_DBISTATE(imp_dbh)->debug >=
3))
+ if (DBIc_WARN(imp_dbh)
+ && DBIc_is(imp_dbh, DBIcf_Executed)
+ && (!dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
+ )
warn("Issuing rollback() for database handle being DESTROY'd
without explicit disconnect()");
dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
}
