package Commods;
+use IO::File;
use strict;
use warnings;
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();
# $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'
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;
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}
}
-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,/*$,,;
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 $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;
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";
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};
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 {
}
}
-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); }
parse_masters();
get_arches_islands_pctb($ocean);
- get_commodmap_pctb_local();
+ parse_pctb_commodmap() or die;
for_islands($ocean,
sub { },
});
}
-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} {
-#!/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.
-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;
-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)= @_;
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";
}
$|=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 $!;
}
}
-$r= read STDIN,$b,1;
+my $r= read STDIN,$b,1;
STDIN->error and die $!;
STDIN->eof or die;
$b and die;