From 9d01242d0991d15f7ea84454264c868e1c4ed8ad Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 16 Aug 2009 13:36:47 +0100 Subject: [PATCH] Much tidying; preserve query type etc. in query_commod --- yarrg/web/check_commodstring | 5 +++++ yarrg/web/check_routestring | 5 +++++ yarrg/web/lookup | 37 +++++++++++++++++++++++++----------- yarrg/web/qtextstring | 3 --- yarrg/web/qtextstringcheck | 18 ++++++++++-------- yarrg/web/query_commod | 8 ++++++++ yarrg/web/query_route | 7 +++++-- 7 files changed, 59 insertions(+), 24 deletions(-) diff --git a/yarrg/web/check_commodstring b/yarrg/web/check_commodstring index 126dc21..de7cda8 100644 --- a/yarrg/web/check_commodstring +++ b/yarrg/web/check_commodstring @@ -36,6 +36,7 @@ <%attr> multiple => 0 +maxambig => 4 <%method sqlstmt> @@ -51,3 +52,7 @@ SELECT commodname,commodid ambiguous commodity "<% $ARGS{spec} |h %>", could be <% $ARGS{couldbe} |h %> + +<%method manyambig> + Many matching commodities. + diff --git a/yarrg/web/check_routestring b/yarrg/web/check_routestring index 55c0783..cfa7ec7 100755 --- a/yarrg/web/check_routestring +++ b/yarrg/web/check_routestring @@ -36,6 +36,7 @@ <%attr> multiple => 1 +maxambig => 5 <%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 manyambig> + + diff --git a/yarrg/web/lookup b/yarrg/web/lookup index a118de0..64860fd 100755 --- a/yarrg/web/lookup +++ b/yarrg/web/lookup @@ -37,7 +37,7 @@ <%perl> my %ahtml; my @vars; -my %styleqf; +my %styles; #---------- "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}) { - $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 { - $styleqf{$name}= $var->{Values}[0][0]; + $styles{$name}= $var->{Values}[0][0]; $ahtml{$name}= $var->{Values}[0][1]; } } + +<%shared> +my %baseqf; +my %queryqf; + + +<%method formhidden> +<%args> +$ours + +% foreach my $n (keys %baseqf, keys %queryqf) { +% next if $ours->($n); +% my $v= exists $baseqf{$n} ? $baseqf{$n} : $queryqf{$n}; + value="<% $v |h %>"> +% } + + <% ucfirst $ahtml{Query} %> - YARRG YARRG - @@ -90,17 +107,15 @@ foreach my $var (@vars) {

<%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)$/; + m/^(?:(?:route|commod)string|islandid\d|archipelago\d|debug)$/; 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 $canon= &{$var->{CmpCanon}}($styleqf{$name}); + my $canon= &{$var->{CmpCanon}}($styles{$name}); 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 ---------- -die if $styleqf{Query} =~ m/[^a-z]/; +die if $styles{Query} =~ m/[^a-z]/; -dbw_connect($styleqf{Ocean}); +dbw_connect($styles{Ocean}); <%args> @@ -154,7 +169,7 @@ $debug => 0

-<& "query_$styleqf{Query}", %baseqf, %queryqf, %styleqf, quri => $quri &> +<& "query_$styles{Query}", %baseqf, %queryqf, %styles, quri => $quri &>

diff --git a/yarrg/web/qtextstring b/yarrg/web/qtextstring index 82c29dc..45f2e32 100644 --- a/yarrg/web/qtextstring +++ b/yarrg/web/qtextstring @@ -44,9 +44,6 @@ my $stringval= $qa->{$thingstring}; $stringval='' if !defined $stringval; -Enter route (islands, or archipelagoes, separated by |s or commas; - abbreviations are OK):
- <&| script &> ts_uri= "qtextstringcheck?format=application/json&ctype=text/xml" + "&what=<% $thingstring %>" diff --git a/yarrg/web/qtextstringcheck b/yarrg/web/qtextstringcheck index 337ed31..5ef8971 100755 --- a/yarrg/web/qtextstringcheck +++ b/yarrg/web/qtextstringcheck @@ -56,11 +56,11 @@ use HTML::Entities; 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 $sqlstmt= $specific->scall_method("sqlstmt"); + +my $sqlstmt= $chk->scall_method("sqlstmt"); 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 @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; @@ -86,12 +88,12 @@ foreach my $each (@specs) { } if (!$results) { if (!%m) { - $err->($specific->scall_method("nomatch", + $err->($chk->scall_method("nomatch", spec => $each)); - } elsif (keys(%m) > 5) { - $err->(' '); + } elsif (keys(%m) > $chk->attr('maxambig')) { + $err->($chk->scall_method("manyambig")); } else { - $err->($specific->scall_method("ambiguous", + $err->($chk->scall_method("ambiguous", spec => $each, couldbe => join(', ', sort keys %m))); } diff --git a/yarrg/web/query_commod b/yarrg/web/query_commod index 5a7497b..2358b41 100644 --- a/yarrg/web/query_commod +++ b/yarrg/web/query_commod @@ -45,12 +45,20 @@ $commodstring => '';

Select commodity

+Enter commodity (abbreviations are OK):
+ + % } 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 dd8644f..8f6d99c 100644 --- a/yarrg/web/query_route +++ b/yarrg/web/query_route @@ -51,6 +51,9 @@ my $qa= \%ARGS;

Specify route

+Enter route (islands, or archipelagoes, separated by |s or commas; + abbreviations are OK):
+ <%perl> -- 2.30.2