package CommodsDatabase;
+# Valid calling sequences:
+# db_setocean('Midnight')
+# [ db_filename() => 'OCEAN-Midnight.db' also OK at any later time ]
+# [ db_writer() ] helpful but not essential
+# db_connect()
+# [ db_onconflict(sub { .... }) ] essential if just dieing is not OK
+# $dbh->do(...), $dbh->prepare(...), db_doall("stmt;stmt;"), etc.
+
use strict;
use warnings;
use DBI;
+use POSIX;
use Commods;
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
- @EXPORT = qw(&db_setocean &db_connect $dbh
- &db_filename &db_doall);
+ @EXPORT = qw(&db_setocean &db_writer &db_connect $dbh
+ &db_filename &db_doall &db_onconflict
+ &dbr_filename &dbr_connect);
%EXPORT_TAGS = ( );
@EXPORT_OK = qw();
}
+sub dbr_filename ($$) {
+ my ($datadir,$oceanname) = @_;
+ return "$datadir/OCEAN-$oceanname.db";
+}
+sub dbr_connect ($$) {
+ my ($datadir,$ocean) = @_;
+ return connect_core(dbr_filename($datadir,$ocean));
+}
+
+sub connect_core ($) {
+ my ($fn)= @_;
+ my $h= DBI->connect("dbi:SQLite:$fn",'','',
+ { AutoCommit=>0,
+ RaiseError=>1, ShowErrorStatement=>1,
+ unicode=>1 })
+ or die "$fn $DBI::errstr ?";
+ return $h;
+ # default timeout is 30s which is plenty
+}
+
our $dbfn;
our $dbh;
sub db_setocean ($) {
my ($oceanname) = @_;
- $dbfn= "OCEAN-$oceanname.db";
+ $dbfn= dbr_filename('.',$oceanname);
}
sub db_filename () {
return $dbfn;
}
+sub db_onconflict (&) {
+ my ($conflictproc) = @_;
+ $dbh->{HandleError}= sub {
+ my ($emsg,$dbh,$val1) = @_;
+ my $native_ecode= $dbh->err();
+ &$conflictproc($emsg) if grep { $_ == $native_ecode } qw(5 6);
+ # 5==SQLITE_BUSY, 6==SQLITE_LOCKED according to the SQLite3
+ # API documentation, .../capi3ref.html#extended-result-codes.
+ return 0; # RaiseError happens next.
+ };
+}
+
+our $writerlockh;
+
+sub db_writer () {
+ my $lockfn= "Writer.lock";
+ $writerlockh= new IO::File "$lockfn", "w" or die "$lockfn $!";
+
+ my $flockall= pack 's!s!LLLLLL', F_WRLCK, SEEK_SET, 0,0,0,0,0,0;
+ # should work everywhere to lock the whole file, provided that
+ # l_type and l_whence are `short int' and come first in that order,
+ # and that start, len and pid are no more than 64 bits each.
+
+ my $r= fcntl($writerlockh, F_SETLKW, $flockall);
+ $r or die "$lockfn fcntl $!";
+}
+
sub db_connect () {
- $dbh= DBI->connect("dbi:SQLite:$dbfn",'','',
- { AutoCommit=>0,
- RaiseError=>1, ShowErrorStatement=>1,
- unicode=>1 })
- or die "$dbfn $DBI::errstr ?";
+ $dbh= connect_core($dbfn);
}
sub db_doall ($) {