X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=blobdiff_plain;f=yarrg%2Fweb%2Fquery_commod;h=4869e5c50fad00d6222fa0a1ce8e2df110f488a9;hp=9cb14ca6870e70abf887b518f2e9698313d67158;hb=890faab73220a817300d53a362464d6a7fc06788;hpb=98610392fde2add293bee6199f2de1d6f88559d8
diff --git a/yarrg/web/query_commod b/yarrg/web/query_commod
index 9cb14ca..4869e5c 100644
--- a/yarrg/web/query_commod
+++ b/yarrg/web/query_commod
@@ -37,6 +37,7 @@
$quri
$dbh
$commodstring => '';
+$prselector
$someresults
$emsgokorprint
%args>
@@ -48,7 +49,9 @@ my ($commodname,$commodid);
my $qa= \%ARGS;
%perl>
-
Select commodity
+Commodity enquiry
+
+% $prselector->('BuySell');
%#---------- textbox, user enters route as string ----------
% if (!$qa->{Dropdowns}) {
@@ -77,10 +80,100 @@ Not yet implemented.
%#========== results ==========
-% $emsgokorprint->($emsg) or $commodid=undef;
+<%perl>
-% if (defined $commodid) {
-% $someresults->();
-COMMODITY <% $commodid %> named <% $commodname |h %>
+$emsgokorprint->($emsg) or $commodid=undef;
+return unless defined $commodid;
+$someresults->();
+
+#---------- actually compute the results and print them ----------
+
+foreach my $bs (split /_/, $ARGS{BuySell}) {
+ $bs =~ m/^(buy|sell)$/ or die;
+ $bs= $1;
+ my ($ascdesc) = ($bs eq 'buy')
+ ? ('DESC')
+ : ('ASC');
+#INNER JOIN
+ my $islands= $dbh->prepare(
+ "SELECT islands.islandid AS islandid, archipelago, islandname,
+ sum(qty) as tqty
+ FROM islands LEFT OUTER JOIN $bs offers
+ ON islands.islandid == offers.islandid AND commodid == ?
+ GROUP BY islands.islandid,
+ ORDER BY archipelago, islandname"
+ );
+
+ my $offers= $dbh->prepare(
+ "SELECT stallname, price, qty
+ FROM $bs NATURAL JOIN stalls
+ WHERE commodid = ? AND islandid = ?
+ ORDER BY price $ascdesc"
+ );
+ # fixme this query is utterly wrong
+
+%perl>
-% }
+Offers to <% uc $bs |h %> <% $commodname |h %>
+
+
+
+
+ | Prices
+ | Quantities available
+ |
+Archipelago
+ | Island
+ | Unique best stall
+ | Best
+ | Median
+ | At best
+ | Within 10%
+ | Total
+ |
+% $islands->execute($commodid);
+% my $island;
+% while ($island= $islands->fetchrow_hashref) {
+% my $islandid= $island->{'islandid'};
+% $offers->execute($commodid, $islandid);
+% my ($offer, $bestprice, $marginal, @beststalls);
+% my $tqty= $island->{'tqty'};
+% my $cqty= '';
+% my $bestqty= '';
+% my $approxqty= '';
+% my $median= '-';
+% while ($offer= $offers->fetchrow_hashref) {
+% my $price= $offer->{'price'};
+% my $qty= $offer->{'qty'};
+% length $bestqty or $bestprice= $price;
+% if ($price == $bestprice) {
+% $bestqty += $qty;
+% push @beststalls, $offer->{'stallname'};
+% }
+% $cqty += $qty;
+% if ($cqty*2 >= $tqty && $median eq '-') {
+% $median= $price;
+% }
+% if ($bestprice*9 <= $price*10 and
+% $price*10 <= $bestprice*11) {
+% $approxqty += $qty;
+% }
+% }
+% my $nstalls= @beststalls;
+% $cqty == $tqty or die "$bs $cqty $tqty $commodid $islandid ";
+ <% $island->{'archipelago'} |h %>
+ | <% $island->{'islandname'} |h %>
+ | <% $nstalls==0 ? '-' :
+ $nstalls==1 ? $beststalls[0] : "$nstalls offers" |h %>
+ | <% length $bestqty ? $bestprice : '-' %>
+ | <% $median %>
+ | <% $bestqty %>
+ | <% $approxqty %>
+ | <% $cqty %>
+ |
+% }
+
+
+<%perl>
+}
+%perl>