wip, transaction fixup

diff --git a/cgi-auth-hybrid.pm b/cgi-auth-hybrid.pm
index f22083a94b3714fa3b0d16baac0278eb13075144..0617881eb1b81224a29301660c5ed3ba1fd24f46 100644 (file)
--- a/cgi-auth-hybrid.pm
+++ b/cgi-auth-hybrid.pm
@@ -209,14 +209,14 @@ sub _dbopen ($) {
     die "$dsn $! ?" unless $dbh;
     $v->{Dbh} = $dbh;
 
     die "$dsn $! ?" unless $dbh;
     $v->{Dbh} = $dbh;
 

-    $dbh->do("BEGIN");
-

     eval {
     eval {

-       $dbh->do("CREATE TABLE $v->{S}{assocdb_table} (".
-                " associdh VARCHAR PRIMARY KEY,".
-                 " username VARCHAR,".
-                " last INTEGER NOT NULL".
-                ")");
+       $r->_db_transaction(sub {
+           $dbh->do("CREATE TABLE $v->{S}{assocdb_table} (".
+                    " associdh VARCHAR PRIMARY KEY,".
+                    " username VARCHAR,".
+                    " last INTEGER NOT NULL".
+                    ")");
+        });

     };
     return $dbh;
 }
     };
     return $dbh;
 }


@@ -228,6 +228,29 @@ sub disconnect ($) {
     $dbh->disconnect();
 }
 
     $dbh->disconnect();
 }
 

+sub _db_transaction ($$) {
+    my ($r, $fn) = @_;
+    my $retries = 10;
+    my $rv;
+    my $dbh = $v->{Dbh};
+    for (;;) {
+       if (!eval {
+           $rv = $fn->();
+           1;
+       }) {
+           { local ($@); $dbh->rollback(); }
+           die $@;
+       }
+       if (eval {
+           $dbh->commit();
+           1;
+       }) {
+           return $rv;
+       }
+       die $@ if !--$retries;
+    }
+}
+

 #---------- request object methods ----------
 
 sub new_request {
 #---------- request object methods ----------
 
 sub new_request {


@@ -550,16 +573,8 @@ sub check_divert ($) {
         return $r->{Divert};
     }
     my $dbh = $r->{Dbh};
         return $r->{Divert};
     }
     my $dbh = $r->{Dbh};

-    $dbh->do("BEGIN");
-    if (!eval {
-        $divert = $r->_check_divert_core();
-        1;
-    }) {
-        $dbh->do("ABORT");
-        die $@;
-    }
-    $r->{Divert} = $divert;
-    $dbh->do("COMMIT");
+    $r->{Divert} = $r->_db_transaction(sub { $r->_check_divert_core(); });
+    $dbh->commit();

     return $divert;
 }
 
     return $divert;
 }
 

diff --git a/commit-test.pl b/commit-test.pl
new file mode 100755 (executable)
index 0000000..69a0640
--- /dev/null
+++ b/commit-test.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/perl -w
+
+use warnings;
+use strict;
+use DBI;
+
+my $dsn = "dbi:SQLite:dbname=test.db";
+my $dbh = DBI->connect($dsn, '','', { 
+                            AutoCommit => 0, RaiseError => 1,
+                        });
+
+foreach my $v (@ARGV) {
+    if (!eval {
+       if ($v eq 'bw') { $dbh->begin_work or die; }
+       elsif ($v eq 'rb') { $dbh->rollback or die; }
+       elsif ($v eq 'ci') { $dbh->commit or die; }
+       elsif ($v eq 'dc') { $dbh->disconnect or die; }
+       elsif ($v eq 'ct') { $dbh->do('CREATE TABLE t (f TEXT)') or die; }
+       elsif ($v eq 'i') { $dbh->do('INSERT INTO t VALUES ("x")') or die; }
+       else { die; }
+       1;
+    }) {
+       warn $@;
+    }
+}

diff --git a/test.cgi b/test.cgi
index b9295513ee876396d2253d0f10141bf1592d4eaf..c869327579675c3f8edbe94b34c316e1d2d96bb0 100755 (executable)
--- a/test.cgi
+++ b/test.cgi
@@ -7,8 +7,6 @@ use CGI::Auth::Hybrid;
 
 my $dump = "$ENV{'CAHTEST_HOME'}/dump";
 
 
 my $dump = "$ENV{'CAHTEST_HOME'}/dump";
 

-#require 'cgi-auth-hybrid.pm';
-

 my $verifier = CGI::Auth::Hybrid->new_verifier(
    assocdb_path => "$dump/assoc.db",
    username_password_ok => sub { my ($c,$r,$u,$p)=@_; return $p eq 'sesame'; },
 my $verifier = CGI::Auth::Hybrid->new_verifier(
    assocdb_path => "$dump/assoc.db",
    username_password_ok => sub { my ($c,$r,$u,$p)=@_; return $p eq 'sesame'; },