<%perl> my %a; my @vars; #---------- "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' ] ] }); 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}; } else { $a{$name}= $var->{Values}[0][0]; } } 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)$/; $queryqf{$var}= $ARGS{$var}; } my $uri= URI->new($m->current_comp()->name()); my $quri= sub { $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 ---------- die "unknown ocean $a{Ocean} ?" unless grep { $_ eq $a{Ocean} } ocean_list(); db_setocean($a{Ocean}); db_connect(); <%args> $debug => 0 $routestring => ''

Specify route

%#---------- textbox, user enters route as string ---------- % if (!$a{Dropdowns}) { Enter route (islands, or archipelagoes, separated by |s or commas; abbreviations are OK):

% if (length $routestring) {

DATA FOR 
<% $routestring |h %>
WOULD GO HERE

% } % } 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; }; $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 ]; } my %resetislandlistdata; foreach my $arch (keys %islandlistdata) { $resetislandlistdata{$arch}= &$optionlistmap($islandlistdata{$arch}, ''); } % for my $dd (0..$a{Dropdowns}-1) { % } % for my $dd (0..$a{Dropdowns}-1) { % my $arch= $ARGS{"archipelago$dd"}; % $arch= 'none' if !defined $arch; % }

% } #---------- end of dropdowns, now common code ----------

%#---------- debugging and epilogue ---------- % if ($debug) {

Debug log:

% } <%init> use CommodsWeb; use HTML::Entities; use URI::Escape;