From 3c3e5dc8eae9b239f2dab871a3bd47222af09538 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 19 Jul 2009 21:08:41 +0100 Subject: [PATCH] Put _commodmap.tsv parsing all in Commods.pm --- pctb/Commods.pm | 24 ++++++++++++++- pctb/commod-results-processor | 33 +++++++------------- pctb/database-info-fetch | 34 +-------------------- pctb/decode-pctb-marketdata | 57 ++++++++++++++++++----------------- 4 files changed, 64 insertions(+), 84 deletions(-) diff --git a/pctb/Commods.pm b/pctb/Commods.pm index dee9fbe..6f3a177 100644 --- a/pctb/Commods.pm +++ b/pctb/Commods.pm @@ -1,5 +1,6 @@ package Commods; +use IO::File; use strict; use warnings; @@ -9,7 +10,8 @@ BEGIN { our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = 1.00; @ISA = qw(Exporter); - @EXPORT = qw(%oceans %commods &parse_masters); + @EXPORT = qw(&parse_masters %oceans %commods + &parse_pctb_commodmap %pctb_commodmap @pctb_commodmap); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); @@ -20,6 +22,8 @@ our %commods; # eg $commods{'Fine black cloth'}= $sources; # $sources = 's[l]b'; # 's' = Special Circumstances; 'l' = local ; B = with Bleach +our (%pctb_commodmap,@pctb_commodmap); + my %colours; # eg $colours{'c'}{'black'}= $sources my @rawcm; # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth' @@ -78,4 +82,22 @@ sub parse_masters () { parse_master_master1('master-master.txt','s'); } +sub parse_pctb_commodmap () { + undef %pctb_commodmap; + foreach my $commod (keys %commods) { $commods{$commod} =~ s/b//; } + + my $c= new IO::File '_commodmap.tsv' or die $!; + if (!$c) { $!==&ENOENT or die $!; return 0; } + + while (<$c>) { + m/^(\S.*\S)\t(\d+)\n$/ or die "$_"; + die if defined $pctb_commodmap{$1}; $pctb_commodmap{$1}= $2; + die if defined $pctb_commodmap[$2]; $pctb_commodmap[$2]= $1; + $commods{$1} .= 'b'; + } + $c->error and die $!; + close $c or die $!; + return 1; +} + 1; diff --git a/pctb/commod-results-processor b/pctb/commod-results-processor index 4a70ddf..504f295 100755 --- a/pctb/commod-results-processor +++ b/pctb/commod-results-processor @@ -32,6 +32,8 @@ use POSIX; use LWP::UserAgent; use XML::Parser; +use Commods; + # $commod{'Hemp'}{Buy|Sell}{'stall'}{Stall} # $commod{'Hemp'}{Buy|Sell}{'stall'}{Price} # $commod{'Hemp'}{Buy|Sell}{'stall'}{Qty} @@ -217,23 +219,10 @@ sub main__tsv () { } -our (%commodmap); our ($pctb) = $ENV{'YPPSC_PCTB_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() { die unless $pctb; $pctb =~ s,/*$,,; @@ -245,7 +234,7 @@ sub refresh_commodmap() { my $intag=''; my %got; my $o= new IO::File "_commodmap.tsv.tmp",'w' or die $!; - undef %commodmap; + undef %pctb_commodmap; my $xp= new XML::Parser (Handlers => @@ -275,8 +264,8 @@ sub refresh_commodmap() { my $index= $1; $_= $got{'name'}; s/^\s+//; s/\s+$//; s/\n/ /g; s/\s+/ /; - die "$_ ?" if exists $commodmap{$_}; - $commodmap{$_}= $index; + die "$_ ?" if exists $pctb_commodmap{$_}; + $pctb_commodmap{$_}= $index; print $o "$_\t$index\n" or die $!; } elsif (lc $_ eq $intag) { $got{$intag}= $cdata; @@ -336,8 +325,8 @@ sub bs_gen_md ($$) { my $o= ''; foreach $commod ( - sort { $commodmap{$a} <=> $commodmap{$b} } - grep { exists $commodmap{$_} } + sort { $pctb_commodmap{$a} <=> $pctb_commodmap{$b} } + grep { exists $pctb_commodmap{$_} } keys %commod ) { #print STDERR "COMMOD $commod\n"; @@ -345,7 +334,7 @@ sub bs_gen_md ($$) { my $l= bs_p($commod,$bs,$sortmul); next unless @$l; #print STDERR "COMMOD $commod has ".scalar(@$l)."\n"; - $o .= writeint($commodmap{$commod}); + $o .= writeint($pctb_commodmap{$commod}); $o .= writeint(scalar @$l); foreach my $cs (@$l) { $stall= $cs->{Stall}; @@ -381,14 +370,14 @@ our (%stalltypetoabbrevmap)= qw( sub genmarketdata () { our $version= '005b'; - load_commodmap(); - my @missing= grep { !exists $commodmap{$_} } keys %commod; + parse_pctb_commodmap(); + my @missing= grep { !exists $pctb_commodmap{$_} } keys %commod; if (@missing) { refresh_commodmap(); refresh_newcommods(); my $missing=0; foreach $commod (sort keys %commod) { - next if exists $commodmap{$commod}; + next if exists $pctb_commodmap{$commod}; if (exists $newcommods{$commod}) { printf STDERR "Ignoring new commodity \`%s'!\n", $commod; } else { diff --git a/pctb/database-info-fetch b/pctb/database-info-fetch index f60c006..2e195c7 100755 --- a/pctb/database-info-fetch +++ b/pctb/database-info-fetch @@ -131,16 +131,6 @@ sub for_islands ($$$$) { } } -sub get_commodmap_pctb_local () { - my $f= new IO::File '_commodmap.tsv' or die $!; - while (<$f>) { - m/^(\w[^\t]+\w)\t\d+$/ or die; - $commods{$1} .= 'b'; - } - $f->error and die $!; - close $f or die $!; -} - sub for_commods ($) { my ($forcommod) = @_; foreach my $commod (sort keys %commods) { &$forcommod($commod); } @@ -157,7 +147,7 @@ sub main__comparesources () { parse_masters(); get_arches_islands_pctb($ocean); - get_commodmap_pctb_local(); + parse_pctb_commodmap() or die; for_islands($ocean, sub { }, @@ -194,28 +184,6 @@ sub main__island () { }); } -sub main__allowablecommods ($$) { - my ($ocean,$island) = @_; - parse_masters(); - my $arches= $oceans{$ocean}; - if (!$arches) { print "unknown ocean\n"; exit 1; } - my $found= 0; - foreach my $islands (values %$arches) { - my $sources= $islands->{$island}; - next unless $sources; - die if $found; - $found= $sources; - } - if (!$found) { print "unknown island\n"; exit 1; } - - print "\n"; - foreach my $commod (sort keys %commods) { - print "$commod\n"; - } - STDOUT->error and die $!; - close STDOUT or die $!; -} - sub main__sunshinewidget () { print <) { - m/^(\S.*\S)\t(\d+)$/ or die; - $commodmap[$2]= $1; -} -die $! if CM->error; +parse_pctb_commodmap(); -%stallkinds= qw(A Apothecary - D Distilling - F Furnishing - I Ironworking - S Shipbuilding - T Tailor - W Weaving); +our %stallkinds= qw(A Apothecary + D Distilling + F Furnishing + I Ironworking + S Shipbuilding + T Tailor + W Weaving); sub getline ($) { my ($w)= @_; @@ -54,13 +53,14 @@ sub inmap($\@$) { printf "# Version: \"%s\"\n", getline("version"); -$nstalls= getline("nstalls")+0; +our $nstalls= getline("nstalls")+0; +our @stalls; while (@stalls < $nstalls) { $_= getline("stall name ".(@stalls+1)); if (s/\^([A-Z])$//) { - $kind= $1; - $sk= $stallkinds{$kind}; + my $kind= $1; + my $sk= $stallkinds{$kind}; die "kind $kind in $_ ?" unless defined $sk; $_ .= "'s $sk Stall"; } @@ -70,19 +70,20 @@ unshift @stalls, undef; $|=1; -foreach $bs qw(Buy Sell) { - $alloffers_want= getint("Buy ncommods"); - $alloffers_done=0; +foreach my $bs qw(Buy Sell) { + my $alloffers_want= getint("Buy ncommods"); + my $alloffers_done=0; while ($alloffers_done < $alloffers_want) { - $commodix= getint("Buy $alloffers_done/$alloffers_want commodix"); - $offers= getint("Buy $commodnum offers"); + my $commodix= getint("Buy $alloffers_done/$alloffers_want commodix"); + my $offers= getint("Buy $commodix offers"); + my $offernum; for ($offernum=0; $offernum<$offers; $offernum++) { - $stallix= getint("Buy $commodnum $offernum stallix"); - $price= getint("Buy $commodnum $offernum price"); - $qty= getint("Buy $commodnum $offernum qty"); + my $stallix= getint("Buy $commodix $offernum stallix"); + my $price= getint("Buy $commodix $offernum price"); + my $qty= getint("Buy $commodix $offernum qty"); printf("%s\t%s\t%s", $bs, - inmap('commod',@commodmap,$commodix), + inmap('commod',@pctb_commodmap,$commodix), inmap('stall',@stalls,$stallix)) or die $!; if ($bs eq 'Sell') { print "\t\t" or die $!; } printf("\t%d\t%d", $price, $qty) or die $!; @@ -94,7 +95,7 @@ foreach $bs qw(Buy Sell) { } } -$r= read STDIN,$b,1; +my $r= read STDIN,$b,1; STDIN->error and die $!; STDIN->eof or die; $b and die; -- 2.30.2