+<%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>
-%# So, add code to do right thing here:
+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 = ?";
+ }
+};
+
+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 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);
+my @flows;
+
+</%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:start, sth => $sth &>
+% my $flow;
+% while ($flow= $sth->fetchrow_hashref()) {
+% push @flows, $flow;
+<& dumpqueryresults:row, sth => $sth, row => $flow &>
+% }
+<& dumpqueryresults:end &>
+
+<%perl>
+
+</%perl>
<%init>
use CommodsWeb;
-my $dbh= dbw_connect('Midnight');
</%init>
~yarrgweb / ypp-sc-tools.web-live.git / blobdiff