commodity table processor

diff --git a/pctb/yppsc-commod-processor b/pctb/yppsc-commod-processor
new file mode 100755 (executable)
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 $!;