chiark / gitweb /
~yarrgweb / ypp-sc-tools.db-test.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: b6d8c4a)
Much tidying; preserve query type etc. in query_commod
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 16 Aug 2009 12:36:47 +0000 (13:36 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Sun, 16 Aug 2009 12:36:47 +0000 (13:36 +0100)
yarrg/web/check_commodstring patch | blob | history
yarrg/web/check_routestring patch | blob | history
yarrg/web/lookup patch | blob | history
yarrg/web/qtextstring patch | blob | history
yarrg/web/qtextstringcheck patch | blob | history
yarrg/web/query_commod patch | blob | history
yarrg/web/query_route patch | blob | history

diff --git a/yarrg/web/check_commodstring b/yarrg/web/check_commodstring
index 126dc21315644dd24820598bbf21d74888265b33..de7cda8cb525848bfcf54498622ba8a40f6e267f 100644 (file)
--- a/yarrg/web/check_commodstring
+++ b/yarrg/web/check_commodstring
@@ -36,6 +36,7 @@
 
 <%attr>
 multiple => 0
 
 <%attr>
 multiple => 0
+maxambig => 4
 </%attr>
 
 <%method sqlstmt>
 </%attr>
 
 <%method sqlstmt>
@@ -51,3 +52,7 @@ SELECT commodname,commodid
   ambiguous commodity "<% $ARGS{spec} |h %>",
   could be <% $ARGS{couldbe} |h %>
 </%method>
   ambiguous commodity "<% $ARGS{spec} |h %>",
   could be <% $ARGS{couldbe} |h %>
 </%method>
+
+<%method manyambig>
+  Many matching commodities.
+</%method>
diff --git a/yarrg/web/check_routestring b/yarrg/web/check_routestring
index 55c0783e8f64e15871d353bee006b068d37551e2..cfa7ec72303e2ea671acb4ef28aa7de9cdedb662 100755 (executable)
--- a/yarrg/web/check_routestring
+++ b/yarrg/web/check_routestring
@@ -36,6 +36,7 @@
 
 <%attr>
 multiple => 1
 
 <%attr>
 multiple => 1
+maxambig => 5
 </%attr>
 
 <%method sqlstmt>
 </%attr>
 
 <%method sqlstmt>
@@ -53,3 +54,7 @@ UNION ALL     SELECT DISTINCT archipelago,NULL,archipelago
   ambiguous island or arch "<% $ARGS{spec} |h %>",
   could be <% $ARGS{couldbe} |h %>
 </%method>
   ambiguous island or arch "<% $ARGS{spec} |h %>",
   could be <% $ARGS{couldbe} |h %>
 </%method>
+
+<%method manyambig>
+  &nbsp;
+</%method>
diff --git a/yarrg/web/lookup b/yarrg/web/lookup
index a118de0905a4d1e58cd500fcc732b20811f847ef..64860fd5f9db94e83105e83b50ad43e433b286db 100755 (executable)
--- a/yarrg/web/lookup
+++ b/yarrg/web/lookup
@@ -37,7 +37,7 @@
 <%perl>
 my %ahtml;
 my @vars;
 <%perl>
 my %ahtml;
 my @vars;
-my %styleqf;
+my %styles;
 
 #---------- "mode" argument parsing and mode menu at top of page ----------
 
 
 #---------- "mode" argument parsing and mode menu at top of page ----------
 
@@ -70,17 +70,34 @@ foreach my $var (@vars) {
                $val= [ $val, encode_entities($val) ];
        }
        if (exists $ARGS{$lname}) {
                $val= [ $val, encode_entities($val) ];
        }
        if (exists $ARGS{$lname}) {
-               $styleqf{$name}= $ARGS{$lname};
-               my @html= grep { $_->[0] eq $styleqf{$name} }
+               $styles{$name}= $ARGS{$lname};
+               my @html= grep { $_->[0] eq $styles{$name} }
                                @{ $var->{Values} };
                $ahtml{$name}= @html==1 ? $html[0][1] : '???';
        } else {
                                @{ $var->{Values} };
                $ahtml{$name}= @html==1 ? $html[0][1] : '???';
        } else {
-               $styleqf{$name}= $var->{Values}[0][0];
+               $styles{$name}= $var->{Values}[0][0];
                $ahtml{$name}= $var->{Values}[0][1];
        }
 }
 
 </%perl>
                $ahtml{$name}= $var->{Values}[0][1];
        }
 }
 
 </%perl>
