better error messages from pipethrough_*

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

diff --git a/pctb/Commods.pm b/pctb/Commods.pm
index 712847db34601b6f4395507396f0cdb20da7ebe7..d9a2a948155c314692a9c83d46fe7daeea7cfa09 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;
@@ -160,14 +206,14 @@ sub pipethrough_run_along ($$$@) {
     if (!$child) {
        open STDIN, "<&", $tf;
        &$childprep() if defined $childprep;
-       exec $cmd @a; die $!;
+       exec $cmd @a; die "@a $!";
     }
     return $fh;
 }
-sub pipethrough_run_finish ($) {
-    my ($fh)= @_;
+sub pipethrough_run_finish ($$) {
+    my ($fh, $what)= @_;
     $fh->error and die $!;
-    close $fh or die "$! $?";  die $? if $?;
+    close $fh or die "$what $! $?";  die $? if $?;
 }
 
 sub pipethrough_run ($$$@) {
@@ -176,7 +222,7 @@ sub pipethrough_run ($$$@) {
     my $r;
     { undef $/; $!=0; $r= <$pt>; }
     defined $r or die $!;
-    pipethrough_run_finish($pt);
+    pipethrough_run_finish($pt, "@a");
     return $r;
 }
 sub pipethrough_run_gzip ($) {
@@ -246,6 +292,14 @@ sub check_tsv_line ($$) {
        $f =~ m/^(|0|[1-9][0-9]{0,5}|\>1000)$/ or &$bad_data("bad field $i");
        ($i % 2) or ($f !~ m/\>/) or &$bad_data("> in field $i price");
     }
+
+    foreach my $i (2,4) {
+       &$bad_data("price with no qty or vice versa (field $i)")
+           if length($v[$i]) xor length($v[$i+1]);
+    }
+    length($v[2]) or length($v[4]) or
+       &$bad_data("commodity entry with no buy or sell offer");
+    
     return @v;
 }