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=97cba0460f975b3a693c72c76be7449ea747eb7a;hb=7f9df3a472dda7008366c3fdf865adeb3467b66b;hpb=7d2fec305c9bdc622a41a343332331b25472fa20 diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm index 97cba04..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,7 +33,7 @@ BEGIN { our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = 1.00; @ISA = qw(Exporter); - @EXPORT = qw(&parse_info_clientside + @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 @@ -40,7 +41,7 @@ BEGIN { &pipethrough_prep &pipethrough_run &pipethrough_run_along &pipethrough_run_finish &pipethrough_run_gzip - &cgipostform &yarrgpostform); + &cgipostform &yarrgpostform &cgi_get_caller); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); @@ -144,7 +145,12 @@ sub parse_info_clientside () { return unless $yarrg; my $master= fetch_with_rsync('info'); parse_info1($master,'s'); - parse_info1('_local-info.txt','s'); + my $local= '_local-info.txt'; + if (stat $local) { + parse_info1($local,'s'); + } else { + die "$local $!" unless $! == &ENOENT; + } } sub fetch_with_rsync ($) { @@ -160,6 +166,7 @@ sub fetch_with_rsync ($) { $!=0; system 'rsync','-Lt','--',$remote,$local; die "$? $!" if $! or $?; } + return $local; } sub parse_info_maproutes ($$$) { @@ -190,7 +197,7 @@ 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>) { @@ -207,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 () { @@ -256,7 +266,8 @@ sub yarrgpostform ($$) { my ($ua, $form) = @_; my $dest= $ENV{'YPPSC_YARRG_YARRG'}; get_our_version($form, 'client'); - return cgipostform($ua, "$dest/commod-update-receiver", $form); + die unless $dest =~ m,/$,; + return cgipostform($ua, "${dest}commod-update-receiver", $form); } sub cgipostform ($$$) { @@ -290,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(); } }