<%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};
$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{lc $name}) {
$a{$name}= $ARGS{lc $name};
} else {
$a{$name}= $var->{Values}[0][0];
}
}
foreach my $var (@vars) {
my $name= $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= ();
foreach my $innerr (@vars) {
my $n= lc $innerr->{Name};
if ($n ne lc $name) {
next unless exists $ARGS{$n};
$qf{$n}= $ARGS{$n};
} else {
next if !$cvalix;
$qf{$n}= $value;
}
}
my $uri= URI->new($m->current_comp()->name());
$qf{'debug'}=1 if $debug;
$uri->query_form(%qf);
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
Specify route
% if ($debug) {
Debug log:
% }
<%init>
use CommodsWeb;
use HTML::Entities;
use URI::Escape;