Put _commodmap.tsv parsing all in Commods.pm

diff --git a/pctb/Commods.pm b/pctb/Commods.pm
index dee9fbed5ab45368da33416d9bf2fe20812b381c..6f3a177ee8870c8ca471521058c4b4d1b0d20728 100644 (file)
--- a/pctb/Commods.pm
+++ b/pctb/Commods.pm
@@ -1,5 +1,6 @@
 
 package Commods;
 
 package Commods;

+use IO::File;

 
 use strict;
 use warnings;
 
 use strict;
 use warnings;


@@ -9,7 +10,8 @@ BEGIN {
     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
     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();
     %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
 
 # $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'
 
 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');
 }
 
     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;
 1;

diff --git a/pctb/commod-results-processor b/pctb/commod-results-processor
index 4a70ddf7767376ab8b9db5406750c257460e9c3c..504f295930f572f71b0c46020b505e6e2a9de9a1 100755 (executable)
--- a/pctb/commod-results-processor
+++ b/pctb/commod-results-processor
@@ -32,6 +32,8 @@ use POSIX;
 use LWP::UserAgent;
 use XML::Parser;
 
 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}
 # $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;
 
 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,/*$,,;
 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 $!;
     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 =>
 
     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+/ /;
                     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;
                     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 (
     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";
                     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";
        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};
        $o .= writeint(scalar @$l);
        foreach my $cs (@$l) {
            $stall= $cs->{Stall};


@@ -381,14 +370,14 @@ our (%stalltypetoabbrevmap)= qw(
 sub genmarketdata () {
     our $version= '005b';
 
 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) {
     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 {
            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 f60c006a6fefef150f9f929a5d23ebbf09c53721..2e195c7a01b2d06471b540a3201721a39701aad2 100755 (executable)
--- 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); }
 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);
     
     parse_masters();
     get_arches_islands_pctb($ocean);

-    get_commodmap_pctb_local();
+    parse_pctb_commodmap() or die;

 
     for_islands($ocean,
                sub { },
 
     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 <<END
 Land {On land} {
 sub main__sunshinewidget () {
     print <<END
 Land {On land} {

diff --git a/pctb/decode-pctb-marketdata b/pctb/decode-pctb-marketdata
index 6cdecc658d1e2065237e9f12c6aeea025adcdb12..f7af70dbf200104883e6b9ce392bd45ca5dd9773 100755 (executable)
--- a/pctb/decode-pctb-marketdata
+++ b/pctb/decode-pctb-marketdata
@@ -1,27 +1,26 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w

 
 # This specific file is hereby placed in the public domain, or nearest
 # equivalent in law, by me, Ian Jackson.  5th July 2009.
 
 
 # This specific file is hereby placed in the public domain, or nearest
 # equivalent in law, by me, Ian Jackson.  5th July 2009.
 

-use IO::Handle;
+use IO::File;
+use strict (qw(vars));

 
 

-open CM, "_commodmap.tsv" or die $!;
+use Commods;
+
+our ($debug)= 0;

 
 $debug=1 if @ARGV;
 
 
 $debug=1 if @ARGV;
 

-while (<CM>) {
-    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)= @_;
 
 sub getline ($) {
     my ($w)= @_;


@@ -54,13 +53,14 @@ sub inmap($\@$) {
     
 
 printf "# Version: \"%s\"\n", getline("version");
     
 
 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])$//) {
 
 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";
     }
        die "kind $kind in $_ ?" unless defined $sk;
        $_ .= "'s $sk Stall";
     }


@@ -70,19 +70,20 @@ unshift @stalls, undef;
 
 $|=1;
 
 
 $|=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)  {
     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++) {
        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,
            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 $!;
                   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;
 STDIN->error and die $!;
 STDIN->eof or die;
 $b and die;