X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=blobdiff_plain;f=yarrg%2Fweb%2Fquery_route;h=eeb4331eb067b7645dadb2506995d0a4323d600b;hp=f409e704b4d01345db3cb14feca6f08c9d55ed3b;hb=29010a75143814a91b4f5200454bea879280e7c1;hpb=38e2919be138f8a77eef7a2fc93d34eff8897f5e diff --git a/yarrg/web/query_route b/yarrg/web/query_route index f409e70..eeb4331 100644 --- a/yarrg/web/query_route +++ b/yarrg/web/query_route @@ -1,190 +1,129 @@ +<%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 core of the `trade route' query. + + + <%args> $quri -$qa +$dbh +$prselector $routestring => ''; +$capacitystring => ''; +$lossperleague => ''; +$capitalstring => ''; +$someresults +$emsgokorprint -<%perl> +<%perl> +my $emsg; +my @warningfs; my @archipelagoes; my @islandids; -my %islandid2; - - - -%#---------- textbox, user enters route as string ---------- -% if (!$qa->{Dropdowns}) { - -

Specify route

- -
- -<&| qtextstring, qa => $qa, thingstring => 'routestring' &> - size=80 - -% } else { #---------- dropdowns, user selects from menus ---------- +my $qa= \%ARGS; +my $be_post; +my $startform= sub { + ($be_post)= @_; + + <%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 $goupdate= sub { $be_post ? 'Update' : 'Go' }; -my $dbh= dbw_connect($qa->{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" ] ]; -} +

Specify route

-$sth= $dbh->prepare("SELECT islandid,islandname,archipelago - FROM islands - ORDER BY islandname;"); -$sth->execute(); +% # Sadly we need to do this rather hacky thing to make it be a POST +% # form if the user has already selected some thing(s) +% if (!$qa->{Dropdowns}) { +% $startform->($routestring =~ m/\S/); +% } else { +% $startform->(grep { +% defined $qa->{"archipelago$_"} || +% defined $qa->{"islandid$_"} +% } (0..$qa->{Dropdowns}-1)); +% } -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 }; -} +% $prselector->('ShowStalls'); -my %resetislandlistdata; -foreach my $arch (keys %islandlistdata) { - $resetislandlistdata{$arch}= - $optionlistmap->($islandlistdata{$arch}, ''); -} +<& enter_route, qa => $qa, dbh => $dbh, emsg_r => \$emsg, + warningfs_r => \@warningfs, + enterwhat => 'Enter route', + islandids_r => \@islandids, + archipelagoes_r => \@archipelagoes + &> - +%#---------- textboxes, user enters details as strings ---------- +% my $routeparams= { EmsgRef => \$emsg }; +% if (!$qa->{Dropdowns}) { - - -<&| script &> -ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>; -function ms_Setarch(dd) { - debug('ms_SetArch '+dd+' arch='+arch); - var arch= document.getElementsByName('archipelago'+dd).item(0).value; - var got= ms_lists[arch]; - if (got == undefined) return; // unknown arch ? hrm - debug('ms_SetArch '+dd+' arch='+arch+' got ok'); - var select= document.getElementsByName('islandid'+dd).item(0); - select.innerHTML= got; - debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set'); -} - - - - - -% for my $dd (0..$qa->{Dropdowns}-1) { - -% } - - - -% for my $dd (0..$qa->{Dropdowns}-1) { -% my $arch= $ARGS{"archipelago$dd"}; -% $arch= 'none' if !defined $arch; - -% } - - -
-
-
+<& enter_advrouteopts, qa=>$qa, dbh=>$dbh, routeparams=>$routeparams &> % } #---------- end of dropdowns, now common middle of page code ---------- - - + +% my $ours= sub { $_[0] =~ +% m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^capitalstring|^[RT]/; +% }; +<& "lookup:formhidden", ours => $ours &> +
+
<%perl> -#========== result computations ========== +#========== results ========== -my $results_head; -$results_head= sub { - print "

Results

\n"; - $results_head= sub { }; -}; - -#---------- result computation - textstring ---------- -if (!$qa->{Dropdowns}) { - if (length $routestring) { - $results_head->(); - my $rsr= $m->comp('routetextstring', - ocean => $qa->{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; -}; +$emsgokorprint->($emsg) or @islandids=(); -for my $dd (0..$qa->{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; +foreach my $warningf (@warningfs) { + $someresults->(); + $warningf->(); } -}#---------- result processing, common stuff % if (@islandids) { -% $results_head->(); - -<& routetrade, islandids => \@islandids, archipelagoes => \@archipelagoes &> - +% $someresults->(); +<& routetrade, + dbh => $dbh, + islandids => \@islandids, + archipelagoes => \@archipelagoes, + qa => $qa, + routeparams => $routeparams + &> % } +