3 This is part of the YARRG website. YARRG is a tool and website
4 for assisting players of Yohoho Puzzle Pirates.
6 Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
7 Copyright (C) 2009 Clare Boothby
9 YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
10 The YARRG website is covered by the GNU Affero GPL v3 or later, which
11 basically means that every installation of the website will let you
14 This program is free software: you can redistribute it and/or modify
15 it under the terms of the GNU Affero General Public License as
16 published by the Free Software Foundation, either version 3 of the
17 License, or (at your option) any later version.
19 This program is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU Affero General Public License for more details.
24 You should have received a copy of the GNU Affero General Public License
25 along with this program. If not, see <http://www.gnu.org/licenses/>.
27 Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
28 are used without permission. This program is not endorsed or
29 sponsored by Three Rings.
32 This Mason component generates the main `lookup' page, including
33 all the entry boxes etc. for every query.
47 #---------- "mode" argument parsing and mode menu at top of page ----------
49 # for debugging, invoke as
50 # http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/pirate-route?debug=1
52 @vars= ({ Name => 'Ocean',
54 CmpCanon => sub { ucfirst lc $_[0] },
55 Values => [ ocean_list() ]
56 }, { Name => 'Dropdowns',
57 Before => 'Interface: ',
58 CmpCanon => sub { !!$_[0] },
59 Values => [ [ 0, 'Type in names' ],
60 [ 4, 'Select from menus' ] ]
63 Values => [ [ 'route', 'Trades for route' ],
64 [ 'age', 'Data age' ] ]
67 foreach my $var (@vars) {
68 my $name= $var->{Name};
70 $var->{Before}= '' unless exists $var->{Before};
71 $var->{CmpCanon}= sub { $_[0]; } unless exists $var->{CmpCanon};
72 foreach my $val (@{ $var->{Values} }) {
74 $val= [ $val, encode_entities($val) ];
76 if (exists $ARGS{$lname}) {
77 $a{$name}= $ARGS{$lname};
78 my @html= grep { $_->[0] eq $a{$name} } @{ $var->{Values} };
79 $ahtml{$name}= @html==1 ? $html[0][1] : '???';
81 $a{$name}= $var->{Values}[0][0];
82 $ahtml{$name}= $var->{Values}[0][1];
87 <html><head><title><% ucfirst $ahtml{Query} %> - YARRG</title></head><body>
89 <a href="<% $m->current_comp()->name() |u %>">YARRG</a> -
90 Yet Another Revenue Research Gatherer
92 <a href="docs">documentation</a>
97 foreach my $var (@vars) {
98 my $lname= lc $var->{Name};
99 next unless exists $ARGS{$lname};
100 $baseqf{$lname}= $ARGS{$lname};
104 foreach my $var (keys %ARGS) {
106 m/^(?:routestring|islandid\d|archipelago\d|debug)$/;
107 my $val= $ARGS{$var};
108 next if $val eq 'none';
109 $queryqf{$var}= $val;
113 my $uri= URI->new('lookup');
114 $uri->query_form(@_);
118 foreach my $var (@vars) {
119 my $name= $var->{Name};
120 my $lname= lc $var->{Name};
121 my $delim= $var->{Before};
122 my $canon= &{$var->{CmpCanon}}($a{$name});
124 foreach my $valr (@{ $var->{Values} }) {
125 print $delim; $delim= "\n|\n";
126 my ($value,$html) = @$valr;
127 my $iscurrent= &{$var->{CmpCanon}}($value) eq $canon;
133 my %qf= (%baseqf,%queryqf);
135 $qf{$lname}= $value if $cvalix;
137 <a href="<% $quri->(%qf) |h %>">
147 #---------- initial checks, startup, main entry form ----------
149 dbw_connect($a{Ocean});
159 %########### query `route' ##########
160 % if ($a{Query} eq 'route') {
162 <h1>Specify route</h1>
163 <form action="<% $quri->() |h %>" method="get">
165 %#---------- textbox, user enters route as string ----------
166 % if (!$a{Dropdowns}) {
168 Enter route (islands, or archipelagoes, separated by |s or commas;
169 abbreviations are OK):<br>
172 tr_uri= "routetextstring?format=json&type=text/xml"
173 + "&ocean=<% uri_escape($a{Ocean}) %>";
180 window.clearTimeout(tr_timeout);
181 tr_timeout = window.setTimeout(tr_Needed, 500);
183 function tr_Needed(){
184 window.clearTimeout(tr_timeout);
185 tr_element= document.getElementById('routestring');
186 tr_needed= tr_element.value;
189 function tr_Request(){
190 if (tr_request || tr_needed==tr_done) return;
192 tr_request= new XMLHttpRequest();
193 uri= tr_uri+'&string='+encodeURIComponent(tr_needed);
194 tr_request.open('GET', uri);
195 tr_request.onreadystatechange= tr_Ready;
196 tr_request.send(null);
198 function tr_Ready() {
199 if (tr_request.readyState != 4) return;
200 if (tr_request.status == 200) {
201 response= tr_request.responseText;
202 eval('results='+response);
203 toedit= document.getElementById('routeresults');
204 toedit.innerHTML= results.show;
209 window.onload= tr_Needed;
212 <input type="text" id="routestring" name="routestring" size=80
213 value="<% $routestring |h %>"
214 onchange="tr_Needed();"
215 onkeyup="tr_Later();"><br>
216 <div id="routeresults"> </div><br>
218 % } else { #---------- dropdowns, user selects from menus ----------
224 $islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
226 my $optionlistmap= sub {
227 my ($optlist, $selected) = @_;
229 foreach my $entry (@$optlist) {
230 $out.= sprintf('<option value="%s" %s>%s</option>',
231 encode_entities($entry->[0]),
232 defined $selected && $entry->[0] eq $selected
234 encode_entities($entry->[1]));
239 my $dbh= dbw_connect($a{Ocean});
241 $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
242 ORDER BY archipelago;");
245 while ($row=$sth->fetchrow_arrayref) {
247 push @archlistdata, [ $arch, $arch ];
248 $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
251 $sth= $dbh->prepare("SELECT islandid,islandname,archipelago
253 ORDER BY islandname;");
256 while ($row=$sth->fetchrow_arrayref) {
258 push @{ $islandlistdata{'none'} }, [ @$row ];
259 push @{ $islandlistdata{$arch} }, [ @$row ];
260 $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
263 my %resetislandlistdata;
264 foreach my $arch (keys %islandlistdata) {
265 $resetislandlistdata{$arch}=
266 $optionlistmap->($islandlistdata{$arch}, '');
271 <input type=hidden name=dropdowns value="<% $a{Dropdowns} |h %>">
274 ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
275 function ms_Setarch(dd) {
276 debug('ms_SetArch '+dd+' arch='+arch);
277 var arch= document.getElementsByName('archipelago'+dd).item(0).value;
278 var got= ms_lists[arch];
279 if (got == undefined) return; // unknown arch ? hrm
280 debug('ms_SetArch '+dd+' arch='+arch+' got ok');
281 var select= document.getElementsByName('islandid'+dd).item(0);
282 select.innerHTML= got;
283 debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
287 <table style="table-layout:fixed; width:90%;">
290 % for my $dd (0..$a{Dropdowns}-1) {
292 <select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
293 <option value="none">Whole ocean</option>
294 <% $optionlistmap->(\@archlistdata, $ARGS{"archipelago$dd"}) %></select></td>
299 % for my $dd (0..$a{Dropdowns}-1) {
300 % my $arch= $ARGS{"archipelago$dd"};
301 % $arch= 'none' if !defined $arch;
303 <select name="islandid<% $dd %>">
304 <% $optionlistmap->($islandlistdata{$arch}, $ARGS{"islandid$dd"}) %>
311 % } #---------- end of dropdowns, now common middle of page code ----------
313 <input type=submit name=submit value="Go">
317 #========== result computations ==========
321 print "<h1>Results</h1>\n";
322 $results_head= sub { };
325 #---------- result computation - textstring ----------
326 if (!$a{Dropdowns}) {
327 if (length $routestring) {
329 my $rsr= $m->comp('routetextstring',
331 string => $routestring,
334 if (length $rsr->{Error}) {
335 print encode_entities($rsr->{Error});
337 foreach my $entry (@{ $rsr->{Results} }) {
339 defined $entry->[1] ? undef : $entry->[0];
340 push @islandids, $entry->[1];
345 } else { #---------- results - dropdowns ----------
347 my $argorundef= sub {
349 my $thing= $ARGS{"${base}${dd}"};
350 $thing= undef if defined $thing and $thing eq 'none';
354 for my $dd (0..$a{Dropdowns}-1) {
355 my $arch= $argorundef->($dd,'archipelago');
356 my $island= $argorundef->($dd,'islandid');
357 next unless defined $arch or defined $island;
358 if (defined $island and defined $arch) {
359 my $ii= $islandid2{$island};
360 my $iarch= $ii->{Arch};
361 if ($iarch ne $arch) {
364 Specified archipelago <% $arch %> but
365 island <% $ii->{Name} %>
366 which is in <% $iarch %>; using the island.<br>
371 push @archipelagoes, $arch;
372 push @islandids, $island;
375 }#---------- result processing, common stuff
381 <& routetrade, islandids => \@islandids, archipelagoes => \@archipelagoes &>
385 % } elsif ($a{Query} eq 'age') {
386 % ########### query `age' ##########
388 <h1>Market data age</h1>
389 <& dataage, %baseqf, %queryqf &>
391 % } ########## end of `age' query ##########
393 %#---------- debugging and epilogue ----------
405 var node= document.getElementById('debug_log');
406 node.innerHTML += "\n" + m + "\n";