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;
137 print '<a href="',$quri->(%qf),'">';
146 #---------- initial checks, startup, main entry form ----------
148 dbw_connect($a{Ocean});
158 %########### query `route' ##########
159 % if ($a{Query} eq 'route') {
161 <h1>Specify route</h1>
162 <form action="<% $quri->() %>" method="get">
164 %#---------- textbox, user enters route as string ----------
165 % if (!$a{Dropdowns}) {
167 Enter route (islands, or archipelagoes, separated by |s or commas;
168 abbreviations are OK):<br/>
170 <script type="text/javascript">
171 tr_uri= "routetextstring?format=json&type=text/xml"
172 + "&ocean=<% uri_escape($a{Ocean}) %>";
179 window.clearTimeout(tr_timeout);
180 tr_timeout = window.setTimeout(tr_Needed, 500);
182 function tr_Needed(){
183 window.clearTimeout(tr_timeout);
184 tr_element= document.getElementById('routestring');
185 tr_needed= tr_element.value;
188 function tr_Request(){
189 if (tr_request || tr_needed==tr_done) return;
191 tr_request= new XMLHttpRequest();
192 uri= tr_uri+'&string='+encodeURIComponent(tr_needed);
193 tr_request.open('GET', uri);
194 tr_request.onreadystatechange= tr_Ready;
195 tr_request.send(null);
197 function tr_Ready() {
198 if (tr_request.readyState != 4) return;
199 if (tr_request.status == 200) {
200 response= tr_request.responseText;
201 eval('results='+response);
202 toedit= document.getElementById('routeresults');
203 toedit.innerHTML= results.show;
208 window.onload= tr_Needed;
211 <input type="text" id="routestring" name="routestring" size=80
212 value="<% $routestring |h %>"
213 onchange="tr_Needed();"
214 onkeyup="tr_Later();"><br>
215 <div id="routeresults"> </div><br/>
217 % } else { #---------- dropdowns, user selects from menus ----------
223 $islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
225 my $optionlistmap= sub {
226 my ($optlist, $selected) = @_;
228 foreach my $entry (@$optlist) {
229 $out.= sprintf('<option value="%s" %s>%s</option>',
230 encode_entities($entry->[0]),
231 defined $selected && $entry->[0] eq $selected
233 encode_entities($entry->[1]));
238 my $dbh= dbw_connect($a{Ocean});
240 $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
241 ORDER BY archipelago;");
244 while ($row=$sth->fetchrow_arrayref) {
246 push @archlistdata, [ $arch, $arch ];
247 $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
250 $sth= $dbh->prepare("SELECT islandid,islandname,archipelago
252 ORDER BY islandname;");
255 while ($row=$sth->fetchrow_arrayref) {
257 push @{ $islandlistdata{'none'} }, [ @$row ];
258 push @{ $islandlistdata{$arch} }, [ @$row ];
259 $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch };
262 my %resetislandlistdata;
263 foreach my $arch (keys %islandlistdata) {
264 $resetislandlistdata{$arch}=
265 $optionlistmap->($islandlistdata{$arch}, '');
270 <input type=hidden name=dropdowns value="<% $a{Dropdowns} |h %>">
272 <script type="text/javascript">
273 ms_lists= <% to_json(\%resetislandlistdata) %>;
274 function ms_Setarch(dd) {
275 debug('ms_SetArch '+dd+' arch='+arch);
276 var arch= document.getElementsByName('archipelago'+dd).item(0).value;
277 var got= ms_lists[arch];
278 if (got == undefined) return; // unknown arch ? hrm
279 debug('ms_SetArch '+dd+' arch='+arch+' got ok');
280 var select= document.getElementsByName('islandid'+dd).item(0);
281 select.innerHTML= got;
282 debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
286 <table style="table-layout:fixed; width:90%;">
289 % for my $dd (0..$a{Dropdowns}-1) {
291 <select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
292 <option value="none">Whole ocean</option>
293 <% $optionlistmap->(\@archlistdata, $ARGS{"archipelago$dd"}) %></select></td>
298 % for my $dd (0..$a{Dropdowns}-1) {
299 % my $arch= $ARGS{"archipelago$dd"};
300 % $arch= 'none' if !defined $arch;
302 <select name="islandid<% $dd %>">
303 <% $optionlistmap->($islandlistdata{$arch}, $ARGS{"islandid$dd"}) %>
310 % } #---------- end of dropdowns, now common middle of page code ----------
312 <input type=submit name=submit value="Go">
316 #========== result computations ==========
320 print "<h1>Results</h1>\n";
321 $results_head= sub { };
324 #---------- result computation - textstring ----------
325 if (!$a{Dropdowns}) {
326 if (length $routestring) {
328 my $rsr= $m->comp('routetextstring',
330 string => $routestring,
333 if (length $rsr->{Error}) {
334 print encode_entities($rsr->{Error});
336 foreach my $entry (@{ $rsr->{Results} }) {
338 defined $entry->[1] ? undef : $entry->[0];
339 push @islandids, $entry->[1];
344 } else { #---------- results - dropdowns ----------
346 my $argorundef= sub {
348 my $thing= $ARGS{"${base}${dd}"};
349 $thing= undef if defined $thing and $thing eq 'none';
353 for my $dd (0..$a{Dropdowns}-1) {
354 my $arch= $argorundef->($dd,'archipelago');
355 my $island= $argorundef->($dd,'islandid');
356 next unless defined $arch or defined $island;
357 if (defined $island and defined $arch) {
358 my $ii= $islandid2{$island};
359 my $iarch= $ii->{Arch};
360 if ($iarch ne $arch) {
363 Specified archipelago <% $arch %> but
364 island <% $ii->{Name} %>
365 which is in <% $iarch %>; using the island.<br>
370 push @archipelagoes, $arch;
371 push @islandids, $island;
374 }#---------- result processing, common stuff
380 <& routetrade, islandids => \@islandids, archipelagoes => \@archipelagoes &>
384 % } elsif ($a{Query} eq 'age') {
385 % ########### query `age' ##########
387 <h1>Market data age</h1>
388 <& dataage, %baseqf, %queryqf &>
390 % } ########## end of `age' query ##########
392 %#---------- debugging and epilogue ----------
401 <script type="text/javascript">
404 var node= document.getElementById('debug_log');
405 node.innerHTML += "\n" + m + "\n";