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;h=2083be17221c1037db72151526b999b9b310ea88;hp=9bb0d71fb1229972fdacfa2c172d2056784e95ac;hb=f805d3a20cb1d7d551b0537c83a87ee3a83f85c9;hpb=a5c969e80989ea2c678a99b46e7db08ae553e59d diff --git a/pctb/yppsc-commod-processor b/pctb/yppsc-commod-processor index 9bb0d71..2083be1 100755 --- a/pctb/yppsc-commod-processor +++ b/pctb/yppsc-commod-processor @@ -26,7 +26,11 @@ use strict (qw(vars)); -use Data::Dumper; +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} @@ -88,11 +92,91 @@ sub bs_p_bestprice ($) { } } -our $arbitrage_only= 0; - sub main__arbitrage () { - $arbitrage_only= 1; - main__bestprice(); + 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 () { @@ -100,10 +184,6 @@ sub main__bestprices () { $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); @@ -136,10 +216,159 @@ sub main__tsv () { } } + +our (%commodmap); +our ($pctb) = 'http://pctb.ilk.org/'; +our ($ua); + +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 $ua= LWP::UserAgent->new; + my $resp= $ua->get("$pctb/commodmap.php"); + 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; + + # hacks to strip off drivel that seems to have been added! + $content =~ s/^.*\n(\<\?xml)/$1/s; + $content =~ s/\<\/body\>.*//s; +# 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 @$l\n"; + + $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; + } + 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 main__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 $o=''; + $o .= bs_gen_md(Buy, -1); + $o .= bs_gen_md(Sell,+1); + + printf("$version\n". + "%d\n", + scalar(@stallmap)) + or die $!; + foreach $stall (@stallmap) { print "$stall\n" or die $!; } + + print $o or die$!; +} + + sub main__upload () { die "\nUploading not yet implemented, sorry.\n"; } + $mode =~ s/\-//; &{"main__$mode"}; close(STDOUT) or die $!;