use strict (qw(vars));
use LWP::UserAgent;
use JSON;
-use Data::Dumper;
+#use Data::Dumper;
use IO::File;
-@ARGV==1 or die "You probably don't want to run this program directly.\n";
+use Commods;
+
+@ARGV>=1 or die "You probably don't want to run this program directly.\n";
our ($which) = shift @ARGV;
$which =~ s/\W//g;
-our ($pctb) = $ENV{'YPPSC_PCTB_PCTB'}; die unless $pctb;
+our ($pctb) = $ENV{'YPPSC_PCTB_PCTB'};
our ($ua)= LWP::UserAgent->new;
our $jsonresp;
-our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources
-our %commods; # eg $commods{'Fine black cloth'}= $sources;
-# $sources = 's[l]b';
-# 's' = Special Circumstances; 'l' = local ; B = with Bleach
-
-BEGIN {
- my %colours; # eg $colours{'c'}{'black'}= $sources
- my @rawcm; # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth'
-
- sub parse_master_master1 ($$) {
- my ($mmfn,$src)= @_;
- my $mm= new IO::File $mmfn, 'r' or die "$mmfn $!";
- my @ctx= ();
- while (<$mm>) {
- next if m/^\s*\#/;
- next unless m/\S/;
- s/\s+$//;
- if (m/^\%(\w+)$/) {
- my $colourkind= $1;
- @ctx= (sub { $colours{$colourkind}{lc $_} .= $src; });
- } elsif (m/^commods$/) {
- @ctx= (sub { push @rawcm, lc $_; });
- } elsif (m/^ocean (\w+)$/) {
- my $ocean= $1;
- @ctx= (sub {
- $ocean or die; # ref to $ocean needed to work
- # around a perl bug
- my $arch= $_;
- $ctx[1]= sub {
- $oceans{$ocean}{$arch}{$_} .= $src;
- };
- });
- } elsif (s/^ +//) {
- my $indent= length $&;
- die "wrong indent $indent" unless defined $ctx[$indent-1];
- &{ $ctx[$indent-1] }();
- } else {
- die "bad syntax";
- }
- }
- $mm->error and die $!;
- close $mm or die $!;
-
-#print Dumper(\%oceans);
-print Dumper(\@rawcm);
-
- %commods= ();
- my $ca;
- $ca= sub {
- my ($s,$ss) = @_;
-#print "ca($s)\n";
- if ($s !~ m/\%(\w+)/) { $commods{ucfirst $s} .= $ss; return; }
- die "unknown $&" unless defined $colours{$1};
- foreach my $c (keys %{ $colours{$1} }) {
- &$ca($`.$c.$', $ss .'%'. $colours{$1}{$c});
- }
- };
- foreach (@rawcm) { &$ca($_,$src); }
- }
-}
-
-sub parse_masters () {
- parse_master_master1('master-master.txt','s');
-}
-
sub jparsetable ($$) {
my ($jobj,$wh) = @_;
my $jtab= $jobj->{$wh};
sub get_arches_islands_pctb ($) {
my ($ocean)= @_;
+ die unless $pctb;
my $url= "$pctb/islands.php?oceanName=".uc $ocean;
my $resp= $ua->get($url);
die $resp->status_line unless $resp->is_success;
}
}
-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 { },
or die $!;
}
-&{"main__$which"}();
+&{"main__$which"}(@ARGV);