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%2Froutetrade;h=e6aff44eece5329da0bccc817e641ac7597f7d92;hp=4475d27197915154c8cc4204556c10259dd355b2;hb=21023ed45c8db0ff06c0106593123d5b84a19c72;hpb=efc8497c2414dfded724d7181e11df53b947e387

diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade
index 4475d27..e6aff44 100644
--- a/yarrg/web/routetrade
+++ b/yarrg/web/routetrade
@@ -1,26 +1,124 @@
+<%doc>
+
+ This is part of the YARRG website.  YARRG is a tool and website
+ for assisting players of Yohoho Puzzle Pirates.
+
+ Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+ Copyright (C) 2009 Clare Boothby
+
+  YARRG's client code etc. is covered by the ordinary GNU GPL (v3 or later).
+  The YARRG website is covered by the GNU Affero GPL v3 or later, which
+   basically means that every installation of the website will let you
+   download the source.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU Affero General Public License as
+ published by the Free Software Foundation, either version 3 of the
+ License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU Affero General Public License for more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+ Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+ are used without permission.  This program is not endorsed or
+ sponsored by Three Rings.
+
+
+ This Mason component is the core trade planner for a specific route.
+
+
+</%doc>
 <%args>
+$dbh
 @islandids
 @archipelagoes
+$qa
 </%args>
+<%perl>
+
+my @flow_conds;
+my @query_params;
+
+my $sd_condition= sub {
+	my ($bs, $ix) = @_;
+	my $islandid= $islandids[$ix];
+	if (defined $islandid) {
+		return "${bs}.islandid = $islandid";
+	} else {
+		push @query_params, $archipelagoes[$ix];
+		return "${bs}_islands.archipelago = ?";
+	}
+};
 
-%# So, add code to do right thing here:
+foreach my $src_i (0..$#islandids) {
+	my $src_cond= $sd_condition->('sell',$src_i);
+	my @dst_conds;
+	foreach my $dst_i ($src_i..$#islandids) {
+		my $dst_cond= $sd_condition->('buy',$dst_i);
+		if ($dst_i==$src_i and !defined $islandids[$src_i]) {
+			# we always want arbitrage, but mentioning an arch
+			# once shouldn't produce intra-arch trades
+			$dst_cond=
+				"($dst_cond AND sell.islandid = buy.islandid)";
+		}
+		push @dst_conds, $dst_cond;
+	}
+	push @flow_conds, "$src_cond AND (
+			".join("
+		     OR ",@dst_conds)."
+		)";
+}
 
+my $stmt= "		
+	SELECT  sell_islands.islandname				org_name,
+		sell_islands.islandid				org_id,
+		sell.price					org_price,
+		sum(sell.qty) 					org_qty,
+		buy_islands.islandname				dst_name,
+		buy_islands.islandid				dst_id,
+		buy.price					dst_price,
+		sum(buy.qty) 					dst_qty,
+		commods.commodname				commodname,
+		commods.commodid				commodid,
+		commods.unitmass				mass,
+		commods.unitvolume				volume,
+		buy.price - sell.price				unitprofit,
+		min(sell.qty,buy.qty)				tqty,
+		min(sell.qty,buy.qty) * (buy.price-sell.price)	profit
+	FROM commods
+	JOIN buy  on commods.commodid = buy.commodid
+	JOIN sell on commods.commodid = sell.commodid
+	JOIN islands as sell_islands on sell.islandid = sell_islands.islandid
+	JOIN islands as buy_islands  on buy.islandid  = buy_islands.islandid
+	WHERE	(
+		".join("
+	   OR	", @flow_conds)."
+	)
+	  AND	buy.price > sell.price
+	GROUP BY commodname, commods.commodid,
+		org_id, org_price, dst_id, dst_price
+	ORDER BY org_name, dst_name, profit DESC, commodname,
+		 org_price, dst_price DESC
+     ";
+
+my $sth= $dbh->prepare($stmt);
+$sth->execute(@query_params);
+
+</%perl>
+% if ($qa->{'debug'}) {
 <pre>
-Route is as follows:
-
-% foreach my $i (0..$#islandids) {
-%   my $islandid= $islandids[$i];
-%   my $archipelago= $archipelagoes[$i];
-%   $islandid= '<undef>' unless defined $islandid;
-%   $archipelago= '<undef>' unless defined $archipelago;
-%
-  islandid=<% $islandid |h %>  archipelago=<% $archipelago |h %>
-%
+<% $stmt |h %>
+<% join(' | ',@query_params) |h %>
+</pre>
 % }
 
-</pre>
+<& dumpqueryresults, sth =>$sth &>
 
 <%init>
 use CommodsWeb;
-my $dbh= dbw_connect('Midnight');
 </%init>