use DBI;
use CGI;
use Locale::gettext;
+use URI;
#---------- public utilities ----------
#---------- default callbacks ----------
sub has_a_param ($$) {
- my ($c,$r,$cn) = @_;
+ my ($r,$cn) = @_;
foreach my $pn (@{ $r->{S}{$cn} }) {
- return 1 if $r->_cm('get_param',$pn);
+ return 1 if $r->_ch('get_param',$pn);
}
return 0;
}
-sub get_params ($$) {
- my ($c,$r) = @_;
+sub get_params ($) {
+ my ($r) = @_;
my %p;
+ my $c = $r->{Cgi};
foreach my $name ($c->param()) {
$p{$name} = [ $c->param($name) ];
}
my $u = umask 077;
$dbh = DBI->connect($dsn, $v->{S}{assocdb_user},
$v->{S}{assocdb_password}, {
- AutoCommit => 0, RaiseError => 1,
+ AutoCommit => 0,
+ RaiseError => 1,
+ ShowErrorStatement => 1,
});
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".
- ")");
+ $v->_db_transaction(sub {
+ local ($dbh->{PrintError}) = 0;
+ $dbh->do("CREATE TABLE $v->{S}{assocdb_table} (".
+ " associd VARCHAR PRIMARY KEY,".
+ " username VARCHAR,".
+ " last INTEGER NOT NULL".
+ ")");
+ });
};
return $dbh;
}
$dbh->disconnect();
}
+sub _db_transaction ($$) {
+ my ($v, $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 {
sub construct_cookie ($$$) {
my ($r, $cookv) = @_;
+ return undef unless $cookv;
return $r->{Cgi}->cookie(-name => $r->{S}{cookie_name},
-value => $cookv,
-path => $r->{S}{cookie_path},
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;
}
my ($r) = @_;
my ($divert) = $r->check_divert();
- return 1 if $divert;
+ return 1 if !$divert;
my $handled = $r->_ch('handle_divert',$divert);
return 0 if $handled;
return $r->_random($bytes);
}
-sub check_mutate ($) {
+sub _assert_checked ($) {
my ($r) = @_;
die "unchecked" unless exists $r->{Divert};
+}
+
+sub check_mutate ($) {
+ my ($r) = @_;
+ $r->_assert_checked();
die if $r->{Divert};
my $meth = $r->_ch('get_method');
die "mutating non-POST" if $meth ne 'POST';
sub secret_val ($) {
my ($r) = @_;
- $r->check();
+ $r->_assert_checked();
return defined $r->{Assoc} ? $r->{Assoc} : '';
}