%perl> my %a; my %ahtml; my @vars; # for output: my @archipelagoes; my @islandids; my %islandid2; #---------- "mode" argument parsing and mode menu at top of page ---------- # for debugging, invoke as # http://www.chiark.greenend.org.uk/ucgi/~clareb/mason/pirates/pirate-route?debug=1 @vars= ({ Name => 'Ocean', Before => 'Ocean: ', CmpCanon => sub { ucfirst lc $_[0] }, Values => [ ocean_list() ] }, { Name => 'Dropdowns', Before => 'Interface: ', CmpCanon => sub { !!$_[0] }, Values => [ [ 0, 'Type in names' ], [ 4, 'Select from menus' ] ] }, { Name => 'Query', Before => 'Query: ', Values => [ [ 'route', 'Trades for route' ], [ 'age', 'Data age' ] ] }); foreach my $var (@vars) { my $name= $var->{Name}; my $lname= lc $name; $var->{Before}= '' unless exists $var->{Before}; $var->{CmpCanon}= sub { $_[0]; } unless exists $var->{CmpCanon}; foreach my $val (@{ $var->{Values} }) { next if ref $val; $val= [ $val, encode_entities($val) ]; } if (exists $ARGS{$lname}) { $a{$name}= $ARGS{$lname}; my @html= grep { $_->[0] eq $a{$name} } @{ $var->{Values} }; $ahtml{$name}= @html==1 ? $html[0][1] : '???'; } else { $a{$name}= $var->{Values}[0][0]; $ahtml{$name}= $var->{Values}[0][1]; } } %perl>
<%perl> my %baseqf; foreach my $var (@vars) { my $lname= lc $var->{Name}; next unless exists $ARGS{$lname}; $baseqf{$lname}= $ARGS{$lname}; } my %queryqf; foreach my $var (keys %ARGS) { next unless $var =~ m/^(?:routestring|islandid\d|archipelago\d|debug)$/; my $val= $ARGS{$var}; next if $val eq 'none'; $queryqf{$var}= $val; } my $quri= sub { my $uri= URI->new('lookup'); $uri->query_form(@_); $uri->path_query(); }; foreach my $var (@vars) { my $name= $var->{Name}; my $lname= lc $var->{Name}; my $delim= $var->{Before}; my $canon= &{$var->{CmpCanon}}($a{$name}); my $cvalix= 0; foreach my $valr (@{ $var->{Values} }) { print $delim; $delim= "\n|\n"; my ($value,$html) = @$valr; my $iscurrent= &{$var->{CmpCanon}}($value) eq $canon; my $after; if ($iscurrent) { print ''; $after= ''; } else { my %qf= (%baseqf,%queryqf); delete $qf{$lname}; $qf{$lname}= $value if $cvalix; print ''; $after= ''; } print $html, $after; $cvalix++; } print "
\n\n"; } #---------- initial checks, startup, main entry form ---------- dbw_connect($a{Ocean}); %perl> <%args> $debug => 0 $routestring => '' %args> %########### query `route' ########## % if ($a{Query} eq 'route') {
Debug log:% } <%init> use CommodsWeb; use HTML::Entities; use URI::Escape; use JSON; %init>