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>
90 <a href="<% $m->current_comp()->name() |u %>">YARRG</a> -
91 Yet Another Revenue Research Gatherer
93 <a href="docs">documentation</a>
98 foreach my $var (@vars) {
99 my $lname= lc $var->{Name};
100 next unless exists $ARGS{$lname};
101 $baseqf{$lname}= $ARGS{$lname};
105 foreach my $var (keys %ARGS) {
107 m/^(?:routestring|islandid\d|archipelago\d|debug)$/;
108 my $val= $ARGS{$var};
109 next if $val eq 'none';
110 $queryqf{$var}= $val;
114 my $uri= URI->new('lookup');
115 $uri->query_form(@_);
119 foreach my $var (@vars) {
120 my $name= $var->{Name};
121 my $lname= lc $var->{Name};
122 my $delim= $var->{Before};
123 my $canon= &{$var->{CmpCanon}}($a{$name});
125 foreach my $valr (@{ $var->{Values} }) {
126 print $delim; $delim= "\n|\n";
127 my ($value,$html) = @$valr;
128 my $iscurrent= &{$var->{CmpCanon}}($value) eq $canon;
134 my %qf= (%baseqf,%queryqf);
136 $qf{$lname}= $value if $cvalix;
138 <a href="<% $quri->(%qf) |h %>">
148 #---------- initial checks, startup, main entry form ----------
150 dbw_connect($a{Ocean});
160 %########### query `route' ##########
161 % if ($a{Query} eq 'route') {
163 <h1>Specify route</h1>
164 <form action="<% $quri->() |h %>" method="get">
166 %#---------- textbox, user enters route as string ----------
167 % if (!$a{Dropdowns}) {
169 Enter route (islands, or archipelagoes, separated by |s or commas;
170 abbreviations are OK):<br>
173 tr_uri= "routetextstring?format=json&type=text/xml"
174 + "&ocean=<% uri_escape($a{Ocean}) %>";
181 window.clearTimeout(tr_timeout);
182 tr_timeout = window.setTimeout(tr_Needed, 500);
184 function tr_Needed(){
185 window.clearTimeout(tr_timeout);
186 tr_element= document.getElementById('routestring');
187 tr_needed= tr_element.value;
190 function tr_Request(){
191 if (tr_request || tr_needed==tr_done) return;
193 tr_request= new XMLHttpRequest();
194 uri= tr_uri+'&string='+encodeURIComponent(tr_needed);
195 tr_request.open('GET', uri);
196 tr_request.onreadystatechange= tr_Ready;
197 tr_request.send(null);
199 function tr_Ready() {
200 if (tr_request.readyState != 4) return;
201 if (tr_request.status == 200) {
202 response= tr_request.responseText;
203 eval('results='+response);
204 toedit= document.getElementById('routeresults');
205 toedit.innerHTML= results.show;
210 window.onload= tr_Needed;
213 <input type="text" id="routestring" name="routestring" size=80
214 value="<% $routestring |h %>"
215 onchange="tr_Needed();"
216 onkeyup="tr_Later();"><br>
217 <div id="routeresults"> </div><br>
219 % } else { #---------- dropdowns, user selects from menus ----------
225 $islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
227 my $optionlistmap= sub {
228 my ($optlist, $selected) = @_;
230 foreach my $entry (@$optlist) {
231 $out.= sprintf('<option value="%s" %s>%s</option>',
232 encode_entities($entry->[0]),
233 defined $selected && $entry->[0] eq $selected
235 encode_entities($entry->[1]));
240 my $dbh= dbw_connect($a{Ocean});
242 $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
243 ORDER BY archipelago;");
246 while ($row=$sth->fetchrow_arrayref) {
248 push @archlistdata, [ $arch, $arch ];
249 $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
252 $sth= $dbh->prepare("SELECT islandid,islandname,archipelago
254 ORDER BY islandname;");
257 while ($row=$sth->fetchrow_arrayref) {
259 push @{ $islandlistdata{'none'} }, [ @$row ];
260 push @{ $islandlistdata{$arch} }, [ @$row ];
261 $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
264 my %resetislandlistdata;
265 foreach my $arch (keys %islandlistdata) {
266 $resetislandlistdata{$arch}=
267 $optionlistmap->($islandlistdata{$arch}, '');
272 <input type=hidden name=dropdowns value="<% $a{Dropdowns} |h %>">
275 ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
276 function ms_Setarch(dd) {
277 debug('ms_SetArch '+dd+' arch='+arch);
278 var arch= document.getElementsByName('archipelago'+dd).item(0).value;
279 var got= ms_lists[arch];
280 if (got == undefined) return; // unknown arch ? hrm
281 debug('ms_SetArch '+dd+' arch='+arch+' got ok');
282 var select= document.getElementsByName('islandid'+dd).item(0);
283 select.innerHTML= got;
284 debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
288 <table style="table-layout:fixed; width:90%;">
291 % for my $dd (0..$a{Dropdowns}-1) {
293 <select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
294 <option value="none">Whole ocean</option>
295 <% $optionlistmap->(\@archlistdata, $ARGS{"archipelago$dd"}) %></select></td>
300 % for my $dd (0..$a{Dropdowns}-1) {
301 % my $arch= $ARGS{"archipelago$dd"};
302 % $arch= 'none' if !defined $arch;
304 <select name="islandid<% $dd %>">
305 <% $optionlistmap->($islandlistdata{$arch}, $ARGS{"islandid$dd"}) %>
312 % } #---------- end of dropdowns, now common middle of page code ----------
314 <input type=submit name=submit value="Go">
318 #========== result computations ==========
322 print "<h1>Results</h1>\n";
323 $results_head= sub { };
326 #---------- result computation - textstring ----------
327 if (!$a{Dropdowns}) {
328 if (length $routestring) {
330 my $rsr= $m->comp('routetextstring',
332 string => $routestring,
335 if (length $rsr->{Error}) {
336 print encode_entities($rsr->{Error});
338 foreach my $entry (@{ $rsr->{Results} }) {
340 defined $entry->[1] ? undef : $entry->[0];
341 push @islandids, $entry->[1];
346 } else { #---------- results - dropdowns ----------
348 my $argorundef= sub {
350 my $thing= $ARGS{"${base}${dd}"};
351 $thing= undef if defined $thing and $thing eq 'none';
355 for my $dd (0..$a{Dropdowns}-1) {
356 my $arch= $argorundef->($dd,'archipelago');
357 my $island= $argorundef->($dd,'islandid');
358 next unless defined $arch or defined $island;
359 if (defined $island and defined $arch) {
360 my $ii= $islandid2{$island};
361 my $iarch= $ii->{Arch};
362 if ($iarch ne $arch) {
365 Specified archipelago <% $arch %> but
366 island <% $ii->{Name} %>
367 which is in <% $iarch %>; using the island.<br>
372 push @archipelagoes, $arch;
373 push @islandids, $island;
376 }#---------- result processing, common stuff
382 <& routetrade, islandids => \@islandids, archipelagoes => \@archipelagoes &>
386 % } elsif ($a{Query} eq 'age') {
387 % ########### query `age' ##########
389 <h1>Market data age</h1>
390 <& dataage, %baseqf, %queryqf &>
392 % } ########## end of `age' query ##########
394 %#---------- debugging and epilogue ----------
406 var node= document.getElementById('debug_log');
407 node.innerHTML += "\n" + m + "\n";