Break parse_master out into Commods.pm

diff --git a/pctb/Commods.pm b/pctb/Commods.pm
new file mode 100644 (file)
index 0000000..dee9fbe
--- /dev/null
+++ b/pctb/Commods.pm
@@ -0,0 +1,81 @@
+
+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;

diff --git a/pctb/database-info-fetch b/pctb/database-info-fetch
index 0752ae0853d7898707e449e18d98cba33f1378b1..f60c006a6fefef150f9f929a5d23ebbf09c53721 100755 (executable)
--- a/pctb/database-info-fetch
+++ b/pctb/database-info-fetch
@@ -30,6 +30,8 @@ use JSON;
 #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;
 
@@ -39,71 +41,6 @@ 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};