X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2Fweb%2Fquery_route;h=3c769a92f4fc6390851f22bb8c4a92e25d3d715c;hp=ea483578d565d6df529dffcfddf7d1c6a5c1e9cf;hb=43454422b2df5e0dcfe144fcb871a2b6f9c1a3d0;hpb=202510fa47a7459760d6e41f6017500696e344d8 diff --git a/yarrg/web/query_route b/yarrg/web/query_route index ea48357..3c769a9 100644 --- a/yarrg/web/query_route +++ b/yarrg/web/query_route @@ -40,17 +40,18 @@ $prselector $routestring => ''; $capacitystring => ''; $lossperleague => ''; +$capitalstring => ''; +$minprofitstring => ''; $someresults $emsgokorprint +$allargs <%perl> my $emsg; +my @warningfs; my @archipelagoes; my @islandids; -my %islandid2; -my ($max_volume, $max_mass); -my $lossperleaguepct; my $qa= \%ARGS; @@ -65,208 +66,72 @@ my $goupdate= sub { $be_post ? 'Update' : 'Go' }; -

Specify route

- -% $prselector->('ShowStalls'); - -%#---------- textbox, user enters route as string ---------- +% # Sadly we need to do this rather hacky thing to make it be a POST +% # form if the user has already selected some thing(s) % if (!$qa->{Dropdowns}) { - -Enter route (islands, or archipelagoes, separated by |s or commas; - abbreviations are OK):
- -% $startform->($routestring =~ m/\S/); - -<&| qtextstring, qa => $qa, dbh => $dbh, - thingstring => 'routestring', emsgstore => \$emsg, - perresult => sub { - my ($canonname, $island, $arch) = @_; - push @islandids, $island; - push @archipelagoes, defined $island ? undef : $arch; - } - &> - size=80 - - -Advanced options - you may leave these blank: -

- - -
- -Vessel or capacity: -<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'cs', - thingstring => 'capacitystring', emsgstore => \$emsg, - perresult => sub { - ($max_volume,$max_mass) = @_; - } - &> - size=30 - - - -  -  - - -Expected losses: - -<&| qtextstring, qa => $qa, dbh => $dbh, prefix => 'll', - thingstring => 'lossperleague', emsgstore => \$emsg, - perresult => sub { ($lossperleaguepct)= @_; } - &> - size=10 - - -
- -% } else { #---------- dropdowns, user selects from menus ---------- - -% $startform->(grep { -% defined $ARGS{"archipelago$_"} || -% defined $ARGS{"islandid$_"} +% $startform->($routestring =~ m/\S/); +% } else { +% $startform->(grep { +% defined $qa->{"archipelago$_"} || +% defined $qa->{"islandid$_"} % } (0..$qa->{Dropdowns}-1)); +% } -<%perl> -my ($sth,$row); -my @archlistdata; -my %islandlistdata; -$islandlistdata{'none'}= [ [ "none", "Select island..." ] ]; - -my $optionlistmap= sub { - my ($optlist, $selected) = @_; - my $out=''; - foreach my $entry (@$optlist) { - $out.= sprintf('', - encode_entities($entry->[0]), - defined $selected && $entry->[0] eq $selected - ? 'selected' : '', - encode_entities($entry->[1])); - } - return $out; -}; - -$sth= $dbh->prepare("SELECT DISTINCT archipelago FROM islands - ORDER BY archipelago;"); -$sth->execute(); - -while ($row=$sth->fetchrow_arrayref) { - my ($arch)= @$row; - push @archlistdata, [ $arch, $arch ]; - $islandlistdata{$arch}= [ [ "none", "Whole arch" ] ]; -} - -$sth= $dbh->prepare("SELECT islandid,islandname,archipelago - FROM islands - ORDER BY islandname;"); -$sth->execute(); - -while ($row=$sth->fetchrow_arrayref) { - my $arch= $row->[2]; - push @{ $islandlistdata{'none'} }, [ @$row ]; - push @{ $islandlistdata{$arch} }, [ @$row ]; - $islandid2{$row->[0]}= { Name => $row->[1], Arch => $arch }; -} - -my %resetislandlistdata; -foreach my $arch (keys %islandlistdata) { - $resetislandlistdata{$arch}= - $optionlistmap->($islandlistdata{$arch}, ''); -} +

- +

Specify route

-<&| script &> -ms_lists= <% to_json_protecttags(\%resetislandlistdata) %>; -function ms_Setarch(dd) { - debug('ms_SetArch '+dd+' arch='+arch); - var arch= document.getElementsByName('archipelago'+dd).item(0).value; - var got= ms_lists[arch]; - if (got == undefined) return; // unknown arch ? hrm - debug('ms_SetArch '+dd+' arch='+arch+' got ok'); - var select= document.getElementsByName('islandid'+dd).item(0); - select.innerHTML= got; - debug('ms_SetArch '+dd+' arch='+arch+' innerHTML set'); -} - +% $prselector->('ShowStalls'); - +<& enter_route, qa => $qa, dbh => $dbh, emsg_r => \$emsg, + warningfs_r => \@warningfs, + enterwhat => 'Enter route', + islandids_r => \@islandids, + archipelagoes_r => \@archipelagoes + &> - -% for my $dd (0..$qa->{Dropdowns}-1) { - -% } - +%#---------- textboxes, user enters details as strings ---------- +% my $routeparams= { EmsgRef => \$emsg }; +% if (!$qa->{Dropdowns}) { - -% for my $dd (0..$qa->{Dropdowns}-1) { -% my $arch= $ARGS{"archipelago$dd"}; -% $arch= 'none' if !defined $arch; - -% } - + +

-

-
-
+<& enter_advrouteopts, qa=>$qa, dbh=>$dbh, + minprofit_needs_apply => $be_post, + routeparams=>$routeparams &> % } #---------- end of dropdowns, now common middle of page code ---------- - % my $ours= sub { $_[0] =~ -% m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^[RT]/; +% m/^island|^archipelago|^routestring|^capacitystring|^lossperleague|^capitalstring|^minprofitstring|^[RT]/; % }; <& "lookup:formhidden", ours => $ours &> +
+
<%perl> #========== results ========== $emsgokorprint->($emsg) or @islandids=(); -my $argorundef= sub { - my ($dd,$base) = @_; - my $thing= $ARGS{"${base}${dd}"}; - $thing= undef if defined $thing and $thing eq 'none'; - return $thing; -}; - -for my $dd (0..$qa->{Dropdowns}-1) { - my $arch= $argorundef->($dd,'archipelago'); - my $island= $argorundef->($dd,'islandid'); - next unless defined $arch or defined $island; - if (defined $island and defined $arch) { - my $ii= $islandid2{$island}; - my $iarch= $ii->{Arch}; - if ($iarch ne $arch) { - $someresults->(); - - Specified archipelago <% $arch %> but - island <% $ii->{Name} %> - which is in <% $iarch %>; using the island.
-<%perl> - } - $arch= undef; - } - push @archipelagoes, $arch; - push @islandids, $island; +foreach my $warningf (@warningfs) { + $someresults->(); + $warningf->(); } % if (@islandids) { -% $someresults->('Relevant trades'); +% $someresults->(); <& routetrade, dbh => $dbh, islandids => \@islandids, archipelagoes => \@archipelagoes, qa => $qa, - max_mass => $max_mass, - max_volume => $max_volume, - lossperleaguepct => $lossperleaguepct + routeparams => $routeparams, + reset_suppressions => !!$allargs->{'apply_minprofit'} &> - % } +
+