X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-live.git;a=blobdiff_plain;f=yarrg%2Fweb%2Fquery_commod;h=8d55f2686130568ba92d2c578dd787d2362e368e;hp=c9b17ae6700b72a0e5ba135a14d95ff381ae3a98;hb=18bff492748999fe28f474cea854f0fd26d6394f;hpb=00ba9271fd8409f29fcae6ee2af15824810bc939 diff --git a/yarrg/web/query_commod b/yarrg/web/query_commod index c9b17ae..8d55f26 100644 --- a/yarrg/web/query_commod +++ b/yarrg/web/query_commod @@ -36,6 +36,7 @@ <%args> $quri $dbh +$commodid => undef; $commodstring => ''; $prselector $someresults @@ -44,35 +45,23 @@ $emsgokorprint <%perl> my $emsg; -my ($commodname,$commodid); +my ($commodname,$cmid); my $qa= \%ARGS; +

Commodity enquiry

% $prselector->('BuySell'); % $prselector->('ShowBlank'); -%#---------- textbox, user enters route as string ---------- -% if (!$qa->{Dropdowns}) { - -Enter commodity (abbreviations are OK):
-
-<&| qtextstring, qa => $qa, dbh => $dbh, - thingstring => 'commodstring', emsgstore => \$emsg, - perresult => sub { ($commodname,$commodid)= @_; } +<& enter_commod, qa => $qa, dbh => $dbh, emsg_r => \$emsg, + commodname_r => \$commodname, + cmid_r => \$cmid &> - size=80 - - -% } else { #---------- dropdowns, user selects from menus ---------- - -Not yet implemented. - -% } #---------- end of dropdowns, now common middle of page code ---------- % my $ours= sub { $_[0] =~ m/^commodstring|^commodid/; }; @@ -81,10 +70,13 @@ Not yet implemented.
%#========== results ========== +
+
<%perl> -$emsgokorprint->($emsg) or $commodid=undef; -return unless defined $commodid; +$emsgokorprint->($emsg) or $cmid=undef; +print("
"), return + unless defined $cmid; $someresults->(); #---------- actually compute the results and print them ---------- @@ -95,14 +87,13 @@ foreach my $bs (split /_/, $ARGS{BuySell}) { my ($ascdesc) = ($bs eq 'buy') ? ('DESC') : ('ASC'); - my $joinkind= $ARGS{ShowBlank} eq 'show' - ? 'LEFT OUTER JOIN' : 'INNER JOIN'; + my $joinkind= $ARGS{ShowBlank} ? 'LEFT OUTER JOIN' : 'INNER JOIN'; my $islands= $dbh->prepare( "SELECT islands.islandid AS islandid, archipelago, islandname, sum(qty) as tqty FROM islands $joinkind $bs offers ON islands.islandid == offers.islandid AND commodid == ? - GROUP BY islands.islandid, + GROUP BY islands.islandid ORDER BY archipelago, islandname" ); @@ -112,32 +103,39 @@ foreach my $bs (split /_/, $ARGS{BuySell}) { WHERE commodid = ? AND islandid = ? ORDER BY price $ascdesc" ); - # fixme this query is utterly wrong

Offers to <% uc $bs |h %> <% $commodname |h %>

- - +% $islands->execute($cmid); +% my $island; +% my %ts_sortkeys; +% my $rowix= 0; +% while ($island= $islands->fetchrow_hashref) { +% if (!$rowix) { +
++++ - + -% $islands->execute($commodid); -% my $island; -% while ($island= $islands->fetchrow_hashref) { +% } % my $islandid= $island->{'islandid'}; -% $offers->execute($commodid, $islandid); +% $offers->execute($cmid, $islandid); % my ($offer, $bestprice, $marginal, @beststalls); % my $tqty= $island->{'tqty'}; % my $cqty= ''; @@ -161,21 +159,61 @@ foreach my $bs (split /_/, $ARGS{BuySell}) { % $approxqty += $qty; % } % } -% my $nstalls= @beststalls; -% $cqty == $tqty or die "$bs $cqty $tqty $commodid $islandid "; - class="<% 'datarow'.($rowix & 1) %>"> + +% for my $cix (0..$#$s) { +% $ts_sortkeys{$cix}{$rowid}= $s->[$cix]; +% } +% $rowix++; % } +% if ($rowix) {
+ + Prices -Quantities available -
Quantity at price +
Archipelago Island -Unique best stall +Stall(s) Best Median -At best -Within 10% -Total +Best ++/-10% +Any
<% $island->{'archipelago'} |h %> - <% $island->{'islandname'} |h %> - <% $nstalls==0 ? '-' : - $nstalls==1 ? $beststalls[0] : "$nstalls offers" |h %> - <% length $bestqty ? $bestprice : '-' %> - <% $median %> - <% $bestqty %> - <% $approxqty %> - <% $cqty %> +% my $stallname; +% +% my $rowid= "id_${bs}_$islandid"; +% my $s= [ ]; +% +% $s->[2]= sprintf "%06d", scalar @beststalls; +% if (!@beststalls) { +% $stallname= '-'; +% } elsif (@beststalls==1) { +% $stallname= $beststalls[0]; +% $s->[2] .= " $stallname"; +% } else { +% $stallname= sprintf "%d offers", scalar @beststalls; +% } +% +% $cqty == $tqty or die "$bs $cqty $tqty $cmid $islandid "; +
<% $s->[0]= $island->{'archipelago'} |h %> + <% $s->[1]= $island->{'islandname'} |h %> + <% $stallname |h %> + <% $s->[3]= (length $bestqty ? $bestprice : '-') %> + <% $s->[4]= $median %> + <% $s->[5]= $bestqty %> + <% $s->[6]= $approxqty %> + <% $s->[7]= $cqty %>
+<&| tabsort, table => "${bs}_table", sortkeys => "${bs}_sortkeys", + throw => "${bs}_table_thr", rowclass => 'datarow', cols => [ + {}, {}, + { DoReverse => 1 }, + { DoReverse => 1, Numeric => 1, MapFn => "ts_Pricemap_${bs}" }, + { DoReverse => 1, Numeric => 1, MapFn => "ts_Pricemap_${bs}" }, + { DoReverse => 1, Numeric => 1 }, + { DoReverse => 1, Numeric => 1 }, + { DoReverse => 1, Numeric => 1 }, + ] &> + <% $bs %>_sortkeys= <% to_json_protecttags(\%ts_sortkeys) %>; + function ts_Pricemap_<% $bs %>(price) { + if (price=='-') { return <% $bs eq 'buy' ? '-1' : '99999999' %>; } + return price; + } + +% } else { +No offers. +% } + <%perl> } +