X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=blobdiff_plain;f=yarrg%2Fweb%2Flookup;h=38d87d6352d9b96c4a82f059e171c1a336f0d176;hp=9206d4b536b68629c6cd93f9bc928fdffe2e4eeb;hb=aed32e2dcb952bcfc9678eef4125e269f538edf2;hpb=1e054798d3b98978221871919c52af06464d48f2 diff --git a/yarrg/web/lookup b/yarrg/web/lookup index 9206d4b..38d87d6 100755 --- a/yarrg/web/lookup +++ b/yarrg/web/lookup @@ -39,11 +39,6 @@ my %a; my %ahtml; my @vars; -# for output: -my @archipelagoes; -my @islandids; -my %islandid2; - #---------- "mode" argument parsing and mode menu at top of page ---------- # for debugging, invoke as @@ -85,7 +80,6 @@ foreach my $var (@vars) { <% ucfirst $ahtml{Query} %> - YARRG -<& webcopyright &> YARRG - Yet Another Revenue Research Gatherer @@ -134,7 +128,9 @@ foreach my $var (@vars) { my %qf= (%baseqf,%queryqf); delete $qf{$lname}; $qf{$lname}= $value if $cvalix; - print ''; + + +<%perl> $after= ''; } print $html, $after; @@ -150,7 +146,6 @@ dbw_connect($a{Ocean}); <%args> $debug => 0 -$routestring => ''

@@ -158,234 +153,12 @@ $routestring => '' %########### query `route' ########## % if ($a{Query} eq 'route') { -

Specify route

- -%#---------- textbox, user enters route as string ---------- -% if (!$a{Dropdowns}) { - -Enter route (islands, or archipelagoes, separated by |s or commas; - abbreviations are OK):
- - - -
-

- -% } else { #---------- dropdowns, user selects from menus ---------- - -<%perl> -my ($sth,$row);; -my @archlistdata; -my %islandlistdata; -$islandlistdata{'none'}= [ [ "none", "Select island..." ] ]; - -my $optionlistmap= sub { - my ($optlist, $selected) = @_; - my $out=''; - foreach my $entry (@$optlist) { - $out.= sprintf('', - encode_entities($entry->[0]), - defined $selected && $entry->[0] eq $selected - ? 'selected' : '', - encode_entities($entry->[1])); - } - return $out; -}; - -my $dbh= dbw_connect($a{Ocean}); - -$sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands - ORDER BY archipelago;"); -$sth->execute(); - -while ($row=$sth->fetchrow_arrayref) { - my ($arch)= @$row; - push @archlistdata, [ $arch, $arch ]; - $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ]; -} - -$sth= $dbh->prepare("SELECT islandid,islandname,archipelago - FROM islands - ORDER BY islandname;"); -$sth->execute(); - -while ($row=$sth->fetchrow_arrayref) { - my $arch= $row->[2]; - push @{ $islandlistdata{'none'} }, [ @$row ]; - push @{ $islandlistdata{$arch} }, [ @$row ]; - $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch }; -} - -my %resetislandlistdata; -foreach my $arch (keys %islandlistdata) { - $resetislandlistdata{$arch}= - $optionlistmap->($islandlistdata{$arch}, ''); -} - - - - - - - - - - -% for my $dd (0..$a{Dropdowns}-1) { - -% } - - - -% for my $dd (0..$a{Dropdowns}-1) { -% my $arch= $ARGS{"archipelago$dd"}; -% $arch= 'none' if !defined $arch; - -% } - - -

- -% } #---------- end of dropdowns, now common middle of page code ---------- - - -

- -<%perl> -#========== result computations ========== - -my $results_head; -$results_head= sub { - print "

Results

\n"; - $results_head= sub { }; -}; - -#---------- result computation - textstring ---------- -if (!$a{Dropdowns}) { - if (length $routestring) { - $results_head->(); - my $rsr= $m->comp('routetextstring', - ocean => $a{Ocean}, - string => $routestring, - format => 'return' - ); - if (length $rsr->{Error}) { - print encode_entities($rsr->{Error}); - } else { - foreach my $entry (@{ $rsr->{Results} }) { - push @archipelagoes, - defined $entry->[1] ? undef : $entry->[0]; - push @islandids, $entry->[1]; - } - } - } - -} else { #---------- results - dropdowns ---------- - -my $argorundef= sub { - my ($dd,$base) = @_; - my $thing= $ARGS{"${base}${dd}"}; - $thing= undef if defined $thing and $thing eq 'none'; - return $thing; -}; - -for my $dd (0..$a{Dropdowns}-1) { - my $arch= $argorundef->($dd,'archipelago'); - my $island= $argorundef->($dd,'islandid'); - next unless defined $arch or defined $island; - if (defined $island and defined $arch) { - my $ii= $islandid2{$island}; - my $iarch= $ii->{Arch}; - if ($iarch ne $arch) { - $results_head->(); - - Specified archipelago <% $arch %> but - island <% $ii->{Name} %> - which is in <% $iarch %>; using the island.
-<%perl> - } - $arch= undef; - } - push @archipelagoes, $arch; - push @islandids, $island; -} - -}#---------- result processing, common stuff - - -% if (@islandids) { -% $results_head->(); - -<& routetrade, islandids => \@islandids, archipelagoes => \@archipelagoes &> - -% } +<& query_route, %baseqf, %queryqf, quri => $quri, a => \%a &> % } elsif ($a{Query} eq 'age') { % ########### query `age' ########## -

Market data age

-<& dataage, %baseqf, %queryqf &> +<& query_age, %baseqf, %queryqf &> % } ########## end of `age' query ########## @@ -398,14 +171,14 @@ Debug log: % } - + <& footer &> @@ -413,6 +186,5 @@ function debug (m) { use CommodsWeb; use HTML::Entities; use URI::Escape; -use JSON;