From: Ian Jackson Date: Wed, 2 Sep 2009 22:27:15 +0000 (+0100) Subject: Query for vessel capacity X-Git-Tag: 3.4~22 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=commitdiff_plain;h=70f23c42b325a1463fe8a9d76cb967b7df1260df Query for vessel capacity --- diff --git a/yarrg/web/lookup b/yarrg/web/lookup index 8fb3bb1..3fd854f 100755 --- a/yarrg/web/lookup +++ b/yarrg/web/lookup @@ -153,7 +153,7 @@ foreach my $var (@vars) { foreach my $var (keys %ARGS) { next unless $var =~ - m/^(?: (?:route|commod)string | + m/^(?: (?:route|commod|capacity)string | commodid | islandid \d | archipelago \d | diff --git a/yarrg/web/qtextstring b/yarrg/web/qtextstring index 84564df..639e9ab 100644 --- a/yarrg/web/qtextstring +++ b/yarrg/web/qtextstring @@ -41,62 +41,65 @@ $dbh $thingstring $emsgstore $perresult +$prefix => 'ts'; <%perl> my $stringval= $qa->{$thingstring}; $stringval='' if !defined $stringval; + +my $p= $prefix.'_'; <&| script &> -ts_uri= "qtextstringcheck?format=application/json&ctype=text/xml" +<%$p%>uri= "qtextstringcheck?format=application/json&ctype=text/xml" + "&what=<% $thingstring %>" + "&ocean=<% uri_escape($qa->{Ocean}) %>"; -ts_timeout=false; -ts_request=false; -ts_done=''; -ts_needed=''; -function ts_Later(){ - window.clearTimeout(ts_timeout); - ts_timeout = window.setTimeout(ts_Needed, 500); +<%$p%>timeout=false; +<%$p%>request=false; +<%$p%>done=''; +<%$p%>needed=''; +function <%$p%>Later(){ + window.clearTimeout(<%$p%>timeout); + <%$p%>timeout = window.setTimeout(<%$p%>Needed, 500); } -function ts_Needed(){ - window.clearTimeout(ts_timeout); - ts_element= document.getElementById('<% $thingstring %>'); - ts_needed= ts_element.value; - ts_Request(); +function <%$p%>Needed(){ + window.clearTimeout(<%$p%>timeout); + <%$p%>element= document.getElementById('<% $thingstring %>'); + <%$p%>needed= <%$p%>element.value; + <%$p%>Request(); } -function ts_Request(){ - if (ts_request || ts_needed==ts_done) return; - ts_done= ts_needed; - ts_request= new XMLHttpRequest(); - uri= ts_uri+'&string='+encodeURIComponent(ts_needed); - ts_request.open('GET', uri); - ts_request.onreadystatechange= ts_Ready; - ts_request.send(null); +function <%$p%>Request(){ + if (<%$p%>request || <%$p%>needed==<%$p%>done) return; + <%$p%>done= <%$p%>needed; + <%$p%>request= new XMLHttpRequest(); + uri= <%$p%>uri+'&string='+encodeURIComponent(<%$p%>needed); + <%$p%>request.open('GET', uri); + <%$p%>request.onreadystatechange= <%$p%>Ready; + <%$p%>request.send(null); } -function ts_Ready() { - if (ts_request.readyState != 4) return; - if (ts_request.status == 200) { - response= ts_request.responseText; - debug('got '+response); +function <%$p%>Ready() { + if (<%$p%>request.readyState != 4) return; + if (<%$p%>request.status == 200) { + response= <%$p%>request.responseText; + debug('<%$p%> got '+response); eval('results='+response); - toedit= document.getElementById('ts_results'); + toedit= document.getElementById('<%$p%>results'); toedit.innerHTML= results.show; } - ts_request= false; - ts_Request(); + <%$p%>request= false; + <%$p%>Request(); } -register_onload(ts_Needed); +register_onload(<%$p%>Needed); content %> id="<% $thingstring %>" name="<% $thingstring %>" - onchange="ts_Needed();" onkeyup="ts_Later();" + onchange="<%$p%>Needed();" onkeyup="<%$p%>Later();" value="<% $stringval |h %>" >
-
 

+
 

<%perl> if (length $thingstring) { @@ -106,9 +109,13 @@ if (length $thingstring) { string => $stringval, format => 'return' ); - $$emsgstore= $emsg; + if (defined $emsg and length $emsg) { + $$emsgstore='' unless defined $$emsgstore; + $$emsgstore .= $emsg. ' '; + } foreach my $entry (@$results) { +#print STDERR "qts entry perresult \`@$entry'\n"; $perresult->(@$entry); } } diff --git a/yarrg/web/qtextstringcheck b/yarrg/web/qtextstringcheck index b2c1013..a6c84fe 100755 --- a/yarrg/web/qtextstringcheck +++ b/yarrg/web/qtextstringcheck @@ -62,16 +62,27 @@ my $chk= $m->fetch_comp("check_${what}"); my $mydbh; $dbh ||= ($mydbh= dbw_connect($ocean)); -my $sqlstmt= $chk->scall_method("sqlstmt"); -my $sth= $dbh->prepare($sqlstmt); -my @sqlstmt_qs= $sqlstmt =~ m/\?/g; +#print STDERR "qtsc string=\`$string'\n"; -#die "$sqlstmt @sqlstmt_qs"; +my ($sth, @sqlstmt_qs); +if ($chk->method_exists('sqlstmt')) { + my $sqlstmt= $chk->scall_method("sqlstmt"); + $sth= $dbh->prepare($sqlstmt); + @sqlstmt_qs= $sqlstmt =~ m/\?/g; +} my $emsg= ''; my @results; - -my @specs= $chk->attr('multiple') ? (split m#[/|,]#, $string) : ($string); +my @specs; +my $hooks = { Emsg => \$emsg, String => \$string, + Results => \@results, Specs => \@specs, + }; + +if ($chk->method_exists('preparse')) { + $chk->call_method('preparse', h => $hooks); +} else { + @specs= $chk->attr('multiple') ? (split m#[/|,]#, $string) : ($string); +} no warnings qw(exiting); @@ -103,8 +114,16 @@ foreach my $each (@specs) { push @results, $results->[0]; }; -$emsg='' if !defined $emsg; my $canontext= join ' | ', map { $_->[0] } @results; +if ($chk->method_exists('postquery')) { + $hooks->{Canon}= \$canontext; + $chk->call_method('postquery', h => $hooks); +} + +$emsg='' if !defined $emsg; +@results=() if length $emsg; + +#print STDERR "qtsc emsg=\`$emsg' results=\`@results'\n"; if ($format =~ /json/) { $r->content_type($ctype or $format); diff --git a/yarrg/web/query_route b/yarrg/web/query_route index 393e7a6..d4a3bd1 100644 --- a/yarrg/web/query_route +++ b/yarrg/web/query_route @@ -38,6 +38,7 @@ $quri $dbh $prselector $routestring => ''; +$capacitystring => ''; $someresults $emsgokorprint @@ -47,6 +48,7 @@ my $emsg; my @archipelagoes; my @islandids; my %islandid2; +my ($max_volume, $max_mass); my $qa= \%ARGS; @@ -84,6 +86,15 @@ Enter route (islands, or archipelagoes, separated by |s or commas; size=80 +Vessel capacity: +<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs', + thingstring => 'capacitystring', emsgstore => \$emsg, + perresult => sub { + ($max_volume,$max_mass) = @_; + } + &> + + % } else { #---------- dropdowns, user selects from menus ---------- % $startform->(grep { @@ -181,7 +192,9 @@ function ms_Setarch(dd) { % } #---------- end of dropdowns, now common middle of page code ---------- -% my $ours= sub { $_[0] =~ m/^island|^archipelago|^routestring|^[RT]/; }; +% my $ours= sub { $_[0] =~ +% m/^island|^archipelago|^routestring|^capacitystring|^[RT]/; +% }; <& "lookup:formhidden", ours => $ours &> <%perl>