X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.db-test.git;a=blobdiff_plain;f=yarrg%2FCommods.pm;h=f2823136fc69b89bb727af177e445055cfcfb3db;hp=955446f402f48719943af31844cc17e9742649a1;hb=b020a18c3378347bc1469caad80ab22a5ea6a0a4;hpb=c68fb80a6bbf7acbcac4b2cb2143f5fea745cd2b

diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm
index 955446f..f282313 100644
--- a/yarrg/Commods.pm
+++ b/yarrg/Commods.pm
@@ -23,6 +23,7 @@
 package Commods;
 use IO::File;
 use HTTP::Request::Common ();
+use POSIX;
 
 use strict;
 use warnings;
@@ -32,14 +33,15 @@ BEGIN {
     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(&parse_masters &parse_masters_ocean
+    @EXPORT      = qw(&parse_info_clientside &fetch_with_rsync
+		      &parse_info_serverside &parse_info_serverside_ocean
 		      %oceans %commods %clients %routes %route_mysteries
 		      &parse_pctb_commodmap %pctb_commodmap @pctb_commodmap
 		      &get_our_version &check_tsv_line
 		      &pipethrough_prep &pipethrough_run
 		      &pipethrough_run_along &pipethrough_run_finish
 		      &pipethrough_run_gzip
-		      &cgipostform);
+		      &cgipostform &yarrgpostform &cgi_get_caller);
     %EXPORT_TAGS = ( );
 
     @EXPORT_OK   = qw();
@@ -58,7 +60,7 @@ our (%pctb_commodmap,@pctb_commodmap);
 my %colours; # eg $colours{'c'}{'black'}= $sources
 my @rawcm; # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth'
 
-sub parse_master_master1 ($$) {
+sub parse_info1 ($$) {
     my ($mmfn,$src)= @_;
     my $mm= new IO::File $mmfn, 'r' or die "$mmfn $!";
     my @ctx= ();
@@ -131,14 +133,43 @@ sub parse_master_master1 ($$) {
 	    my $arch= $ocean->{$an};
 	    push @allislands, sort keys %$arch;
 	}
-	parse_master_map_route_islands($on, \@allislands, $routes);
+	parse_info_maproutes($on, \@allislands, $routes);
 	foreach my $route (values %$routes) {
-	    parse_master_map_route_islands($on, \@allislands, $route);
+	    parse_info_maproutes($on, \@allislands, $route);
 	}
     }
 }
 
-sub parse_master_map_route_islands ($$$) {
+sub parse_info_clientside () {
+    my $yarrg= $ENV{'YPPSC_YARRG_DICT_UPDATE'};
+    return unless $yarrg;
+    my $master= fetch_with_rsync('info');
+    parse_info1($master,'s');
+    my $local= '_local-info.txt';
+    if (stat $local) {
+	parse_info1($local,'s');
+    } else {
+	die "$local $!" unless $! == &ENOENT;
+    }
+}
+
+sub fetch_with_rsync ($) {
+    my ($stem) = @_;
+
+    my $rsync= $ENV{'YPPSC_YARRG_RSYNC'};
+    $rsync= 'rsync' if !defined $rsync;
+
+    my $local= "_master-$stem.txt";
+    my $src= $ENV{'YPPSC_YARRG_DICT_UPDATE'};
+    if ($src) {
+	my $remote= "$src/master-$stem.txt";
+	$!=0; system 'rsync','-Lt','--',$remote,$local;
+	die "$? $!" if $! or $?;
+    }
+    return $local;
+}
+
+sub parse_info_maproutes ($$$) {
     my ($on, $allislands, $routemap) = @_;;
     foreach my $k (sort keys %$routemap) {
 	my @ok= grep { index($_,$k) >= 0 } @$allislands;
@@ -153,21 +184,20 @@ sub parse_master_map_route_islands ($$$) {
     }
 }
 
-sub parse_masters () {
-    parse_master_master1('master-master.txt','s');
+sub parse_info_serverside () {
+    parse_info1('master-info.txt','s');
 }
-sub parse_masters_ocean ($) {
+sub parse_info_serverside_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');
+    parse_info1("ocean-".(lc $oceanname).".txt",'s');
 }
 
 sub parse_pctb_commodmap () {
     undef %pctb_commodmap;
     foreach my $commod (keys %commods) { $commods{$commod} =~ s/b//; }
 
-    my $c= new IO::File '_commodmap.tsv' or die $!;
+    my $c= new IO::File '_commodmap.tsv';
     if (!$c) { $!==&ENOENT or die $!; return 0; }
 
     while (<$c>) {
@@ -184,12 +214,15 @@ sub parse_pctb_commodmap () {
 sub get_our_version ($$) {
     my ($aref,$prefix) = @_;
     $aref->{"${prefix}name"}= 'ypp-sc-tools yarrg';
-    $aref->{"${prefix}fixes"}= 'lastpage';
+    $aref->{"${prefix}fixes"}= 'lastpage checkpager';
 
-    my $version= `git-describe --tags HEAD`; $? and die $?;
+    my $version= `git-describe --tags HEAD || echo 0unknown`; $? and die $?;
     chomp($version);
     $aref->{"${prefix}version"}= $version;
     return $aref;
+    # clientname	"ypp-sc-tools"
+    # clientversion	2.1-g2e06a26  [from git-describe --tags HEAD]
+    # clientfixes	"lastpage"  [space separated list]
 }
 
 sub pipethrough_prep () {
@@ -229,6 +262,14 @@ sub pipethrough_run_gzip ($) {
     pipethrough_run($_[0],undef,'gzip','gzip');
 }
 
+sub yarrgpostform ($$) {
+    my ($ua, $form) = @_;
+    my $dest= $ENV{'YPPSC_YARRG_YARRG'};
+    get_our_version($form, 'client');
+    die unless $dest =~ m,/$,;
+    return cgipostform($ua, "${dest}commod-update-receiver", $form);
+}    
+
 sub cgipostform ($$$) {
     my ($ua, $url, $form) = @_;
     my $req= HTTP::Request::Common::POST($url,
@@ -260,8 +301,9 @@ sub cgipostform ($$$) {
 	$out =~ m,^Content-Type: text/plain.*\n\n, or die "$out ?";
 	return $';
     } else {
-	my $resp= $ua->request($url,$req);
-	die $resp->status_line unless $resp->is_success;
+	my $resp= $ua->request($req);
+	die $resp->status_line."\n".$resp->content."\n "
+	    unless $resp->is_success;
 	return $resp->content();
     }
 }
@@ -302,4 +344,17 @@ sub check_tsv_line ($$) {
     return @v;
 }
 
+sub cgi_get_caller () {
+    my $caller= $ENV{'REMOTE_ADDR'};
+    $caller= 'LOCAL' unless defined $caller;
+
+    my $fwdf= $ENV{'HTTP_X_FORWARDED_FOR'};
+    if (defined $fwdf) {
+	$fwdf =~ s/\s//g;
+	$fwdf =~ s/[^0-9.,]/?/g;
+	$caller= "$fwdf";
+    }
+    return $caller;
+}
+
 1;