die "$dsn $! ?" unless $dbh;
$v->{Dbh} = $dbh;
- $dbh->do("BEGIN");
-
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;
}
$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 {
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;
}
--- /dev/null
+#!/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 $@;
+ }
+}
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'; },