<%args>
$quri
$dbh
+$baseqf
+$queryqf
$islandstring => '';
$capacitystring => '';
$lossperleague => '';
$capitalstring => '';
+$minprofitstring => '';
$distance => '';
+$prselector
$someresults
$emsgokorprint
+$allargs
</%args>
<%perl>
my @warningfs;
my @islandids;
+my $destspec;
+
my $maxmaxdist=35;
my $maxcpu=90;
my $concur_lim=5;
</%perl>
+<div class="query">
<h1>Find most profitable routes and trades</h1>
% if ($qa->{Dropdowns}) {
This feature is not available from the "drop down menus" interface.
% } else {
+% $prselector->('RouteSearchType');
+
<form action="<% $quri->() |h %>" method="get">
<& enter_route, qa=>$qa, dbh=>$dbh, emsg_r=>\$emsg, warningfs_r=>\@warningfs,
islandids_r => \@islandids, archipelagoes_r => undef
&>
+% my $searchtype= $ARGS{RouteSearchType};
+% if ($searchtype == 0) {
+% $destspec= 'any';
+% } elsif ($searchtype == 1) {
+% $destspec= 'circ';
+% } elsif ($searchtype == 2) {
+
+Destination (one island only):
+<& qtextstring, qa => $qa, dbh => $dbh, emsgstore => \$emsg,
+ thingstring => 'deststring',
+ prefix => 'ds', boxopts => 'size=40',
+ onresults => sub {
+print STDERR "ONRESULTS @_\n";
+ return unless @_;
+ my ($canonname, $island, $arch) = @{ $_[0] };
+ die unless defined $island;
+ $destspec= $island;
+ }
+ &>
+
+% } else {
+% die "$destspec ?";
+% }
+
<&| enter_advrouteopts, qa=>$qa, dbh=>$dbh, routeparams=>$routeparams &>
<td>
<td>
Maximum distance:
- <&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'ml',
- thingstring => 'distance', emsgstore => \$emsg,
- onresults => sub { ($maxdist)= @_; } &>
- size=10
- </&>
+ <& qtextstring, qa => $qa, dbh => $dbh, prefix => 'ml',
+ thingstring => 'distance', emsgstore => \$emsg, boxopts => 'size=10',
+ onresults => sub { ($maxdist)= @_; }
+ &>
</&>
-<input type=submit name=submit value="Go">
-% my $ours= sub { $_[0] =~ m/^lossperleague|^islandstring|^capitalstring|^capacitystring|^distance/; };
+<input type=submit name=submit value="Search">
+% my $ours= sub { $_[0] =~ m/^lossperleague|^islandstring|^deststring|^capitalstring|^capacitystring|^minprofitstring|^distance/; };
<& "lookup:formhidden", ours => $ours &>
% }
</form>
+</div>
+<div class="results">
<%perl>
if (!$emsg && $maxdist > $maxmaxdist) {
" supported, sorry.";
}
-$emsgokorprint->($emsg) or return;
-@islandids or return;
-defined $routeparams->{MaxMass} or defined $routeparams->{MaxVolume} or return;
+print("</div>"), return
+ unless $emsgokorprint->($emsg)
+ and @islandids
+ and $allargs->{'submit'}
+ and defined $destspec
+ and (defined $routeparams->{MaxMass} or
+ defined $routeparams->{MaxVolume});
#---------- prepare island names ----------
my $row= $islandname_stmt->fetchrow_hashref();
local $_= $row->{'islandname'};
s/ Island$//;
- return $_, $row->{'archipelago'};
+ return $_, $row->{'islandname'}, $row->{'archipelago'};
};
#---------- compute the results ----------
}
push @rsargs, defined $routeparams->{LossPerLeaguePct}
? $routeparams->{LossPerLeaguePct}*0.01 : 1e-9;
-push @rsargs, '0';
-push @rsargs, 'search',$maxdist, $maxcountea,$maxcountea, 'any', @islandids;
+push @rsargs, 0; #$routeparams->{MinProfit};
+push @rsargs, 'search',$maxdist, $maxcountea,$maxcountea;
+push @rsargs, $destspec;
+push @rsargs, @islandids;
m/[^-.0-9a-zA-Z]/ and die "$_ $& ?" foreach @rsargs;
}
unshift @rsargs,
- sourcebasedir().'/yarrg/routesearch',
+ 'nice', sourcebasedir().'/yarrg/routesearch',
'-d', dbw_filename($qa->{'Ocean'}),
'-C', webdatadir().'/_concur.', '.lock';
my ($ap,$isles) = (uc $1,$5);
next if $results{$ap} && %{$results{$ap}} >= $maxcountea;
my $item= { A => $3, P => $4, Leagues => $2 };
- my (@i, @a);
+ my (@i, @fi, @a);
foreach (split / /, $isles) {
- my ($name,$arch)= $isleinfo->($_);
+ my ($name,$fullname,$arch)= $isleinfo->($_);
push @i, $name;
+ push @fi, $fullname;
push @a, $arch unless @a && $a[-1] eq $arch;
}
$item->{Isles}= [ @i ];
for ($i=1; $i < @i-1; $i++) {
push @{ $item->{Vias} }, $i[$i];
}
+ my %linkqf= (%$baseqf, %$queryqf);
+ delete $linkqf{'query'};
+ $linkqf{'routestring'}= join ', ', @fi;
+ $item->{Url}= $quri->(%linkqf);
+ $item->{ArchesString}= join ', ', @a;
+ $item->{ViasString}= join ' ', map { $_.',' } @{ $item->{Vias} };
+ $item->{RouteSortString}= join ', ', @i;
$results{$ap}{$isles}= $item;
}
print "</pre>\n";
}
+$!=0;
+if (!close $fh) {
+ die $! if $!;
+ die $? if $? != 24; # SIGXCPU but not in POSIX.pm :-/
+</%perl>
+<h2>Search took too long and was terminated</h2>
+
+Sorry, but your query resulted in a search that took too long.
+Searches are limited to <% $maxcpu |h %> seconds of CPU time to
+avoid them consuming excessive resources on the server system, and to
+make sure that shorter searches can still happen.
+
+<p>
+Please try a search with a smaller minimum distance, or place more
+restrictions on the route.
+
+<%perl>
+ return;
+}
+
if ($concur_fail) {
</%perl>
<h2>Server too busy</h2>
<p>
If you submitted several searches and gave up on them (eg by hitting
-`back' or `stop' in your browser), be aware that that doesn't
+"back" or "stop" in your browser), be aware that that doesn't
generally stop the search process at the server end. So it's best to
avoid asking for large searches that you're not sure about.
return;
}
+$someresults->();
+
</%perl>
% foreach my $ap (qw(A P)) {
-<h2>ap=<% $ap %></h2>
-<table rules=groups>
+% if ($ap eq 'A') {
+<h2>Best routes for total profit</h2>
+% } else {
+<h2>Best routes for profit per league</h2>
+% }
+<table class="data" rules=groups id="ap<% $ap %>_table">
<colgroup span=2>
<colgroup span=1>
<colgroup span=1>
<colgroup span=3>
-<tbody>
<tr>
<th colspan=2>Profit
<th>Dist.
<th>Archipelagoes
-<th colspan=3>Route
+<th>
+<th>Route
+<th>
<tr>
<th>Abs.
<th>Per.lg.
<th>
-<th>
+<th>(link to plan)
<th>Start
<th>Via
<th>Finish
-<tbody>
+<tr id="ap<% $ap %>_sortrow"><th><th><th><th><th><th><th>
% my $datarow=0;
+% my %sortkeys;
% foreach my $isles (sort {
% $results{$ap}{$b}{$ap} <=>
% $results{$ap}{$a}{$ap}
% } keys %{$results{$ap}}) {
% my $item= $results{$ap}{$isles};
-<tr class="datarow<% $datarow %>">
+% my $ci=0;
+% my $rowid= "r${ap}$isles"; $rowid =~ y/ /_/;
+% foreach my $k (qw(A P Leagues ArchesString
+% Start RouteSortString Finish)) {
+% $sortkeys{$ci}{$rowid}= $item->{$k};
+% $ci++;
+% }
+<tr class="datarow<% $datarow %>" id="<% $rowid %>">
<td align=right><% $item->{A} |h %>
<td align=right><% $item->{P} |h %>
<td align=right><% $item->{Leagues} |h %>
-<td align=left><% join ', ', @{ $item->{Archs} } |h %>
+<td align=left><a href="<% $item->{Url} |h %>"><%
+ $item->{ArchesString} |h %></a>
<td align=left><% $item->{Start} |h %>,
-<td align=left><% join ' ', map { $_.',' } @{ $item->{Vias} } |h %>
+<td align=left><% $item->{ViasString} |h %>
<td align=left><% $item->{Finish} |h %>
</td>
% $datarow ^= 1;
% } # $isles
</table>
+<&| tabsort, table => "ap${ap}_table", sortkeys => "ap${ap}_sortkeys",
+ throw => "ap${ap}_sortrow", rowclass => "datarow", cols => [
+ { DoReverse => 1, Numeric => 1 },
+ { DoReverse => 1, Numeric => 1 },
+ { DoReverse => 1, Numeric => 1 },
+ { },
+ { },
+ { },
+ { },
+ ] &>
+ ap<% $ap %>_sortkeys= <% to_json_protecttags(\%sortkeys) %>;
+</&tabsort>
% } # $ap
-<%perl>
+<p>
+
+<h2>Notes</h2>
-</%perl>
+Per league values count each island visited as one
+(additional) league; the "Dist." column is however the actual distance
+to be sailed. All profit figures are somewhat approximate; get a
+complete trading plan for a route for accurate information.
+
+</div>