package Commods;
use IO::File;
use HTTP::Request::Common ();
+use POSIX;
use strict;
use warnings;
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
+ &set_ctype_utf8);
%EXPORT_TAGS = ( );
@EXPORT_OK = qw();
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= ();
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;
}
}
-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 () {
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 () {
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,
$out =~ m,^Content-Type: text/plain.*\n\n, or die "$out ?";
return $';
} else {
- my $resp= $ua->request($url,$req);
+ my $resp= $ua->request($req);
die $resp->status_line unless $resp->is_success;
return $resp->content();
}
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;
+}
+
+sub set_ctype_utf8 () {
+ setlocale(LC_CTYPE, "en.UTF-8");
+}
+
1;