X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2Fweb%2Flookup;h=751a99aa1a6916382c3843c610eda6691a02868b;hp=41eda49db3359e0462a330245c3ce1468fe9b86d;hb=013f7a0ab3bf8d2b1100022e8fc868407c751720;hpb=974db6fb76db530406e21d71b785cc3b6f5c3079 diff --git a/yarrg/web/lookup b/yarrg/web/lookup old mode 100644 new mode 100755 index 41eda49..751a99a --- a/yarrg/web/lookup +++ b/yarrg/web/lookup @@ -1,45 +1,44 @@ -%# This is part of the YARRG website. YARRG is a tool and website -%# for assisting players of Yohoho Puzzle Pirates. -%# -%# Copyright (C) 2009 Ian Jackson -%# Copyright (C) 2009 Clare Boothby -%# -%# YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later). -%# The YARRG website is covered by the GNU Affero GPL v3 or later, which -%# basically means that every installation of the website will let you -%# download the source. -%# -%# This program is free software: you can redistribute it and/or modify -%# it under the terms of the GNU Affero General Public License as -%# published by the Free Software Foundation, either version 3 of the -%# License, or (at your option) any later version. -%# -%# This program is distributed in the hope that it will be useful, -%# but WITHOUT ANY WARRANTY; without even the implied warranty of -%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -%# GNU Affero General Public License for more details. -%# -%# You should have received a copy of the GNU Affero General Public License -%# along with this program. If not, see . -%# -%# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and -%# are used without permission. This program is not endorsed or -%# sponsored by Three Rings. -%# -%# -%# This Mason component generates the main `lookup' page, including -%# all the entry boxes etc. for every query. -%# +<%doc> + + This is part of the YARRG website. YARRG is a tool and website + for assisting players of Yohoho Puzzle Pirates. + + Copyright (C) 2009 Ian Jackson + Copyright (C) 2009 Clare Boothby + + YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later). + The YARRG website is covered by the GNU Affero GPL v3 or later, which + basically means that every installation of the website will let you + download the source. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + + Yohoho and Puzzle Pirates are probably trademarks of Three Rings and + are used without permission. This program is not endorsed or + sponsored by Three Rings. + + + This Mason component generates the main `lookup' page, including + all the entry boxes etc. for every query. + + + <%perl> 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 @@ -81,7 +80,6 @@ foreach my $var (@vars) { <% ucfirst $ahtml{Query} %> - YARRG -<& webcopyright &> YARRG - Yet Another Revenue Research Gatherer @@ -130,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; @@ -141,249 +141,20 @@ foreach my $var (@vars) { #---------- initial checks, startup, main entry form ---------- +die if $a{Query} =~ m/[^a-z]/; + dbw_connect($a{Ocean}); <%args> $debug => 0 -$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]; - } - } - } +<& "query_$a{Query}", %baseqf, %queryqf, quri => $quri, a => \%a &> -} 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 &> - -% } - -% } elsif ($a{Query} eq 'age') { -% ########### query `age' ########## - -

Market data age

-<& dataage, %baseqf, %queryqf &> - -% } ########## end of `age' query ########## +

%#---------- debugging and epilogue ---------- @@ -394,14 +165,14 @@ Debug log: % } - + <& footer &> @@ -409,6 +180,5 @@ function debug (m) { use CommodsWeb; use HTML::Entities; use URI::Escape; -use JSON;