From: Ian Jackson <ian@liberator.(none)>
Date: Sun, 11 Oct 2009 21:37:34 +0000 (+0100)
Subject: WIP routesearch: actually find the database
X-Git-Tag: 5.0^2~49
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=commitdiff_plain;h=2abd3537af0c697684bfb97895f230372101329d

WIP routesearch: actually find the database
---

diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm
index 79744ce..c72bc2d 100644
--- a/yarrg/CommodsDatabase.pm
+++ b/yarrg/CommodsDatabase.pm
@@ -45,7 +45,7 @@ BEGIN {
     @ISA         = qw(Exporter);
     @EXPORT      = qw(&db_setocean &db_writer &db_connect $dbh
 		      &db_filename &db_doall &db_onconflict
-		      &dbr_filename &dbr_connect);
+		      &dbr_filename &dbr_connect &db_connect_core);
     %EXPORT_TAGS = ( );
 
     @EXPORT_OK   = qw();
@@ -60,7 +60,7 @@ sub dbr_connect ($$) {
     return connect_core(dbr_filename($datadir,$ocean));
 }
 
-sub connect_core ($) {
+sub db_connect_core ($) {
     my ($fn)= @_;
     my $h= DBI->connect("dbi:SQLite:$fn",'','',
 		       { AutoCommit=>0,
diff --git a/yarrg/CommodsWeb.pm b/yarrg/CommodsWeb.pm
index adcff34..00c6f24 100644
--- a/yarrg/CommodsWeb.pm
+++ b/yarrg/CommodsWeb.pm
@@ -48,7 +48,7 @@ BEGIN {
     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(&dbw_connect &ocean_list &sourcebasedir
+    @EXPORT      = qw(&dbw_connect &dbw_filename &ocean_list &sourcebasedir
 		      &to_json_shim &to_json_protecttags
 		      &set_ctype_utf8
 		      &expected_error &dbw_lookup_string
@@ -106,11 +106,17 @@ sub ocean_list () {
     return @ocean_list;
 }
 
-sub dbw_connect ($) {
+sub dbw_filename ($) {
     my ($ocean) = @_;
     die "unknown ocean $ocean ?"
 	unless grep { $_ eq $ocean } ocean_list();
-    return dbr_connect(datadir(), $ocean);
+    return dbr_filename(datadir(), $ocean);
+}
+
+sub dbw_connect ($) {
+    my ($ocean) = @_;
+    my $fn= dbw_filename($ocean);
+    return db_connect_core($fn);
 }
 
 sub to_json_shim ($) {
diff --git a/yarrg/rscommon.h b/yarrg/rscommon.h
index ab92fa5..38dc629 100644
--- a/yarrg/rscommon.h
+++ b/yarrg/rscommon.h
@@ -98,7 +98,7 @@ void sql_bind(sqlite3_stmt *ss, int index, int value,
 
 extern sqlite3 *db;
 
-void setup_sql(void);
+void setup_sql(const char *database);
 
 
 typedef struct {
diff --git a/yarrg/rsmain.c b/yarrg/rsmain.c
index 524cbec..ea03260 100644
--- a/yarrg/rsmain.c
+++ b/yarrg/rsmain.c
@@ -74,17 +74,17 @@ int main(int argc, const char **argv) {
     debug_file= stderr;
   }
 
+  const char *database= *argv++;
+
   sysassert( !setvbuf(debug,0,_IOLBF,0) );
 
   max_mass= atof(*argv++);
   max_volu= atof(*argv++);
   max_capi= atof(*argv++);
   double loss_per_league= atof(*argv++);
-
-  if (!loss_per_league) loss_per_league= 1e-7;
   distance_loss_factor_per_league= 1.0 - loss_per_league;
 
-  setup_sql();
+  setup_sql(database);
   setup_value();
   setup_search();
 
diff --git a/yarrg/rssql.c b/yarrg/rssql.c
index bfe60d6..26a77bb 100644
--- a/yarrg/rssql.c
+++ b/yarrg/rssql.c
@@ -14,10 +14,10 @@ static int busy_handler(void *u, int previous) {
   return 1;
 }
 
-void setup_sql(void) {
+void setup_sql(const char *database) {
   sqlite3_stmt *sst;
   
-  SQL_MUST( sqlite3_open("OCEAN-Midnight.db", &db) );
+  SQL_MUST( sqlite3_open(database, &db) );
   SQL_MUST( sqlite3_busy_handler(db, busy_handler, 0) );
 
   sst= sql_prepare("BEGIN","(begin)");
diff --git a/yarrg/web/query_routesearch b/yarrg/web/query_routesearch
index 93fcf0b..9accc54 100644
--- a/yarrg/web/query_routesearch
+++ b/yarrg/web/query_routesearch
@@ -46,6 +46,8 @@ $emsgokorprint
 </%args>
 
 <%perl>
+use BSD::Resource;
+
 my $emsg;
 my @warningfs;
 my @islandids;
@@ -91,7 +93,62 @@ This feature is not available from the "drop down menus" interface.
 </form>
 <%perl>
 
+if (!$emsg && $maxdist > 30) {
+	$emsg= "Searching for routes of more than 30 leagues is not".
+		" supported, sorry.";
+}
+
 $emsgokorprint->($emsg) or return;
 @islandids or return;
+defined $routeparams->{MaxMass} or defined $routeparams->{MaxVolume} or return;
+
+#---------- compute the results ----------
+
+my @rsargs;
+
+foreach my $k (qw(MaxMass MaxVolume MaxCapital)) {
+	my $v= $routeparams->{$k};
+	push @rsargs, (defined $v ? $v : -1);
+}
+push @rsargs, defined $routeparams->{LossPerLeaguePct}
+	? $routeparams->{LossPerLeaguePct}*0.01 : 1e-9;
+push @rsargs, qw(search 10 10), $maxdist, 'any', @islandids;
+
+m/[^-.0-9a-zA-Z]/ and die "$_ $& ?" foreach @rsargs;
+
+unshift @rsargs, dbw_filename($qa->{'Ocean'});
+unshift @rsargs, qw(-DN);
+
+if ($qa->{'debug'}) {
+</%perl>
+[[ <% "@rsargs" |h %> ]]<br><pre>
+<%perl>
+}
+
+unshift @rsargs, sourcebasedir().'/yarrg/routesearch';
+
+my $fh= new IO::File;
+my $child= $fh->open("-|"); defined $child or die $!;
+if (!$child) {
+	my $cpu= BSD::Resource::RLIMIT_CPU;
+	my ($soft,$hard)= getrlimit($cpu);
+	my $max=10;
+	setrlimit($cpu,$max,$hard) or die $! if $soft>$max;
+	exec @rsargs;
+	die $!;
+}
+
+while (<$fh>) {
+	chomp;
+	if ($qa->{'debug'}) {
+</%perl>
+<% $_ |h %>
+<%perl>
+	}
+}
+
+if ($qa->{'debug'}) {
+	print "</pre>\n";
+}
 
 </%perl>