--- /dev/null
+
+package Commods;
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Exporter ();
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+ $VERSION = 1.00;
+ @ISA = qw(Exporter);
+ @EXPORT = qw(%oceans %commods &parse_masters);
+ %EXPORT_TAGS = ( );
+
+ @EXPORT_OK = qw();
+}
+
+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
+
+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');
+}
+
+1;
#use Data::Dumper;
use IO::File;
+use Commods;
+
@ARGV>=1 or die "You probably don't want to run this program directly.\n";
our ($which) = shift @ARGV;
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};