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

diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm
index 7bd7c77e1191055137e9b7fa43b45d2bec08263c..79744cede7254daabbb07cd0db1941d2e0b7eae2 100644 (file)
--- 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 d09331d4c54e40ae91861d3abbf080187caba06a..5e1520e22f45a3e0d3853f53e6523f1b370e6e5c 100644 (file)
--- 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 158239dd5a7a98cbcb57088f0b1cb7a8601e23a3..6a3c47889fead82686fa712bb4091c19612b7209 100644 (file)
--- 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 74a5086f1428b64f37e269dd66f3eff07ed999d7..9c7200c39480df0343ab70b7615e4e994316b3d2 100644 (file)
--- 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 d66e756b1a4e9f3517cb8055b3a927918a03d27e..4d59c7fa5e2d4b5697d9e55bb6a00aa7d1e90bc9 100644 (file)
--- 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 bbd63a6fac87c5409df59b7fd75be02428387d35..4475d27197915154c8cc4204556c10259dd355b2 100644 (file)
--- 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>