From 18c4ed62b79ac9aa7e3f0ec4104068483e03086f Mon Sep 17 00:00:00 2001
From: Ian Jackson <ian@liberator.relativity.greenend.org.uk>
Date: Sun, 7 Jun 2009 19:54:49 +0100
Subject: [PATCH] commodity table processor

---
 pctb/yppsc-commod-processor | 144 ++++++++++++++++++++++++++++++++++++
 1 file changed, 144 insertions(+)
 create mode 100755 pctb/yppsc-commod-processor

diff --git a/pctb/yppsc-commod-processor b/pctb/yppsc-commod-processor
new file mode 100755
index 0000000..981ae92
--- /dev/null
+++ b/pctb/yppsc-commod-processor
@@ -0,0 +1,144 @@
+#!/usr/bin/perl -w
+
+# helper program for processing commodity output
+
+# This is part of ypp-sc-tools, a set of third-party tools for assisting
+# players of Yohoho Puzzle Pirates.
+#
+# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU 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 General Public License for more details.
+#
+# You should have received a copy of the GNU 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.
+
+
+use strict (qw(vars));
+use Data::Dumper;
+
+# $commod{'Hemp'}{Buy|Sell}{'stall'}{Stall}
+# $commod{'Hemp'}{Buy|Sell}{'stall'}{Price}
+# $commod{'Hemp'}{Buy|Sell}{'stall'}{Qty}
+# $commod{'Hemp'}{Hold}
+
+our @v;
+our ($commod,$stall,%commod);
+
+@ARGV==1 or die "You probably don't want to run this program directly.\n";
+our ($mode) = shift @ARGV;
+
+# ./yppsc-commod-processor tsv <t |less -x40,80,90,100,110
+
+sub bs_read ($$) {
+    my ($bs,$c) = @_;
+    return if @v <= $c;
+    my ($price,$qty) = @v[$c..$c+1];
+    return if !length($price) && !length($qty);
+    die "$_ ?" unless length($price) && length($qty);
+    $commod{$commod}{$bs}{$stall}= {
+	Stall => $stall,
+	Price => $price,
+	Qty => $qty,
+    };
+}
+
+while (<>) {
+    chomp;
+    @v= split /\t/;
+#print STDERR "[".join("|",@v)."]\n";
+    ($commod,$stall) = @v;
+    bs_read(Buy,  2);
+    bs_read(Sell, 4);
+    $commod{$commod}{Hold}= $v[6]+0 if @v>6;
+}
+
+our $current;
+
+sub bs_p ($$$) {
+    my ($commod,$bs,$sortmul) = @_;
+    my $ary= $current->{$bs};
+    my $r= [ ];
+#print Dumper($ary);
+    foreach my $stall (sort {
+	$sortmul * ($ary->{$a}{Price} <=> $ary->{$b}{Price});
+    } keys %$ary) {
+	push @$r, $ary->{$stall};
+    }
+    return $r;
+}
+
+sub bs_p_bestprice ($) {
+    my ($l) = @_;
+    if (@$l) {
+	printf("| %-25.25s %4d", $l->[0]{Stall}, $l->[0]{Price}) or die $!;
+    } else {
+	printf("| %25s %4s","","") or die $!;
+    }
+}
+
+our $arbitrage_only= 0;
+
+sub main__arbitrage () {
+    $arbitrage_only= 1;
+    main__bestprice();
+}
+
+sub main__bestprice () {
+    foreach $commod (sort keys %commod) {
+	$current= $commod{$commod};
+	my $buys=  bs_p($commod,Buy, -1);
+	my $sells= bs_p($commod,Sell,+1);
+	if ($arbitrage_only) {
+	    next unless @$buys and @$sells;
+	    next unless $buys->[0]{Price} > $sells->[0]{Price};
+	}
+	printf("%-15.15s", $commod) or die $!;
+	bs_p_bestprice($buys);
+	bs_p_bestprice($sells);
+	print("\n") or die $!;
+    }
+}
+
+sub bs_p_tsv ($) {
+    my ($bs) = @_;
+    if (exists $current->{$bs}{$stall}) {
+	my $si= $current->{$bs}{$stall};
+	printf("\t%d\t%s", $si->{Price}, $si->{Qty}) or die $!;
+    } else {
+	printf("\t\t") or die $!;
+    }
+}
+
+sub main__tsv () {
+    foreach $commod (sort keys %commod) {
+	$current= $commod{$commod};
+	my %stalls;
+	map { $stalls{$_}=1; } keys %{ $current->{Buy}  };
+	map { $stalls{$_}=1; } keys %{ $current->{Sell} };
+	foreach $stall (sort keys %stalls) {
+	    printf("%s\t%s", $commod, $stall) or die $!;
+	    bs_p_tsv(Buy);
+	    bs_p_tsv(Sell);
+	    print("\n") or die $!;
+	}
+    }
+}
+
+sub main__upload () {
+    die "Uploading not yet implemented, sorry\n.";
+}
+
+&{"main__$mode"};
+close(STDOUT) or die $!;
-- 
2.30.2