<%args> $quri $qa $routestring => ''; <%perl> my @archipelagoes; my @islandids; my %islandid2; %#---------- textbox, user enters route as string ---------- % if (!$qa->{Dropdowns}) {

Specify route

<&| qtextstring, qa => $qa, thingstring => 'routestring' &> size=80 % } else { #---------- dropdowns, user selects from menus ---------- <%perl> my ($sth,$row);; my @archlistdata; my %islandlistdata; $islandlistdata{'none'}= [ [ "none", "Select island..." ] ]; my $optionlistmap= sub { my ($optlist, $selected) = @_; my $out=''; foreach my $entry (@$optlist) { $out.= sprintf('', encode_entities($entry->[0]), defined $selected && $entry->[0] eq $selected ? 'selected' : '', encode_entities($entry->[1])); } return $out; }; my $dbh= dbw_connect($qa->{Ocean}); $sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands ORDER BY archipelago;"); $sth->execute(); while ($row=$sth->fetchrow_arrayref) { my ($arch)= @$row; push @archlistdata, [ $arch, $arch ]; $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ]; } $sth= $dbh->prepare("SELECT islandid,islandname,archipelago FROM islands ORDER BY islandname;"); $sth->execute(); while ($row=$sth->fetchrow_arrayref) { my $arch= $row->[2]; push @{ $islandlistdata{'none'} }, [ @$row ]; push @{ $islandlistdata{$arch} }, [ @$row ]; $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch }; } my %resetislandlistdata; foreach my $arch (keys %islandlistdata) { $resetislandlistdata{$arch}= $optionlistmap->($islandlistdata{$arch}, ''); } <&| script &> ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>; function ms_Setarch(dd) { debug('ms_SetArch '+dd+' arch='+arch); var arch= document.getElementsByName('archipelago'+dd).item(0).value; var got= ms_lists[arch]; if (got == undefined) return; // unknown arch ? hrm debug('ms_SetArch '+dd+' arch='+arch+' got ok'); var select= document.getElementsByName('islandid'+dd).item(0); select.innerHTML= got; debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set'); } % for my $dd (0..$qa->{Dropdowns}-1) { % } % for my $dd (0..$qa->{Dropdowns}-1) { % my $arch= $ARGS{"archipelago$dd"}; % $arch= 'none' if !defined $arch; % }
% } #---------- end of dropdowns, now common middle of page code ----------
<%perl> #========== result computations ========== my $results_head; $results_head= sub { print "

Results

\n"; $results_head= sub { }; }; #---------- result computation - textstring ---------- if (!$qa->{Dropdowns}) { if (length $routestring) { $results_head->(); my $rsr= $m->comp('routetextstring', ocean => $qa->{Ocean}, string => $routestring, format => 'return' ); if (length $rsr->{Error}) { print encode_entities($rsr->{Error}); } else { foreach my $entry (@{ $rsr->{Results} }) { push @archipelagoes, defined $entry->[1] ? undef : $entry->[0]; push @islandids, $entry->[1]; } } } } else { #---------- results - dropdowns ---------- my $argorundef= sub { my ($dd,$base) = @_; my $thing= $ARGS{"${base}${dd}"}; $thing= undef if defined $thing and $thing eq 'none'; return $thing; }; for my $dd (0..$qa->{Dropdowns}-1) { my $arch= $argorundef->($dd,'archipelago'); my $island= $argorundef->($dd,'islandid'); next unless defined $arch or defined $island; if (defined $island and defined $arch) { my $ii= $islandid2{$island}; my $iarch= $ii->{Arch}; if ($iarch ne $arch) { $results_head->(); Specified archipelago <% $arch %> but island <% $ii->{Name} %> which is in <% $iarch %>; using the island.
<%perl> } $arch= undef; } push @archipelagoes, $arch; push @islandids, $island; } }#---------- result processing, common stuff % if (@islandids) { % $results_head->(); <& routetrade, islandids => \@islandids, archipelagoes => \@archipelagoes &> % }