#!/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 # # 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 . # # 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 $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__bestprices () { 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 "\nUploading not yet implemented, sorry.\n"; } $mode =~ s/\-//; &{"main__$mode"}; close(STDOUT) or die $!;