dbw_connect($styles{Ocean});
+my $results_head_done=0;
+my $someresults= sub {
+ return if $results_head_done;
+ $results_head_done=1;
+ print "\n<h1>Results</h1>\n";
+};
+
</%perl>
<%args>
$debug => 0
<hr>
-<& "query_$styles{Query}", %baseqf, %queryqf, %styles, quri => $quri &>
+<& "query_$styles{Query}", %baseqf, %queryqf, %styles, quri => $quri,
+ someresults => $someresults,
+ emsgokorprint => sub {
+ my ($emsg) = @_;
+ return 1 unless defined $emsg and length $emsg;
+ $someresults->();
+ print $emsg;
+ return 0;
+ }
+ &>
<p>
</%doc>
<%args>
$thingstring
+$emsgstore
+$perresult
$qa => $m->caller_args(1)->{'qa'}
</%args>
<%perl>
>
<br>
<div id="ts_results"> </div><br>
+
+<%perl>
+if (length $thingstring) {
+ my ($emsg,$canonstring,$results)= $m->comp('qtextstringcheck',
+ what => $thingstring,
+ ocean => $qa->{Ocean},
+ string => $stringval,
+ format => 'return'
+ );
+ $$emsgstore= $emsg;
+
+ foreach my $entry (@$results) {
+ $perresult->(@$entry);
+ }
+}
+</%perl>
<%args>
$quri
$commodstring => '';
+$someresults
+$emsgokorprint
</%args>
-% my $qa= \%ARGS;
+<%perl>
+my $emsg;
+my ($commodname,$commodid);
-%#---------- textbox, user enters route as string ----------
-% if (!$qa->{Dropdowns}) {
+my $qa= \%ARGS;
+</%perl>
<h1>Select commodity</h1>
+%#---------- textbox, user enters route as string ----------
+% if (!$qa->{Dropdowns}) {
+
Enter commodity (abbreviations are OK):<br>
<form action="<% $quri->() |h %>" method="get">
-<&| qtextstring, qa => $qa, thingstring => 'commodstring' &>
+<&| qtextstring, qa => $qa, thingstring => 'commodstring', emsgstore => \$emsg,
+ perresult => sub { ($commodname,$commodid)= @_; }
+ &>
size=80
</&>
+% } else { #---------- dropdowns, user selects from menus ----------
+
+Not yet implemented.
+
+% } #---------- end of dropdowns, now common middle of page code ----------
+
<input type=submit name=submit value="Go">
-% my $ours= sub { $_[0] =~ m/^commodstring/; };
+% my $ours= sub { $_[0] =~ m/^commodstring|^commodid/; };
<& "lookup:formhidden", ours => $ours &>
</form>
-% } else { #---------- dropdowns, user selects from menus ----------
+%#========== results ==========
+% $emsgokorprint->($emsg) or $commodid=undef;
-% } #---------- end of dropdowns, now common middle of page code ----------
+% if (defined $commodid) {
+% $someresults->();
+COMMODITY <% $commodid %> named <% $commodname |h %>
+
+% }
<%args>
$quri
$routestring => '';
+$someresults
+$emsgokorprint
</%args>
-<%perl>
+<%perl>
+my $emsg;
my @archipelagoes;
my @islandids;
my %islandid2;
<form action="<% $quri->() |h %>" method="get">
-<&| qtextstring, qa => $qa, thingstring => 'routestring' &>
+<&| qtextstring, qa => $qa, thingstring => 'routestring', emsgstore => \$emsg,
+ perresult => sub {
+ my ($canonname, $island, $arch) = @_;
+ push @islandids, $island;
+ push @archipelagoes, defined $island ? undef : $arch;
+ }
+ &>
size=80
</&>
% } else { #---------- dropdowns, user selects from menus ----------
<%perl>
-my ($sth,$row);;
+my ($sth,$row);
my @archlistdata;
my %islandlistdata;
$islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
</form>
<%perl>
-#========== result computations ==========
+#========== results ==========
-my $results_head;
-$results_head= sub {
- print "<h1>Results</h1>\n";
- $results_head= sub { };
-};
-
-#---------- result computation - textstring ----------
-if (!$qa->{Dropdowns}) {
- if (length $routestring) {
- $results_head->();
- my ($emsg,$canonstring,$results)= $m->comp('qtextstringcheck',
- what => 'routestring',
- ocean => $qa->{Ocean},
- string => $routestring,
- format => 'return'
- );
- if (length $emsg) {
- print encode_entities($emsg);
- } else {
- foreach my $entry (@$results) {
- push @islandids, $entry->[1];
- push @archipelagoes,
- defined $entry->[1] ? undef : $entry->[2];
- }
- }
- }
-
-} else { #---------- results - dropdowns ----------
+$emsgokorprint->($emsg) or @islandids=();
my $argorundef= sub {
my ($dd,$base) = @_;
my $ii= $islandid2{$island};
my $iarch= $ii->{Arch};
if ($iarch ne $arch) {
- $results_head->();
+ $someresults->();
</%perl>
Specified archipelago <% $arch %> but
island <% $ii->{Name} %>
push @islandids, $island;
}
-}#---------- result processing, common stuff
</%perl>
% if (@islandids) {
-% $results_head->();
-
+% $someresults->();
<& routetrade, islandids => \@islandids, archipelagoes => \@archipelagoes &>
-
% }