X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=blobdiff_plain;f=yarrg%2FCommodsDatabase.pm;h=c72bc2dffb9663f08c2d160157d9b785c71cbe2a;hp=4866c855d3baacccc7c29ae754a60415169672d6;hb=2abd3537af0c697684bfb97895f230372101329d;hpb=c68fb80a6bbf7acbcac4b2cb2143f5fea745cd2b

diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm
index 4866c85..c72bc2d 100644
--- a/yarrg/CommodsDatabase.pm
+++ b/yarrg/CommodsDatabase.pm
@@ -22,10 +22,19 @@
 
 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;
 
@@ -34,30 +43,74 @@ BEGIN {
     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 &db_connect_core);
     %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 db_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 ($) {