WIP our own database

diff --git a/pctb/database-info-fetch b/pctb/database-info-fetch
index 3b8db77c4209b05f9537b34f29e744a354d1b855..8b464a125b9026f01eb0468fe2cac3a34ba8ace2 100755 (executable)
--- a/pctb/database-info-fetch
+++ b/pctb/database-info-fetch
@@ -28,6 +28,7 @@ use strict (qw(vars));
 use LWP::UserAgent;
 use JSON;
 use Data::Dumper;
 use LWP::UserAgent;
 use JSON;
 use Data::Dumper;

+use IO::File;

 
 @ARGV==1 or die "You probably don't want to run this program directly.\n";
 our ($which) = shift @ARGV;
 
 @ARGV==1 or die "You probably don't want to run this program directly.\n";
 our ($which) = shift @ARGV;


@@ -38,6 +39,71 @@ our ($pctb) = $ENV{'YPPSC_PCTB_PCTB'};  die unless $pctb;
 our ($ua)= LWP::UserAgent->new;
 our $jsonresp;
 
 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 jparsetable ($$) {
     my ($jobj,$wh) = @_;
     my $jtab= $jobj->{$wh};


@@ -79,8 +145,8 @@ sub json_convert_shim ($) {
     }
 }
 
     }
 }
 

