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=4869e5c50fad00d6222fa0a1ce8e2df110f488a9;hp=ab87cac30e5bb6e7d01ef638f3906dd8a11ae16e;hb=890faab73220a817300d53a362464d6a7fc06788;hpb=b124f869e5f0d90bf1caa178c92f6ebc267cfa8c
diff --git a/yarrg/web/query_commod b/yarrg/web/query_commod
index ab87cac..4869e5c 100644
--- a/yarrg/web/query_commod
+++ b/yarrg/web/query_commod
@@ -35,21 +35,145 @@
%doc>
<%args>
$quri
-$qa
+$dbh
$commodstring => '';
+$prselector
+$someresults
+$emsgokorprint
%args>
+<%perl>
+my $emsg;
+my ($commodname,$commodid);
+
+my $qa= \%ARGS;
+%perl>
+
+
Commodity enquiry
+
+% $prselector->('BuySell');
+
%#---------- textbox, user enters route as string ----------
% if (!$qa->{Dropdowns}) {
-Select commodity
+Enter commodity (abbreviations are OK):
+
+%#========== results ==========
+<%perl>
+
+$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>