From 13b9f206d92634f4e6f4a940ed31690c1235d827 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 20 Sep 2009 19:59:51 +0100 Subject: [PATCH] Break out generation of commodity and route form entry boxes into enter_* components --- yarrg/web/enter_commod | 72 ++++++++++++++ yarrg/web/enter_route | 190 +++++++++++++++++++++++++++++++++++++ yarrg/web/qtextstringcheck | 2 +- yarrg/web/query_commod | 30 +----- yarrg/web/query_route | 161 +++++-------------------------- 5 files changed, 288 insertions(+), 167 deletions(-) create mode 100644 yarrg/web/enter_commod create mode 100644 yarrg/web/enter_route diff --git a/yarrg/web/enter_commod b/yarrg/web/enter_commod new file mode 100644 index 0000000..2ccc9ab --- /dev/null +++ b/yarrg/web/enter_commod @@ -0,0 +1,72 @@ +<%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 form contents for selecting a commodity. + + + +<%args> +$qa +$dbh +$emsg_r + +$commodname_r +$cmid_r + + +%#---------- textbox, user enters commodity as string ---------- +% if (!$qa->{Dropdowns}) { + +Enter commodity (abbreviations are OK):
+ +<&| qtextstring, qa => $qa, dbh => $dbh, + thingstring => 'commodstring', emsgstore => $emsg_r, + onresults => sub { ($$commodname_r,$$cmid_r)= @{ $_[0] } if @_ } + &> + size=80 + + +% } else { #---------- dropdowns, user selects from menus ---------- + +% my $sth= $dbh->prepare("SELECT commodname,commodid FROM commods +% ORDER BY commodname"); +% $sth->execute(); +% my $row; + + +% } #---------- end of dropdowns, now common middle of page code ---------- diff --git a/yarrg/web/enter_route b/yarrg/web/enter_route new file mode 100644 index 0000000..58b29f4 --- /dev/null +++ b/yarrg/web/enter_route @@ -0,0 +1,190 @@ +<%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 form contents for selecting a list + of locations (eg, a route). + + + +<%args> +$qa +$dbh +$emsg_r +$warningfs_r + +$enterwhat +$islandids_r +$archipelagoes_r + + +%#---------- textbox, user enters route as string ---------- +% if (!$qa->{Dropdowns}) { + +<% $enterwhat %> (islands, or archipelagoes, separated by |s or commas; + abbreviations are OK):
+ +<&| qtextstring, qa => $qa, dbh => $dbh, + thingstring => 'routestring', emsgstore => $emsg_r, + onresults => sub { + foreach (@_) { + my ($canonname, $island, $arch) = @$_; + push @$islandids_r, $island; + push @$archipelagoes_r, defined $island ? undef : $arch; + } + } + &> + size=80 + + +% } else { #---------- dropdowns, user selects from menus ---------- + +<%perl> +my %islandid2; +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; +}; + +$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}, ''); +} + + + +<&| 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= $qa->{"archipelago$dd"}; +% $arch= 'none' if !defined $arch; + +% } + + +
+
+
+ +<%perl> + +my $argorundef= sub { + my ($dd,$base) = @_; + my $thing= $qa->{"${base}${dd}"}; + $thing= undef if defined $thing and $thing eq 'none'; + return $thing; +}; + +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) { + push @$warningfs_r, sub { + + Specified archipelago <% $arch %> but + island <% $ii->{Name} %> + which is in <% $iarch %>; using the island.

+<%perl> + }; + } + $arch= undef; + } + push @$archipelagoes_r, $arch; + push @$islandids_r, $island; +} + + + +% } diff --git a/yarrg/web/qtextstringcheck b/yarrg/web/qtextstringcheck index 4adb606..3b4fdd7 100755 --- a/yarrg/web/qtextstringcheck +++ b/yarrg/web/qtextstringcheck @@ -95,7 +95,7 @@ if ($chk->method_exists('execute')) { my $sqlstmt_nqs= @sqlstmt_nqs; my @specs= $chk->attr('multiple') - ? (split m#[/|,]#, $string) + ? (split m#\s*[/|,]\s*#, $string) : ($string); foreach my $each (@specs) { diff --git a/yarrg/web/query_commod b/yarrg/web/query_commod index 81e8208..5db6330 100644 --- a/yarrg/web/query_commod +++ b/yarrg/web/query_commod @@ -57,34 +57,10 @@ my $qa= \%ARGS;

-%#---------- textbox, user enters route as string ---------- -% if (!$qa->{Dropdowns}) { - -Enter commodity (abbreviations are OK):
- -<&| qtextstring, qa => $qa, dbh => $dbh, - thingstring => 'commodstring', emsgstore => \$emsg, - onresults => sub { ($commodname,$cmid)= @{ $_[0] }; } +<& enter_commod, qa => $qa, dbh => $dbh, emsg_r => \$emsg, + commodname_r => \$commodname, + cmid_r => \$cmid &> - size=80 - - -% } else { #---------- dropdowns, user selects from menus ---------- - -% my $sth= $dbh->prepare("SELECT commodname,commodid FROM commods -% ORDER BY commodname"); -% $sth->execute(); -% my $row; - - -% } #---------- end of dropdowns, now common middle of page code ---------- % my $ours= sub { $_[0] =~ m/^commodstring|^commodid/; }; diff --git a/yarrg/web/query_route b/yarrg/web/query_route index 8b491d9..26b83a5 100644 --- a/yarrg/web/query_route +++ b/yarrg/web/query_route @@ -47,9 +47,9 @@ $emsgokorprint <%perl> my $emsg; +my @warningfs; my @archipelagoes; my @islandids; -my %islandid2; my ($max_volume, $max_mass); my $lossperleaguepct; my $capital; @@ -69,28 +69,28 @@ my $goupdate= sub { $be_post ? 'Update' : 'Go' };

Specify route

-% $prselector->('ShowStalls'); - -%#---------- textbox, user enters route as string ---------- +% # 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)); +% } -Enter route (islands, or archipelagoes, separated by |s or commas; - abbreviations are OK):
+% $prselector->('ShowStalls'); -% $startform->($routestring =~ m/\S/); +<& enter_route, qa => $qa, dbh => $dbh, emsg_r => \$emsg, + warningfs_r => \@warningfs, + enterwhat => 'Enter route', + islandids_r => \@islandids, + archipelagoes_r => \@archipelagoes +&> -<&| qtextstring, qa => $qa, dbh => $dbh, - thingstring => 'routestring', emsgstore => \$emsg, - onresults => sub { - foreach (@_) { - my ($canonname, $island, $arch) = @$_; - push @islandids, $island; - push @archipelagoes, defined $island ? undef : $arch; - } - } - &> - size=80 - +%#---------- textboxes, user enters details as strings ---------- +% if (!$qa->{Dropdowns}) { Advanced options - you may leave these blank:

@@ -137,100 +137,6 @@ Expected losses: -% } else { #---------- dropdowns, user selects from menus ---------- - -% $startform->(grep { -% defined $ARGS{"archipelago$_"} || -% defined $ARGS{"islandid$_"} -% } (0..$qa->{Dropdowns}-1)); - -<%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; -}; - -$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}, ''); -} - - - -<&| 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; - -% } - - -
-
-
- % } #---------- end of dropdowns, now common middle of page code ---------- @@ -244,32 +150,9 @@ function ms_Setarch(dd) { $emsgokorprint->($emsg) or @islandids=(); -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..$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) { - $someresults->(); - - 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->(); } -- 2.30.2