-sub get_arches_islands () {
-    my $ocean= $ENV{'YPPSC_OCEAN'};  die unless $ocean;
+sub get_arches_islands_pctb ($) {
+    my ($ocean)= @_;

     my $url= "$pctb/islands.php?oceanName=".uc $ocean;
     my $resp= $ua->get($url);
     die $resp->status_line unless $resp->is_success;
     my $url= "$pctb/islands.php?oceanName=".uc $ocean;
     my $resp= $ua->get($url);
     die $resp->status_line unless $resp->is_success;


@@ -88,30 +154,108 @@ sub get_arches_islands () {
     my $jobj= json_convert_shim($resp->content);
     my $arches= [ jparsetable($jobj, 'arches') ];
     my $islands= [ jparsetable($jobj, 'islands') ];
     my $jobj= json_convert_shim($resp->content);
     my $arches= [ jparsetable($jobj, 'arches') ];
     my $islands= [ jparsetable($jobj, 'islands') ];

-    return ($arches,$islands);
-}

 
 

-sub main__island () {
-    my ($arches, $islands) = get_arches_islands();
-#    print Dumper(\@arches, \@islands);

     my $islands_done=0;
     my $islands_done=0;

-    foreach my $arch (sort_by_name(@$arches)) {
-#      print Dumper($arch);
+    foreach my $arch (@$arches) {
+#      print Dumper($arnch);

        my $aname= $arch->{'name'};
        die "$jsonresp ?" unless defined $aname;
        my $aname= $arch->{'name'};
        die "$jsonresp ?" unless defined $aname;

-       ptcl($aname); p(' '); ptcl($aname); p(" {\n");
-       foreach my $island (sort_by_name(@$islands)) {
+
+       foreach my $island (@$islands) {

            my $iname= $island->{'name'};
            die "$jsonresp $aname ?" unless defined $iname;
            next unless $arch->{'id'} == $island->{'arch'};
            my $iname= $island->{'name'};
            die "$jsonresp $aname ?" unless defined $iname;
            next unless $arch->{'id'} == $island->{'arch'};

-           p('    '); ptcl($iname); p(' '); ptcl($iname); p("\n");
+
+           $oceans{$ocean}{$aname}{$iname} .= 'b';
+           

            $islands_done++;
        }
            $islands_done++;
        }

-       p("}\n");

     }
     die "$jsonresp $islands_done ?" unless $islands_done == @$islands;
 }
 
     }
     die "$jsonresp $islands_done ?" unless $islands_done == @$islands;
 }
 

+sub get_ocean () {
+    my $ocean= $ENV{'YPPSC_OCEAN'};  die unless $ocean;
+    return ucfirst lc $ocean;
+}
+
+sub for_islands ($$$$) {
+    my ($ocean,$forarch,$forisle,$endarch) = @_;
+
+    my $arches= $oceans{$ocean};
+    foreach my $aname (sort keys %$arches) {
+       &$forarch($ocean,$aname);
+       my $islands= $arches->{$aname};
+       foreach my $iname (sort keys %$islands) {
+           &$forisle($ocean,$aname,$iname);
+       }
+       &$endarch();
+    }
+}
+
+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 compare_sources_one ($$) {
+    my ($srcs,$what) = @_;
+    return if $srcs =~ m,^sl?(?:\%sl?)*b$,;
+    print "srcs=$srcs $what\n";
+}
+
+sub main__comparesources () {
+    my $ocean= get_ocean();
+    
+    parse_masters();
+    get_arches_islands_pctb($ocean);
+    get_commodmap_pctb_local();
+
+    for_islands($ocean,
+               sub { },
+               sub {
+                   my ($ocean,$a,$i)= @_;
+                   my $srcs= $oceans{$ocean}{$a}{$i};
+                   compare_sources_one($srcs, "island $ocean / $a / $i");
+               },
+               sub { });
+    for_commods(sub {
+                   my ($commod)= @_;
+                   my $srcs= $commods{$commod};
+                   compare_sources_one($srcs, "commodity $commod");
+               });
+}
+
+sub main__island () {
+    my $ocean= get_ocean();
+    
+    parse_masters();
+    get_arches_islands_pctb($ocean);
+
+    for_islands($ocean,
+               sub {
+                   my ($ocean,$aname)= @_;
+                   ptcl($aname); p(' '); ptcl($aname); p(" {\n");
+               },
+               sub {
+                   my ($ocean,$aname,$iname)= @_;
+                   p('    '); ptcl($iname); p(' '); ptcl($iname); p("\n");
+               },
+               sub {
+                   p("}\n");
+               });
+}
+

 sub main__sunshinewidget () {
     print <<END
 Land {On land} {
 sub main__sunshinewidget () {
     print <<END
 Land {On land} {

diff --git a/pctb/master-master.txt b/pctb/master-master.txt
new file mode 100644 (file)
index 0000000..b1fe2df
--- /dev/null
+++ b/pctb/master-master.txt
@@ -0,0 +1,165 @@
+
+commods
+ %c dye
+ %c enamel
+ %c paint
+
+ %c cloth
+ fine %c cloth
+
+ %g gems
+
+%c
+ aqua
+ black
+ blue
+ brown
+ gold
+ green
+ grey
+ lavender
+ lemon
+ light blue
+ light green
+ lime
+ magenta
+ maroon
+ mint
+ navy
+ orange
+ peach
+ persimmon
+ pink
+ purple
+ red
+ rose
+ tan
+ violet
+ white
+ yellow
+
+%g
+ amber
+ amethyst
+ beryl
+ coral
+ jade
+ jasper
+ jet
+ lapis lazuli
+ quartz
+ tigereye
+
+commods
+ bananas
+ broom flower
+ butterfly weed
+ carambolas
+ chalcocite
+ coconuts
+ cowslip
+ cubanite
+ diamonds
+ durians
+ elderberries
+ emeralds
+ fine rum
+ gold nuggets
+ gold ore
+ grog
+ hemp
+ hemp oil
+ indigo
+ iris root
+ iron
+ kraken's blood
+ lacquer
+ large cannon balls
+ leushite
+ lily of the valley
+ limes
+ lobelia
+ lorandite
+ madder
+ mangos
+ masuyite
+ medium cannon balls
+ moonstones
+ nettle
+ old man's beard
+ opals
+ papagoite
+ passion fruit
+ pearls
+ pineapples
+ pokeweed berries
+ pomegranates
+ rambutan
+ rubies
+ sail cloth
+ sapphires
+ sassafras
+ serandite
+ sincosite
+ small cannon balls
+ stone
+ sugar cane
+ swill
+ tellurium
+ thorianite
+ topazes
+ varnish
+ weld
+ wood
+ yarrow
+
+ocean Midnight
+ Coral
+  Angelfish Island
+  Delta Island
+  Meke Island
+  Park Island
+ Diamond
+  Alpha Island
+  Byrne Island
+  Cnossos Island
+  Oyster Island
+  Papaya Island
+  Turtle Island
+  Winter Solstice
+ Emerald
+  Emperor Island
+  Epsilon Island
+  Gaea Island
+  Guava Island
+  Spring Island
+  Tinga Island
+  Wrasse Island
+ Jet
+  Chaparral Island
+  Eclipse Island
+  Hephaestus' Forge
+  Lagniappe Island
+  Namath Island
+  Xi Island
+ Opal
+  Endurance Island
+  Nu Island
+  Orca Island
+  Waterberry
+ Pearl
+  Cleopatra's Pearls
+  Frond Island
+  Ostreum Island
+  Zeta Island
+ Ruby
+  Eta Island
+  Cranberry Island
+  Islay of Luthien
+  Jorvik Island
+  Midsummer
+ Sapphire
+  Beta Island
+  Iris Island
+  Remora Island
+  Vernal Equinox