X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.web-live.git;a=blobdiff_plain;f=pctb%2Fyppsc-commod-processor;fp=pctb%2Fyppsc-commod-processor;h=0000000000000000000000000000000000000000;hp=32763293ac705f6128cd88a7312000ce296501ae;hb=e888c1dd3476ca49bccf82b93b4a3633587d400d;hpb=6a3c0962283d32bc6e5f6c47c929baf37ddc642f diff --git a/pctb/yppsc-commod-processor b/pctb/yppsc-commod-processor deleted file mode 100755 index 3276329..0000000 --- a/pctb/yppsc-commod-processor +++ /dev/null @@ -1,387 +0,0 @@ -#!/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 HTTP::Request; -use IO::File; -use POSIX; -use LWP::UserAgent; -use XML::Parser; - -# $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 $!; - } -} - -sub main__arbitrage () { - my @arbs= (); - foreach $commod (sort keys %commod) { - $current= $commod{$commod}; - my @buys= @{ bs_p($commod,Buy, -1) }; - my @sells= @{ bs_p($commod,Sell,+1) }; - my $profit= 0; - my $cqty= 0; - my $info= ''; - my $arbs= []; - for (;;) { -#print Dumper($commod,\@buys,\@sells); - last unless @buys; - last unless @sells; - my $pricediff= $buys[0]{Price} - $sells[0]{Price}; - last unless $pricediff > 0; - our $qty= 1000; - sub arb_check_qty (\@) { - my ($verbs) = @_; - my $vqty= $verbs->[0]{Qty}; - return if $vqty =~ m/^\>/; - $qty= $vqty if $qty > $vqty; - return if $vqty; - my $verb= shift @$verbs; - } - arb_check_qty(@buys); - arb_check_qty(@sells); - next unless $qty; - my $tprofit= $qty*$pricediff; - $profit += $tprofit; - $cqty += $qty; - - $info.= - sprintf("%-13.13s| %-19.19s %4d| %-19.19s %4d|%3d x%3d =%3d\n", - $commod, - $buys[0]{Stall},$buys[0]{Price}, - $sells[0]{Stall},$sells[0]{Price}, - $qty, $pricediff, $tprofit); - sub arb_subtract_qty (\@) { - my ($verbs) = @_; - my $verb= shift @$verbs; - unshift @$verbs, { - Stall => $verb->{Stall}, - Price => $verb->{Price}, - Qty => $verb->{Qty} - $qty - }; - } - arb_subtract_qty(@buys); - arb_subtract_qty(@sells); - } - next unless $profit; - $info.= - sprintf("%-13.13s| %19s %4s| %19s %4s|%3d %4d\n", - $commod, '','', '','', $cqty, $profit); - push @arbs, { Profit => $profit, Info => $info }; - } - my $allprofit; - - if (!@arbs) { - print "No arbitrage opportunities.\n" or die $!; - return; - } - my $bigdiv= <{Profit} <=> $a->{Profit}; - } @arbs) { - print $div,$arb->{Info} or die $1; - $div= <{Profit}; - } - print $bigdiv or die $!; - printf("%-13.13s %19s %4s %19s %4s %-5s %7d\n", - '', '','', '','', 'TOTAL', $allprofit) - or die $!; -} - -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); - 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 $!; - } - } -} - - -our (%commodmap); -our ($pctb) = $ENV{'YPPSC_PCTB_PCTB'}; die unless $pctb; - -our ($ua)= LWP::UserAgent->new; - -sub load_commodmap() { - undef %commodmap; - my $c= new IO::File "#commodmap#.tsv"; - if (!$c) { $!==&ENOENT or die $!; return; } - while (<$c>) { - m/^(\S.*\S)\t(\d+)\n$/ or die "$_"; - $commodmap{$1}= $2; - } - $c->error and die $!; - close $c; -} - -sub refresh_commodmap() { - my $resp= $ua->get("$pctb/commodmap.php?version=2"); - die $resp->status_line unless $resp->is_success; - - my $cdata=''; - my $incommodmap=0; - my $intag=''; - my %got; - my $o= new IO::File "#commodmap#.tsv.new",'w' or die $!; - undef %commodmap; - - my $xp= new XML::Parser - (Handlers => - { - Start => sub { - $_=$_[1]; -#print STDERR "START [$_] intag=$intag icm=$incommodmap\n"; - if (m/^commodmap$/i) { - $incommodmap++; - undef %got; - } elsif (m/^(?:name|index)$/i) { - $cdata=''; - $intag=lc($_) if $incommodmap; -#print STDERR "START RECOGNISED $intag icm=$incommodmap\n"; -# } else { -#print STDERR "START UNRECOGNISED\n"; - } - }, - End => sub { - $_=$_[1]; -#print STDERR "END [$_] intag=$intag icm=$incommodmap\n"; - if (m/^commodmap$/i) { - $incommodmap--; - die unless exists $got{'name'}; - die unless exists $got{'index'}; - die unless $got{'index'} =~ m/^\s*([1-9]\d{0,3})\s*$/; - my $index= $1; - $_= $got{'name'}; - s/^\s+//; s/\s+$//; s/\n/ /g; s/\s+/ /; - die "$_ ?" if exists $commodmap{$_}; - $commodmap{$_}= $index; - print $o "$_\t$index\n" or die $!; - } elsif (lc $_ eq $intag) { - $got{$intag}= $cdata; - } - }, - Char => sub { -#print STDERR "CHAR [$_[1]] intag=$intag icm=$incommodmap\n"; - $cdata .= $_[1]; - } - }) or die; - my $content= $resp->content; - -# print STDERR "[[[$content]]]\n"; - $xp->parse($content); - close $o or die $!; - rename "#commodmap#.tsv.new","#commodmap#.tsv" or die $!; -} - -our (%stallmap, @stallmap); - -sub bs_gen_md ($$) { - my ($bs,$sortmul) = @_; - my $count= 0; - my $o= ''; - - foreach $commod (sort { - $commodmap{$a} <=> $commodmap{$b} - } keys %commod) { -#print STDERR "COMMOD $commod\n"; - $current= $commod{$commod}; - my $l= bs_p($commod,$bs,$sortmul); - next unless @$l; -#print STDERR "COMMOD $commod has ".scalar(@$l)."\n"; - $o .= writeint($commodmap{$commod}); - $o .= writeint(scalar @$l); - foreach my $cs (@$l) { - $stall= $cs->{Stall}; - my $stallix= $stallmap{$stall}; - if (!defined $stallix) { - push @stallmap, $stall; - $stallmap{$stall}= $stallix= @stallmap; -#print STDERR "STALL DEF $stallix $stall\n"; - } - my $qty= $cs->{Qty}; - $qty =~ s/^\>\s*//; - $o .= writeint($stallix, $cs->{Price}, $qty+0); - $count++; - } - } -#print STDERR "COMMOD $commod COUNT WAS $count\n"; - return - writeint($count).$o; -} - -sub writeint { return pack 'v*', @_; } - -sub genmarketdata () { - our $version= '005b'; - - load_commodmap(); - my @missing= grep { !exists $commodmap{$_} } keys %commod; - if (@missing) { - refresh_commodmap(); - my $missing=0; - foreach $commod (sort keys %commod) { - next if exists $commodmap{$commod}; - printf STDERR "Unknown commodity \`%s'!\n", $commod; - $missing++; - } - die "$missing unknown commoditi(es). OCR failure?\n" - if $missing; - } - - my $ob=''; - $ob .= bs_gen_md(Buy, -1); - $ob .= bs_gen_md(Sell,+1); - - my $ot= sprintf("$version\n". - "%d\n", - scalar(@stallmap)); - foreach $stall (@stallmap) { $ot .= "$stall\n"; } - return $ot.$ob; -} - -sub main__genmarketdata () { - my $o= genmarketdata(); - print $o or die $!; -} - -sub main__upload () { - my $o= genmarketdata(); - my $url= "$pctb/upload.php"; - $url= "http://www.chiark.greenend.org.uk/ucgi/~ijackson/check/upload.php"; - my $content= { - 'marketdata' => [ undef, "marketdata.gz", - Content_Type => 'application/gzip', - Content => $o - ] - }; - my $resp= $ua->post("$url", Content => $content, - Content_Type => 'form-data'); - die $resp->status_line unless $resp->is_success; - - print "[[ ",$resp->content," ]]\n"; -} - - -$mode =~ s/\-//; -&{"main__$mode"}; -close(STDOUT) or die $!;