X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2Fcommod-results-processor;h=d427f74b41d10a51bcc2ed8fee3ae525a78e2fc2;hp=37484d6ef6ff071172036578b55a1eef3d2bb301;hb=HEAD;hpb=ef3dad0114d29a0c300eea4a8e1cf6d8e6e68453 diff --git a/yarrg/commod-results-processor b/yarrg/commod-results-processor index 37484d6..fe05fb8 100755 --- a/yarrg/commod-results-processor +++ b/yarrg/commod-results-processor @@ -24,6 +24,7 @@ # are used without permission. This program is not endorsed or # sponsored by Three Rings. +BEGIN { unshift @INC, qw(.) } use strict (qw(vars)); use HTTP::Request; @@ -39,7 +40,7 @@ use Commods; # $commod{'Hemp'}{Hold} our @v; -our ($commod,$stall,%commod); +our ($commod,$stall,%commod,@commods_inorder); @ARGV==1 or die "You probably don't want to run this program directly.\n"; our ($mode) = shift @ARGV; @@ -69,6 +70,7 @@ while (<>) { die "$_ ?" if m/.\D/; } ($commod,$stall) = @v; + push @commods_inorder, $commod unless exists $commod{$commod}; bs_read(Buy, 2); bs_read(Sell, 4); $commod{$commod}{Hold}= $v[6]+0 if @v>6; @@ -234,6 +236,41 @@ sub main__tsv () { write_tsv(\*STDOUT,1); } +sub undef_printable { my ($ov)= @_; defined $ov ? $ov : '?'; }; + +sub commodsinorder_print1 ($$) { + my ($keyword,$commod) = @_; + printf("%s\t%-40s %10s %s", + $keyword, + $commod, + undef_printable($commods{$commod}{Ordval}), + undef_printable($commods{$commod}{Class})) + or die $!; +} + +sub main__commodsinorder () { + parse_info_serverside(); + my $last_ov; + foreach my $commod (@commods_inorder) { + my $ov= $commods{$commod}{Ordval}; + commodsinorder_print1('found',$commod); + if (defined $ov) { + if (defined $last_ov && $ov <= $last_ov) { + print " out-of-order" or die $!; + } + $last_ov= $ov; + } + print "\n" or die $!; + } + foreach my $commod (sort { + undef_printable($commods{$a}{Ordval}) cmp + undef_printable($commods{$b}{Ordval}) + } keys %commods) { + next if exists $commod{$commod}; + commodsinorder_print1('none',$commod); + print "\n" or die $!; + } +} our ($pctb) = $ENV{'YPPSC_YARRG_PCTB'}; @@ -514,19 +551,17 @@ sub main__uploadpctb () { my $islandid; while ($resptxt =~ - m/^islands\[\d+\]\[\d+\]\=new\s+option\(\"(.*)\"\,(\d+)\)\s*$/mig + m/^islands\[(\d+)\]\[\d+\]\=new\s+option\(\"(.*)\"\,(\d+)\)\s*$/mig ) { - next unless $1 eq $island; - $islandid= $2; + next unless $1 eq $oceanids[0]; + next unless $2 eq $island; + $islandid= $3; } defined $islandid or die; die "@filenames ?" if grep { $_ ne $filename } @filenames; die "@forcerls ?" if grep { $_ ne $forcerl } @forcerls; - my $setisland= { - }; - print STDERR "Setting ocean and island...\n"; my $siurl= ($url . "?action=setisland".