+
+<%shared>
+my %baseqf;
+my %queryqf;
+</%shared>
+
+<%method formhidden>
+<%args>
+$ours
+</%args>
+% foreach my $n (keys %baseqf, keys %queryqf) {
+%      next if $ours->($n);
+%      my $v= exists $baseqf{$n} ? $baseqf{$n} : $queryqf{$n};
+<input type=hidden name=<% $n %> value="<% $v |h %>">
+% }
+</%method>
+
 <html><head><title><% ucfirst $ahtml{Query} %> - YARRG</title></head><body>
 
 <a href="<% $m->current_comp()->name() |u %>">YARRG</a> -
 <html><head><title><% ucfirst $ahtml{Query} %> - YARRG</title></head><body>
 
 <a href="<% $m->current_comp()->name() |u %>">YARRG</a> -
@@ -90,17 +107,15 @@ foreach my $var (@vars) {
 <p>
 <%perl>
 
 <p>
 <%perl>
 
-my %baseqf;
 foreach my $var (@vars) {
        my $lname= lc $var->{Name};
        next unless exists $ARGS{$lname};
        $baseqf{$lname}= $ARGS{$lname};
 }
 
 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 =~
 foreach my $var (keys %ARGS) {
        next unless $var =~
-               m/^(?:routestring|islandid\d|archipelago\d|debug)$/;
+               m/^(?:(?:route|commod)string|islandid\d|archipelago\d|debug)$/;
        my $val= $ARGS{$var};
        next if $val eq 'none';
        $queryqf{$var}= $val;
        my $val= $ARGS{$var};
        next if $val eq 'none';
        $queryqf{$var}= $val;
@@ -116,7 +131,7 @@ foreach my $var (@vars) {
        my $name= $var->{Name};
        my $lname= lc $var->{Name};
        my $delim= $var->{Before};
        my $name= $var->{Name};
        my $lname= lc $var->{Name};
        my $delim= $var->{Before};
-       my $canon= &{$var->{CmpCanon}}($styleqf{$name});
+       my $canon= &{$var->{CmpCanon}}($styles{$name});
        my $cvalix= 0;
        foreach my $valr (@{ $var->{Values} }) {
                print $delim;  $delim= "\n|\n";
        my $cvalix= 0;
        foreach my $valr (@{ $var->{Values} }) {
                print $delim;  $delim= "\n|\n";
@@ -143,9 +158,9 @@ foreach my $var (@vars) {
 
 #---------- initial checks, startup, main entry form ----------
 
 
 #---------- initial checks, startup, main entry form ----------
 
-die if $styleqf{Query} =~ m/[^a-z]/;
+die if $styles{Query} =~ m/[^a-z]/;
 
 
-dbw_connect($styleqf{Ocean});
+dbw_connect($styles{Ocean});
 
 </%perl>
 <%args>
 
 </%perl>
 <%args>
@@ -154,7 +169,7 @@ $debug => 0
 
 <hr>
 
 
 <hr>
 
-<& "query_$styleqf{Query}", %baseqf, %queryqf, %styleqf, quri => $quri &>
+<& "query_$styles{Query}", %baseqf, %queryqf, %styles, quri => $quri &>
 
 <p>
 
 
 <p>
 
diff --git a/yarrg/web/qtextstring b/yarrg/web/qtextstring
index 82c29dcda728e030ef4587fca3dc0a086b9bce87..45f2e32a75c53f9b404cc93db52c858d84d8b99b 100644 (file)
--- a/yarrg/web/qtextstring
+++ b/yarrg/web/qtextstring
@@ -44,9 +44,6 @@ my $stringval= $qa->{$thingstring};
 $stringval='' if !defined $stringval;
 </%perl>
 
 $stringval='' if !defined $stringval;
 </%perl>
 
-Enter route (islands, or archipelagoes, separated by |s or commas;
- abbreviations are OK):<br>
-
 <&| script &>
 ts_uri= "qtextstringcheck?format=application/json&ctype=text/xml"
                + "&what=<% $thingstring %>"
 <&| script &>
 ts_uri= "qtextstringcheck?format=application/json&ctype=text/xml"
                + "&what=<% $thingstring %>"
diff --git a/yarrg/web/qtextstringcheck b/yarrg/web/qtextstringcheck
index 337ed31f2deb156e831b491f1d6883abda40900a..5ef8971f644b63991af5d6eb5379be7fec1da596 100755 (executable)
--- a/yarrg/web/qtextstringcheck
+++ b/yarrg/web/qtextstringcheck
@@ -56,11 +56,11 @@ use HTML::Entities;
 use CommodsWeb;
 
 die if $what =~ m/[^a-z]/;
 use CommodsWeb;
 
 die if $what =~ m/[^a-z]/;
-my $specifics= "check_${what}";
-my $specific= $m->fetch_comp($specifics);
+my $chk= $m->fetch_comp("check_${what}");
 
 my $dbh= dbw_connect($ocean);
 
 my $dbh= dbw_connect($ocean);
-my $sqlstmt= $specific->scall_method("sqlstmt");
+
+my $sqlstmt= $chk->scall_method("sqlstmt");
 my $sth= $dbh->prepare($sqlstmt);
 my @sqlstmt_qs= $sqlstmt =~ m/\?/g;
 
 my $sth= $dbh->prepare($sqlstmt);
 my @sqlstmt_qs= $sqlstmt =~ m/\?/g;
 
@@ -69,7 +69,9 @@ my @sqlstmt_qs= $sqlstmt =~ m/\?/g;
 my $emsg= '';
 my @results;
 
 my $emsg= '';
 my @results;
 
-my @specs= $specific->attr('multiple') ? (split m#[/|,]#, $string) : ($string);
+my @specs= $chk->attr('multiple') ? (split m#[/|,]#, $string) : ($string);
+
+no warnings qw(exiting);
 
 foreach my $each (@specs) {
        $each =~ s/^\s*//;  $each =~ s/\s*$//;  $each =~ s/\s+/ /g;
 
 foreach my $each (@specs) {
        $each =~ s/^\s*//;  $each =~ s/\s*$//;  $each =~ s/\s+/ /g;
@@ -86,12 +88,12 @@ foreach my $each (@specs) {
        }
        if (!$results) {
                if (!%m) {
        }
        if (!$results) {
                if (!%m) {
-                       $err->($specific->scall_method("nomatch",
+                       $err->($chk->scall_method("nomatch",
                                spec => $each));
                                spec => $each));
-               } elsif (keys(%m) > 5) {
-                       $err->('&nbsp;');
+               } elsif (keys(%m) > $chk->attr('maxambig')) {
+                       $err->($chk->scall_method("manyambig"));
                } else {
                } else {
-                       $err->($specific->scall_method("ambiguous",
+                       $err->($chk->scall_method("ambiguous",
                                spec => $each,
                                couldbe => join(', ', sort keys %m)));
                }
                                spec => $each,
                                couldbe => join(', ', sort keys %m)));
                }
diff --git a/yarrg/web/query_commod b/yarrg/web/query_commod
index 5a7497bac9d3d8d042bf40c031d565bf952607d2..2358b4167cc373874dd8bf959f3099a610612eeb 100644 (file)
--- a/yarrg/web/query_commod
+++ b/yarrg/web/query_commod
@@ -45,12 +45,20 @@ $commodstring => '';
 
 <h1>Select commodity</h1>
 
 
 <h1>Select commodity</h1>
 
+Enter commodity (abbreviations are OK):<br>
+
 <form action="<% $quri->() |h %>" method="get">
 
 <&| qtextstring, qa => $qa, thingstring => 'commodstring' &>
  size=80
 </&>
 
 <form action="<% $quri->() |h %>" method="get">
 
 <&| qtextstring, qa => $qa, thingstring => 'commodstring' &>
  size=80
 </&>
 
+<input type=submit name=submit value="Go">
+% my $ours= sub { $_[0] =~ m/^commodstring/; };
+<& "lookup:formhidden", ours => $ours &>
+
+</form>
+
 % } else { #---------- dropdowns, user selects from menus ----------
 
 % } #---------- end of dropdowns, now common middle of page code ----------
 % } else { #---------- dropdowns, user selects from menus ----------
 
 % } #---------- end of dropdowns, now common middle of page code ----------
diff --git a/yarrg/web/query_route b/yarrg/web/query_route
index dd8644f1675694d200e28341d0b32bc5d6396422..8f6d99c49d29ed353f5f2fcdf6d88dc55180afac 100644 (file)
--- a/yarrg/web/query_route
+++ b/yarrg/web/query_route
@@ -51,6 +51,9 @@ my $qa= \%ARGS;
 
 <h1>Specify route</h1>
 
 
 <h1>Specify route</h1>
 
+Enter route (islands, or archipelagoes, separated by |s or commas;
+ abbreviations are OK):<br>
+
 <form action="<% $quri->() |h %>" method="get">
 
 <&| qtextstring, qa => $qa, thingstring => 'routestring' &>
 <form action="<% $quri->() |h %>" method="get">
 
 <&| qtextstring, qa => $qa, thingstring => 'routestring' &>
@@ -112,8 +115,6 @@ $dbh->rollback();
 
 </%perl>
 
 
 </%perl>
 
-<input type=hidden name=dropdowns value="<% $qa->{Dropdowns} |h %>">
-
 <&| script &>
 ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
 function ms_Setarch(dd) {
 <&| script &>
 ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>;
 function ms_Setarch(dd) {
@@ -155,6 +156,8 @@ function ms_Setarch(dd) {
 % } #---------- end of dropdowns, now common middle of page code ----------
 
 <input type=submit name=submit value="Go">
 % } #---------- end of dropdowns, now common middle of page code ----------
 
 <input type=submit name=submit value="Go">
+% my $ours= sub { $_[0] =~ m/^island|^archipelago|^routestring/; };
+<& "lookup:formhidden", ours => $ours &>
 </form>
 
 <%perl>
 </form>
 
 <%perl>
yarrg testing database