chiark / gitweb /
WIP routesearch: actually find the database
authorIan Jackson <ian@liberator.(none)>
Sun, 11 Oct 2009 21:37:34 +0000 (22:37 +0100)
committerIan Jackson <ian@liberator.(none)>
Sun, 11 Oct 2009 21:37:34 +0000 (22:37 +0100)
yarrg/CommodsDatabase.pm
yarrg/CommodsWeb.pm
yarrg/rscommon.h
yarrg/rsmain.c
yarrg/rssql.c
yarrg/web/query_routesearch

index 79744ce..c72bc2d 100644 (file)
@@ -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,
index adcff34..00c6f24 100644 (file)
@@ -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 ($) {
index ab92fa5..38dc629 100644 (file)
@@ -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 {
index 524cbec..ea03260 100644 (file)
@@ -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();
 
index bfe60d6..26a77bb 100644 (file)
@@ -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)");
index 93fcf0b..9accc54 100644 (file)
@@ -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>