X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fweb%2Fpirate-route;fp=yarrg%2Fweb%2Fpirate-route;h=a7d5eb25c2c210ba5c8d64f69929dfa23688bf80;hb=f4739073c3f78b1c2646b58d6adbe983ab00ca15;hp=0000000000000000000000000000000000000000;hpb=5b9cc22ec3ee084ba46a83c0ae99f4831317ff9d;p=ypp-sc-tools.db-test.git
diff --git a/yarrg/web/pirate-route b/yarrg/web/pirate-route
new file mode 100644
index 0000000..a7d5eb2
--- /dev/null
+++ b/yarrg/web/pirate-route
@@ -0,0 +1,116 @@
+
Specify route
+
+<%perl>
+my %a;
+my @vars;
+
+@vars= ({ Name => 'Ocean',
+ Before => 'Ocean: ',
+ CmpCanon => sub { ucfirst lc $_[0] },
+ Values => [ qw(Midnight Ice) ]
+ }, { 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($self_url);
+ $uri->query_form(%qf);
+ print '';
+ $after= '';
+ }
+ print $html, $after;
+ $cvalix++;
+ }
+ print '';
+}
+
+db_setocean($a{'ocean'});
+db_connect();
+
+%perl>
+
+
Specify route
+
+
+<%init>
+use CommodsWeb;
+use HTML::Entities;
+
+%init>