X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;ds=sidebyside;f=pctb%2FCommods.pm;fp=pctb%2FCommods.pm;h=75d48c4ee9d2ed707d4da20268274cdbfe474546;hb=e3bd945bfba693d7467f28a2c59e77219387caa9;hp=712847db34601b6f4395507396f0cdb20da7ebe7;hpb=5c448a7c813853cb34ce8006bb6a544fbb15b2be;p=ypp-sc-tools.db-test.git

diff --git a/pctb/Commods.pm b/pctb/Commods.pm
index 712847d..75d48c4 100644
--- 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)\t+(\S[^\t]*\S)\t+([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;