DBD::SQLite: fixed #52573 manual transaction issue; please ship this as a dev release (or a prod one if you prefer) to see if this would also fix other major tools like CPANPLUS etc, which 1.27 reportedly broke

Changes

@@ -3,6 +3,8 @@ Changes for Perl extension DBD-SQLite
 1.28_01 to be released
     - Updated to SQLite 3.6.21 (ISHIGAKI)
     - silence warnings on HP-UX (HMBRAND)
+    - Resolved #52573: Manual Transaction handling seems to be
+      broken (hopefully) (ISHIGAKI)
 
 1.27 Mon 23 Nov 2009
     - Switching to a production version

MANIFEST.SKIP

@@ -6,6 +6,9 @@ CVS/.*
 \.tgz$
 \.tar\.gz$
 \.o$
+\.obj$
+\.def$
+\.pdb$
 \.xsi$
 \.bs$
 ^.#

dbdimp.c

@@ -546,11 +546,22 @@ sqlite_st_execute(SV *sth, imp_sth_t *imp_sth)
         }
     }
 
-    if ( (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) && (sqlite3_get_autocommit(imp_dbh->db)) ) {
+    if (sqlite3_get_autocommit(imp_dbh->db)) {
-        sqlite_trace(sth, imp_sth, 3, "BEGIN TRAN");
+        char *sql = sqlite3_sql(imp_sth->stmt);
-        rc = sqlite_exec(sth, "BEGIN TRANSACTION");
+        if ((sql[0] == 'B' || sql[0] == 'b') &&
-        if (rc != SQLITE_OK) {
+            (sql[1] == 'E' || sql[1] == 'e') &&
-            return -2; /* -> undef in SQLite.xsi */
+            (sql[2] == 'G' || sql[2] == 'g') &&
+            (sql[3] == 'I' || sql[3] == 'i') &&
+            (sql[4] == 'N' || sql[4] == 'n')) {
+            DBIc_on(imp_dbh,  DBIcf_BegunWork);
+            DBIc_off(imp_dbh, DBIcf_AutoCommit);
+        }
+        else if (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) {
+            sqlite_trace(sth, imp_sth, 3, "BEGIN TRAN");
+            rc = sqlite_exec(sth, "BEGIN TRANSACTION");
+            if (rc != SQLITE_OK) {
+                return -2; /* -> undef in SQLite.xsi */
+            }
         }
     }
 
@@ -582,6 +593,10 @@ sqlite_st_execute(SV *sth, imp_sth_t *imp_sth)
         case SQLITE_DONE:
             DBIc_ACTIVE_on(imp_sth);
             sqlite_trace(sth, imp_sth, 5, form("exec ok - %d rows, %d cols", imp_sth->nrow, DBIc_NUM_FIELDS(imp_sth)));
+            if (DBIc_is(imp_dbh, DBIcf_AutoCommit) && !sqlite3_get_autocommit(imp_dbh->db)) {
+                DBIc_on(imp_dbh,  DBIcf_BegunWork);
+                DBIc_off(imp_dbh, DBIcf_AutoCommit);
+            }
             return 0; /* -> '0E0' in SQLite.xsi */
         default:
             sqlite_error(sth, imp_sth->retval, sqlite3_errmsg(imp_dbh->db));

lib/DBD/SQLite.pm

@@ -10,7 +10,7 @@ use vars qw{$err $errstr $drh $sqlite_version};
 use vars qw{%COLLATION};
 
 BEGIN {
-    $VERSION = '1.27';
+    $VERSION = '1.28_01';
     @ISA     = 'DynaLoader';
 
     # Initialize errors

t/lib/Test.pm

@@ -9,7 +9,7 @@ use Test::More ();
 
 use vars qw{$VERSION @ISA @EXPORT @CALL_FUNCS};
 BEGIN {
-	$VERSION = '1.27';
+	$VERSION = '1.28_01';
 	@ISA     = 'Exporter';
 	@EXPORT  = qw/connect_ok dies @CALL_FUNCS/;
 

t/rt_52573_manual_exclusive_lock.t

@@ -0,0 +1,199 @@
+#!/usr/bin/perl -w
+
+use strict;
+BEGIN {
+	$|  = 1;
+	$^W = 1;
+}
+
+use t::lib::Test;
+use Test::More tests => 94;
+use Test::NoWarnings;
+
+my $dbh = connect_ok(
+	AutoCommit => 1,
+	RaiseError => 1,
+	PrintError => 0,
+);
+
+$dbh->do('create table foo (id)');
+
+# scenario 1: AutoCommit => 1 and no begin_work
+
+ok $dbh->{AutoCommit}, "AutoCommit is on";
+ok !$dbh->{BegunWork},  "BegunWork is off";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'a statement works';
+diag $@ if $@;
+# eval { $dbh->rollback };
+# ok !$@, "rollback ignored: nothing to be rolled back";
+# diag $@ if $@;
+ok $dbh->{AutoCommit}, "AutoCommit is still on";
+ok !$dbh->{BegunWork},  "BegunWork is still off";
+
+# scenario 2: AutoCommit => 1 and begin_work and implicit BEGIN
+
+eval { $dbh->begin_work };
+ok !$@, "begin_work works";
+ok !$dbh->{AutoCommit}, "AutoCommit is turned off";
+ok $dbh->{BegunWork},    "BegunWork is turned on";
+eval { $dbh->begin_work };
+like $@ => qr/Already in a transaction/, "but second begin_work should fail";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, "other statement should work";
+diag $@ if $@;
+eval { $dbh->rollback };
+ok !$@, 'rolled back';
+diag $@ if $@;
+ok $dbh->{AutoCommit}, "AutoCommit is turned on";
+ok !$dbh->{BegunWork},  "BegunWork is turned off";
+
+# scenario 3: AutoCommit => 1 and begin_work and explicit and immediate BEGIN
+
+eval { $dbh->begin_work };
+ok !$@, "begin_work works";
+ok !$dbh->{AutoCommit}, "AutoCommit is turned off";
+ok $dbh->{BegunWork},    "BegunWork is turned on";
+eval { $dbh->do('BEGIN EXCLUSIVE TRANSACTION') };
+ok !$@, "first BEGIN should be passed through";
+diag $@ if $@;
+eval { $dbh->do('BEGIN TRANSACTION') };
+like $@ => qr/cannot start a transaction/, "second BEGIN should fail";
+eval { $dbh->begin_work };
+like $@ => qr/Already in a transaction/, "and second begin_work also should fail";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'other statement should work';
+diag $@ if $@;
+eval { $dbh->rollback };
+ok !$@, 'rolled back';
+diag $@ if $@;
+ok $dbh->{AutoCommit}, "AutoCommit is turned on now";
+ok !$dbh->{BegunWork},  "BegunWork is turned off";
+
+# scenario 4: AutoCommit => 1 and begin_work and explicit but not immediate BEGIN
+eval { $dbh->begin_work };
+ok !$@, "begin_work works";
+ok !$dbh->{AutoCommit}, "AutoCommit is turned off";
+ok $dbh->{BegunWork},    "BegunWork is turned on";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'statement should work';
+diag $@ if $@;
+eval { $dbh->do('BEGIN TRANSACTION') };
+like $@ => qr/cannot start a transaction/, "BEGIN after other statements should fail";
+eval { $dbh->begin_work };
+like $@ => qr/Already in a transaction/, "and second begin_work also should fail";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'other statement should work';
+diag $@ if $@;
+eval { $dbh->rollback };
+ok !$@, 'rolled back';
+diag $@ if $@;
+ok $dbh->{AutoCommit}, "AutoCommit is turned on now";
+ok !$dbh->{BegunWork},  "BegunWork is turned off";
+
+# scenario 5: AutoCommit => 1 and explicit BEGIN and no begin_work
+ok $dbh->{AutoCommit}, "AutoCommit is on";
+ok !$dbh->{BegunWork},    "BegunWork is off";
+eval { $dbh->do('BEGIN TRANSACTION'); };
+ok !$@, 'BEGIN should work';
+diag $@ if $@;
+ok !$dbh->{AutoCommit}, "AutoCommit is turned off";
+ok $dbh->{BegunWork},    "BegunWork is turned on";
+eval { $dbh->do('BEGIN TRANSACTION') };
+like $@ => qr/cannot start a transaction/, "second BEGIN should fail";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'other statement should work';
+diag $@ if $@;
+eval { $dbh->rollback };
+ok !$@, 'rolled back';
+diag $@ if $@;
+ok $dbh->{AutoCommit}, "AutoCommit is turned on now";
+ok !$dbh->{BegunWork},  "BegunWork is turned off";
+
+# scenario 6: AutoCommit => 1 and explicit BEGIN and begin_work
+ok $dbh->{AutoCommit}, "AutoCommit is on";
+ok !$dbh->{BegunWork},    "BegunWork is off";
+eval { $dbh->do('BEGIN TRANSACTION'); };
+ok !$@, 'BEGIN should work';
+diag $@ if $@;
+ok !$dbh->{AutoCommit}, "AutoCommit is turned off";
+ok $dbh->{BegunWork},    "BegunWork is turned on";
+eval { $dbh->do('BEGIN TRANSACTION') };
+like $@ => qr/cannot start a transaction/, "second BEGIN should fail";
+eval { $dbh->begin_work };
+like $@ => qr/Already in a transaction/, "and second begin_work also should fail";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'other statement should work';
+diag $@ if $@;
+eval { $dbh->rollback };
+ok !$@, 'rolled back';
+diag $@ if $@;
+ok $dbh->{AutoCommit}, "AutoCommit is turned on now";
+ok !$dbh->{BegunWork},  "BegunWork is turned off";
+
+# scenario 7: AutoCommit => 0 and explicit BEGIN
+ok $dbh->{AutoCommit}, "AutoCommit is on";
+ok !$dbh->{BegunWork},    "BegunWork is off";
+eval { $dbh->{AutoCommit} = 0 };
+ok !$@, "AutoCommit is turned off";
+ok !$dbh->{BegunWork},    "BegunWork is still off";
+eval { $dbh->do('BEGIN TRANSACTION'); };
+ok !$@, 'BEGIN should work';
+diag $@ if $@;
+ok !$dbh->{AutoCommit}, "AutoCommit is turned off";
+ok $dbh->{BegunWork},    "BegunWork is turned on";
+eval { $dbh->do('BEGIN TRANSACTION') };
+like $@ => qr/cannot start a transaction/, "second BEGIN should fail";
+eval { $dbh->begin_work };
+like $@ => qr/Already in a transaction/, "and begin_work also should fail";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'other statement should work';
+diag $@ if $@;
+eval { $dbh->rollback };
+ok !$@, 'rolled back';
+diag $@ if $@;
+ok $dbh->{AutoCommit}, "AutoCommit is turned on now";
+ok !$dbh->{BegunWork},  "BegunWork is turned off";
+
+# scenario 8: AutoCommit => 0 and begin_work
+ok $dbh->{AutoCommit}, "AutoCommit is on";
+ok !$dbh->{BegunWork},    "BegunWork is off";
+eval { $dbh->{AutoCommit} = 0 };
+ok !$@, "AutoCommit is turned off";
+ok !$dbh->{BegunWork},    "BegunWork is still off";
+eval { $dbh->begin_work; };
+like $@ => qr/Already in a transaction/, "begin_work should fail";
+ok !$dbh->{AutoCommit}, "AutoCommit is still off";
+ok !$dbh->{BegunWork},    "BegunWork is still off";
+eval { $dbh->do('BEGIN TRANSACTION') };
+ok !$@, "BEGIN should work";
+diag $@ if $@;
+ok !$dbh->{AutoCommit}, "AutoCommit is still off";
+ok $dbh->{BegunWork},    "BegunWork is turned on";
+eval { $dbh->begin_work };
+like $@ => qr/Already in a transaction/, "and second begin_work also should fail";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'other statement should work';
+diag $@ if $@;
+eval { $dbh->rollback };
+ok !$@, 'rolled back';
+diag $@ if $@;
+ok $dbh->{AutoCommit}, "AutoCommit is turned on now";
+ok !$dbh->{BegunWork},  "BegunWork is turned off";
+
+# scenario 9: AutoCommit => 0 and implicit BEGIN
+ok $dbh->{AutoCommit}, "AutoCommit is on";
+ok !$dbh->{BegunWork},    "BegunWork is off";
+eval { $dbh->{AutoCommit} = 0 };
+ok !$@, "AutoCommit is turned off";
+ok !$dbh->{BegunWork},    "BegunWork is still off";
+eval { $dbh->do('insert into foo (id) values (1)'); };
+ok !$@, 'other statement should work';
+diag $@ if $@;
+ok !$dbh->{AutoCommit}, "AutoCommit is still off";
+ok !$dbh->{BegunWork},    "BegunWork is still off";
+eval { $dbh->rollback };
+ok !$@, 'rolled back';
+diag $@ if $@;
+ok !$dbh->{AutoCommit}, "AutoCommit is still off";
+ok !$dbh->{BegunWork},  "BegunWork is still off";