yarrg/web/route

   1 <html><head><title>Specify route</title></head><body>
   2
   3 <%perl>
   4 my %a;
   5 my @vars;
   6
   7 #---------- "mode" argument parsing and mode menu at top of page ----------
   8
   9 # for debugging, invoke as
  10 #  http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/pirate-route?debug=1
  11
  12 @vars= ({       Name => 'Ocean',
  13                 Before => 'Ocean: ',
  14                 CmpCanon => sub { ucfirst lc $_[0] },
  15                 Values => [ ocean_list() ]
  16         }, {    Name => 'Dropdowns',
  17                 Before => 'Interface: ',
  18                 CmpCanon => sub { !!$_[0] },
  19                 Values => [     [ 0, 'Type in names' ],
  20                                 [ 4, 'Select from menus' ] ]
  21         });
  22
  23 foreach my $var (@vars) {
  24         my $name= $var->{Name};
  25         my $lname= lc $name;
  26         $var->{Before}= '' unless exists $var->{Before};
  27         $var->{CmpCanon}= sub { $_[0]; } unless exists $var->{CmpCanon};
  28         foreach my $val (@{ $var->{Values} }) {
  29                 next if ref $val;
  30                 $val= [ $val, encode_entities($val) ];
  31         }
  32         if (exists $ARGS{$lname}) {
  33                 $a{$name}= $ARGS{$lname};
  34         } else {
  35                 $a{$name}= $var->{Values}[0][0];
  36         }
  37 }
  38
  39 my %baseqf;
  40 foreach my $var (@vars) {
  41         my $lname= lc $var->{Name};
  42         next unless exists $ARGS{$lname};
  43         $baseqf{$lname}= $ARGS{$lname};
  44 }
  45
  46 my %queryqf;
  47 foreach my $var (keys %ARGS) {
  48         next unless $var =~
  49                 m/^(?:routestring|islandid\d|archipelago\d|debug)$/;
  50         $queryqf{$var}= $ARGS{$var};
  51 }
  52
  53 my $uri= URI->new($m->current_comp()->name());
  54 my $quri= sub { $uri->query_form(@_); $uri->path_query(); };
  55
  56 foreach my $var (@vars) {
  57         my $name= $var->{Name};
  58         my $lname= lc $var->{Name};
  59         my $delim= $var->{Before};
  60         my $canon= &{$var->{CmpCanon}}($a{$name});
  61         my $cvalix= 0;
  62         foreach my $valr (@{ $var->{Values} }) {
  63                 print $delim;  $delim= "\n|\n";
  64                 my ($value,$html) = @$valr;
  65                 my $iscurrent= &{$var->{CmpCanon}}($value) eq $canon;
  66                 my $after;
  67                 if ($iscurrent) {
  68                         print '<b>';
  69                         $after= '</b>';
  70                 } else {
  71                         my %qf= (%baseqf,%queryqf);
  72                         delete $qf{$lname};
  73                         $qf{$lname}= $value if $cvalix;
  74                         print '<a href="',&$quri(%qf),'">';
  75                         $after= '</a>';
  76                 }
  77                 print $html, $after;
  78                 $cvalix++;
  79         }
  80         print "<p>\n\n";
  81 }
  82
  83 #---------- initial checks, startup, main entry form ----------
  84
  85 die "unknown ocean $a{Ocean} ?"
  86         unless grep { $_ eq $a{Ocean} } ocean_list();
  87
  88 db_setocean($a{Ocean});
  89 db_connect();
  90
  91 </%perl>
  92 <%args>
  93 $debug => 0
  94 $routestring => ''
  95 </%args>
  96
  97 <h1>Specify route</h1>
  98 <form action="<% &$quri() %>" method="get">
  99
 100 %#---------- textbox, user enters route as string ----------
 101 % if (!$a{Dropdowns}) {
 102
 103 Enter route (islands, or archipelagoes, separated by |s or commas;
 104  abbreviations are OK):<br/>
 105
 106 <script type="text/javascript">
 107 tr_uri= "routetextstring?format=json&type=text/xml"
 108                 + "&ocean=<% uri_escape($a{Ocean}) %>";
 109
 110 tr_timeout=false;
 111 tr_request=false;
 112 tr_done='';
 113 tr_needed='';
 114 function tr_Later(){
 115   window.clearTimeout(tr_timeout);
 116   tr_timeout = window.setTimeout(tr_Needed, 500);
 117 }
 118 function tr_Needed(){
 119   window.clearTimeout(tr_timeout);
 120   tr_element= document.getElementById('routestring');
 121   tr_needed= tr_element.value;
 122   tr_Request();
 123 }
 124 function tr_Request(){
 125   if (tr_request || tr_needed==tr_done) return;
 126   tr_done= tr_needed;
 127   tr_request= new XMLHttpRequest();
 128   uri= tr_uri+'&string='+encodeURIComponent(tr_needed);
 129   tr_request.open('GET', uri);
 130   tr_request.onreadystatechange= tr_Ready;
 131   tr_request.send(null);
 132 }
 133 function tr_Ready() {
 134   if (tr_request.readyState != 4) return;
 135   if (tr_request.status == 200) {
 136     response= tr_request.responseText;
 137     eval('results='+response);
 138     toedit= document.getElementById('routeresults');
 139     toedit.innerHTML= results.show;
 140   }
 141   tr_request= false;
 142   tr_Request();
 143 }
 144 </script>
 145
 146 <input type="text" id="routestring" name="routestring" size=80
 147  value="<% $routestring |h %>"
 148  onchange="tr_Needed();"
 149  onkeyup="tr_Later();"><br>
 150 <div id="routeresults">&nbsp;</div><br/>
 151
 152 % if (length $routestring) {
 153
 154 <pre>
 155 DATA FOR
 156 <% $routestring |h %>
 157 WOULD GO HERE
 158 </pre>
 159
 160 % }
 161
 162 % } else { #---------- dropdowns, user selects from menus ----------
 163
 164 <%perl>
 165 my ($sth,$row);;
 166 my @archlistdata;
 167 my %islandlistdata;
 168 $islandlistdata{'none'}= [ [ "none", "Select island..." ] ];
 169
 170 my $optionlistmap= sub {
 171         my ($optlist, $selected) = @_;
 172         my $out='';
 173         foreach my $entry (@$optlist) {
 174                 $out.= sprintf('<option value="%s" %s>%s</option>',
 175                         encode_entities($entry->[0]),
 176                         defined $selected && $entry->[0] eq $selected
 177                                 ? 'selected' : '',
 178                         encode_entities($entry->[1]));
 179         }
 180         return $out;
 181 };
 182
 183 $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands
 184                             ORDER BY archipelago;");
 185 $sth->execute();
 186
 187 while ($row=$sth->fetchrow_arrayref) {
 188         my ($arch)= @$row;
 189         push @archlistdata, [ $arch, $arch ];
 190         $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ];
 191 }
 192
 193 $sth= $dbh->prepare("SELECT islandid,islandname,archipelago
 194                             FROM islands
 195                             ORDER BY islandname;");
 196 $sth->execute();
 197
 198 while ($row=$sth->fetchrow_arrayref) {
 199         my $arch= $row->[2];
 200         push @{ $islandlistdata{'none'} }, [ @$row ];
 201         push @{ $islandlistdata{$arch} }, [ @$row ];
 202 }
 203
 204 my %resetislandlistdata;
 205 foreach my $arch (keys %islandlistdata) {
 206         $resetislandlistdata{$arch}=
 207                 &$optionlistmap($islandlistdata{$arch}, '');
 208 }
 209
 210 </%perl>
 211
 212 <input type=hidden name=dropdowns value="<% $a{Dropdowns} %>">
 213
 214 <script type="text/javascript">
 215 ms_lists= <% to_json(\%resetislandlistdata) %>;
 216 function ms_Setarch(dd) {
 217   debug('ms_SetArch '+dd+' arch='+arch);
 218   var arch= document.getElementsByName('archipelago'+dd).item(0).value;
 219   var got= ms_lists[arch];
 220   if (got == undefined) return; // unknown arch ?  hrm
 221   debug('ms_SetArch '+dd+' arch='+arch+' got ok');
 222   var select= document.getElementsByName('islandid'+dd).item(0);
 223   select.innerHTML= got;
 224   debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set');
 225 }
 226 </script>
 227
 228 <table style="table-layout:fixed; width:90%;">
 229
 230 <tr>
 231 %       for my $dd (0..$a{Dropdowns}-1) {
 232 <td>
 233 <select name="archipelago<% $dd %>" onchange="ms_Setarch(<% $dd %>)">
 234 <option value="none">Whole ocean</option>
 235 <% &$optionlistmap(\@archlistdata, $ARGS{"archipelago$dd"}) %></select></td>
 236 %       }
 237 </tr>
 238
 239 <tr>
 240 %       for my $dd (0..$a{Dropdowns}-1) {
 241 %               my $arch= $ARGS{"archipelago$dd"};
 242 %               $arch= 'none' if !defined $arch;
 243 <td>
 244 <select name="islandid<% $dd %>">
 245 <% &$optionlistmap($islandlistdata{$arch}, $ARGS{"islandid$dd"}) %>
 246 </select></td>
 247 %       }
 248 </tr>
 249
 250 </table>
 251
 252 % } #---------- end of dropdowns, now common code ----------
 253
 254 <input type=submit name=submit value="Go">
 255 </form>
 256
 257 %#---------- debugging and epilogue ----------
 258
 259 % if ($debug) {
 260 <p>
 261 <pre id="debug_log">
 262 Debug log:
 263 </pre>
 264 % }
 265
 266 <script type="text/javascript">
 267 function debug (m) {
 268 % if ($debug) {
 269   var node= document.getElementById('debug_log');
 270   node.innerHTML += "\n" + m + "\n";
 271 % }
 272 }
 273 </script>
 274
 275 <%init>
 276 use CommodsWeb;
 277 use HTML::Entities;
 278 use URI::Escape;
 279
 280 </%init>