From db998ff5d636967de9de9218ff0b940a4feb9a6d Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 20 Sep 2009 20:15:19 +0100 Subject: [PATCH 1/1] New query_offers query; actual implementation TBD --- yarrg/web/enter_commod | 4 +- yarrg/web/enter_route | 4 +- yarrg/web/lookup | 1 + yarrg/web/query_offers | 97 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 102 insertions(+), 4 deletions(-) create mode 100644 yarrg/web/query_offers diff --git a/yarrg/web/enter_commod b/yarrg/web/enter_commod index 666f625..c3f5553 100644 --- a/yarrg/web/enter_commod +++ b/yarrg/web/enter_commod @@ -47,8 +47,8 @@ $cmid_r Enter commodity (abbreviations are OK):
-<&| qtextstring, qa => $qa, dbh => $dbh, - thingstring => 'commodstring', emsgstore => $emsg_r, +<&| qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r, + thingstring => 'commodstring', prefix => 'cm', onresults => sub { ($$commodname_r,$$cmid_r)= @{ $_[0] } if @_ } &> size=80 diff --git a/yarrg/web/enter_route b/yarrg/web/enter_route index f4ad1d7..c21d967 100644 --- a/yarrg/web/enter_route +++ b/yarrg/web/enter_route @@ -51,8 +51,8 @@ $archipelagoes_r <% $enterwhat %> (islands, or archipelagoes, separated by |s or commas; abbreviations are OK):
-<&| qtextstring, qa => $qa, dbh => $dbh, - thingstring => 'routestring', emsgstore => $emsg_r, +<&| qtextstring, qa => $qa, dbh => $dbh, emsgstore => $emsg_r, + thingstring => 'routestring', prefix => 'rl', onresults => sub { foreach (@_) { my ($canonname, $island, $arch) = @$_; diff --git a/yarrg/web/lookup b/yarrg/web/lookup index 371bbb2..ec72a6e 100755 --- a/yarrg/web/lookup +++ b/yarrg/web/lookup @@ -57,6 +57,7 @@ my %styles; Before => 'Query: ', Values => [ [ 'route', 'Trades for route' ], [ 'commod', 'Prices for commodity' ], + [ 'offers', 'Offers at location' ], [ 'age', 'Data age' ] ] }, { Name => 'BuySell', Before => '', diff --git a/yarrg/web/query_offers b/yarrg/web/query_offers new file mode 100644 index 0000000..47c3555 --- /dev/null +++ b/yarrg/web/query_offers @@ -0,0 +1,97 @@ +<%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 `offers' query. + + + +<%args> +$quri +$dbh +$commodid => undef; +$commodstring => ''; +$islandid => undef; +$prselector +$someresults +$emsgokorprint + + +<%perl> +my $emsg; +my @warningfs; +my @islandids; +my @archipelagoes; +my ($commodname,$cmid); + +my $qa= \%ARGS; + + +

Prices for commodity at location(s)

+ +% $prselector->('BuySell'); + +
+ +<& enter_commod, qa => $qa, dbh => $dbh, emsg_r => \$emsg, + commodname_r => \$commodname, + cmid_r => \$cmid + &> + +<& enter_route, qa => $qa, dbh => $dbh, emsg_r => \$emsg, + warningfs_r => \@warningfs, + enterwhat => 'Enter location', + islandids_r => \@islandids, + archipelagoes_r => \@archipelagoes + &> + + +% my $ours= sub { $_[0] =~ +% m/^commodstring|^commodid|^routestring|^archipelago|^island/; +% }; +<& "lookup:formhidden", ours => $ours &> + +
+ +%#========== results ========== +<%perl> + +$emsgokorprint->($emsg) or $cmid=undef; +return unless defined $cmid and @islandids; + +foreach my $wf (@warningfs) { $wf->(); } + + +
+NOT YET IMPLEMENTED
+
+cmdid= <% $cmid %>
+islandids= <% join ',', map { defined($_) ? $_ : 'U' } @islandids %>
+
-- 2.30.2