@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;
}
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 ($) {
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;
}
}
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>) {
return @ocean_list;
}
+sub dbw_connect ($) {
+ my ($ocean) = @_;
+ die "unknown ocean $ocean ?"
+ unless grep { $_ eq $ocean } ocean_list();
+ return dbr_connect($datadir, $ocean);
+}
+
1;
<%init>
use CommodsWeb;
-db_setocean('Midnight');
-db_connect();
+my $dbh= dbw_connect('Midnight');
</%init>
#---------- 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>
return $out;
};
+my $dbh= dbw_connect($a{Ocean});
+
$sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
ORDER BY archipelago;");
$sth->execute();
use CommodsWeb;
use HTML::Entities;
use URI::Escape;
+use JSON;
</%init>
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 ?
}
$canontext= join ' | ', map { $_->[2] } @results;
-
return $output->();
</%perl>
<%init>
use CommodsWeb;
-db_setocean('Midnight');
-db_connect();
+my $dbh= dbw_connect('Midnight');
</%init>