@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();
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,
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
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 ($) {
extern sqlite3 *db;
-void setup_sql(void);
+void setup_sql(const char *database);
typedef struct {
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();
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)");
</%args>
<%perl>
+use BSD::Resource;
+
my $emsg;
my @warningfs;
my @islandids;
</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>