Use commas to separate islands in route database for easier editing

[ypp-sc-tools.db-live.git] / pctb / Commods.pm

diff --git a/pctb/Commods.pm b/pctb/Commods.pm
index 712847db34601b6f4395507396f0cdb20da7ebe7..b348c17812373ab72405c9eebdfd8a0a4c56c977 100644 (file)
--- a/pctb/Commods.pm
+++ b/pctb/Commods.pm
@@ -32,7 +32,8 @@ BEGIN {
     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(&parse_masters %oceans %commods %clients
+    @EXPORT      = qw(&parse_masters &parse_masters_ocean
+                     %oceans %commods %clients %routes %route_mysteries
                      &parse_pctb_commodmap %pctb_commodmap @pctb_commodmap
                      &get_our_version &check_tsv_line
                      &pipethrough_prep &pipethrough_run
@@ -47,6 +48,8 @@ BEGIN {
 our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $sources;
 our %commods; # eg $commods{'Fine black cloth'}= $sources;
 our %clients; # eg $clients{'ypp-sc-tools'}= [ qw(last-page) ];
+our %routes; # eg $routes{'Midnight'}{'Orca'}{'Tinga'}= $sources  NB abbrevs!
+our %route_mysteries; # eg $route_mysteries{'Midnight'}{'Norse'}= 3
 # $sources = 's[l]b';
 #       's' = Special Circumstances; 'l' = local ; B = with Bleach
 
@@ -78,6 +81,12 @@ sub parse_master_master1 ($$) {
                    $oceans{$ocean}{$arch}{$_} .= $src;
                };
            });
+       } elsif (m/^routes (\w+)$/) {
+           my $ocean= $1;
+           @ctx= (sub {
+               m/^(\S[^\t]*\S),\s*(\S[^\t]*\S),\s*([1-9][0-9]{0,2})$/ or die;
+               $routes{$ocean}{$1}{$2}= $3;
+           });
        } elsif (m/^client (\S+.*\S)$/) {
            my $client= $1;
            $clients{$client}= [ ];
@@ -111,11 +120,48 @@ sub parse_master_master1 ($$) {
        }
     };
     foreach (@rawcm) { &$ca($_,$src); }
+
+    foreach my $on (keys %routes) {
+       my $routes= $routes{$on};
+       my $ocean= $oceans{$on};
+       die unless defined $ocean;
+       
+       my @allislands;
+       foreach my $an (sort keys %$ocean) {
+           my $arch= $ocean->{$an};
+           push @allislands, sort keys %$arch;
+       }
+       parse_master_map_route_islands($on, \@allislands, $routes);
+       foreach my $route (values %$routes) {
+           parse_master_map_route_islands($on, \@allislands, $route);
+       }
+    }
+}
+
+sub parse_master_map_route_islands ($$$) {
+    my ($on, $allislands, $routemap) = @_;;
+    foreach my $k (sort keys %$routemap) {
+       my @ok= grep { index($_,$k) >= 0 } @$allislands;
+       die "ambiguous $k" if @ok>1;
+       if (!@ok) {
+           $route_mysteries{$on}{$k}++;
+           delete $routemap->{$k};
+       } elsif ($ok[0] ne $k) {
+           $routemap->{$ok[0]}= $routemap->{$k};
+           delete $routemap->{$k};
+       }
+    }
 }
 
 sub parse_masters () {
     parse_master_master1('master-master.txt','s');
 }
+sub parse_masters_ocean ($) {
+    my ($oceanname) = @_;
+    parse_master_master1('master-master.txt','s');
+    die "unknown ocean $oceanname ?" unless exists $oceans{$oceanname};
+    parse_master_master1("ocean-".(lc $oceanname).".txt",'s');
+}
 
 sub parse_pctb_commodmap () {
     undef %pctb_commodmap;