From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 13 Aug 2009 01:19:40 +0000 (+0100)
Subject: abolish $dbh global in Mason code to shorten db connection lifetime
X-Git-Tag: 3.4~210
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=commitdiff_plain;h=c363ec70c47a05f429b3bda15f4a4e42d5233eb2

abolish $dbh global in Mason code to shorten db connection lifetime
---

diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm
index 7bd7c77..79744ce 100644
--- a/yarrg/CommodsDatabase.pm
+++ b/yarrg/CommodsDatabase.pm
@@ -45,22 +45,38 @@ BEGIN {
     @ISA         = qw(Exporter);
     @EXPORT      = qw(&db_setocean &db_writer &db_connect $dbh
 		      &db_filename &db_doall &db_onconflict
-		      &db_setdatadir $db_datadir);
+		      &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;
-our $db_datadir= '.';
 
-sub db_setdatadir ($) {
-    $db_datadir= $_[0];
-}
 sub db_setocean ($) {
     my ($oceanname) = @_;
-    $dbfn= "$db_datadir/OCEAN-$oceanname.db";
+    $dbfn= dbr_filename('.',$oceanname);
 }
 sub db_filename () {
     return $dbfn;
@@ -94,12 +110,7 @@ sub db_writer () {
 }
 
 sub db_connect () {
-    $dbh= DBI->connect("dbi:SQLite:$dbfn",'','',
-		       { AutoCommit=>0,
-			 RaiseError=>1, ShowErrorStatement=>1,
-			 unicode=>1 })
-	or die "$dbfn $DBI::errstr ?";
-    # default timeout is 30s which is plenty
+    $dbh= connect_core($dbfn);
 }
 
 sub db_doall ($) {
diff --git a/yarrg/CommodsWeb.pm b/yarrg/CommodsWeb.pm
index d09331d..5e1520e 100644
--- a/yarrg/CommodsWeb.pm
+++ b/yarrg/CommodsWeb.pm
@@ -43,16 +43,17 @@ BEGIN {
     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw($dbh &db_setocean &db_connect &db_doall
-		      &ocean_list);
+    @EXPORT      = qw(&dbw_connect &ocean_list);
     %EXPORT_TAGS = ( );
 
     @EXPORT_OK   = qw();
 }
 
+our $datadir='.';
+
 for my $dir (@INC) {
     if ($dir =~ m/\.perl-lib$/) {
-	db_setdatadir("$dir/DATA");
+	$datadir= "$dir/DATA";
 	last;
     }
 }
@@ -61,7 +62,7 @@ my @ocean_list;
 
 sub ocean_list () {
     if (!@ocean_list) {
-	my $fn= "$db_datadir/master-info.txt";
+	my $fn= "$datadir/master-info.txt";
 	my $f= new IO::File $fn or die $!;
 	my @r;
 	while (<$f>) {
@@ -75,4 +76,11 @@ sub ocean_list () {
     return @ocean_list;
 }
 
+sub dbw_connect ($) {
+    my ($ocean) = @_;
+    die "unknown ocean $ocean ?"
+	unless grep { $_ eq $ocean } ocean_list();
+    return dbr_connect($datadir, $ocean);
+}
+
 1;
diff --git a/yarrg/web/pirates b/yarrg/web/pirates
index 158239d..6a3c478 100644
--- a/yarrg/web/pirates
+++ b/yarrg/web/pirates
@@ -54,6 +54,5 @@ $sth->execute();
 
 <%init>
 use CommodsWeb;
-db_setocean('Midnight');
-db_connect();
+my $dbh= dbw_connect('Midnight');
 </%init>
diff --git a/yarrg/web/route b/yarrg/web/route
index 74a5086..9c7200c 100644
--- a/yarrg/web/route
+++ b/yarrg/web/route
@@ -87,11 +87,7 @@ foreach my $var (@vars) {
 
 #---------- initial checks, startup, main entry form ----------
 
-die "unknown ocean $a{Ocean} ?"
-	unless grep { $_ eq $a{Ocean} } ocean_list();
-
-db_setocean($a{Ocean});
-db_connect();
+dbw_connect($a{Ocean});
 
 </%perl>
 <%args>
@@ -176,6 +172,8 @@ my $optionlistmap= sub {
 	return $out;
 };
 
+my $dbh= dbw_connect($a{Ocean});
+
 $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
 			    ORDER BY archipelago;");
 $sth->execute();
@@ -342,5 +340,6 @@ function debug (m) {
 use CommodsWeb;
 use HTML::Entities;
 use URI::Escape;
+use JSON;
 
 </%init>
diff --git a/yarrg/web/routetextstring b/yarrg/web/routetextstring
index d66e756..4d59c7f 100644
--- a/yarrg/web/routetextstring
+++ b/yarrg/web/routetextstring
@@ -15,8 +15,7 @@ use HTML::Entities;
 use JSON;
 use Data::Dumper;
 
-db_setocean($ocean);
-db_connect();
+my $dbh= dbw_connect($ocean);
 
 my $sth= $dbh->prepare("SELECT archipelago,islandid,islandname
 	 			FROM islands WHERE islandname LIKE ?
@@ -78,7 +77,6 @@ foreach my $each (split m#[/|,]#, $string) {
 }
 
 $canontext= join ' | ', map { $_->[2] } @results;
-
 return $output->();
 
 </%perl>
diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index bbd63a6..4475d27 100644
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -22,6 +22,5 @@ Route is as follows:
 
 <%init>
 use CommodsWeb;
-db_setocean('Midnight');
-db_connect();
+my $dbh= dbw_connect('Midnight');
 </%init>