chiark / gitweb /
Merge branch 'stable-3.x'
authorIan Jackson <ian@liberator.relativity.greenend.org.uk>
Thu, 24 Sep 2009 18:11:13 +0000 (19:11 +0100)
committerIan Jackson <ian@liberator.relativity.greenend.org.uk>
Thu, 24 Sep 2009 18:11:13 +0000 (19:11 +0100)
1  2 
yarrg/Commods.pm
yarrg/README

diff --combined yarrg/Commods.pm
index 9c8281876f334b99578e73622cf95f00e9ec6259,59ad3e1384cf9dcab67d350a775a617ce9613ba6..372fe16f51544081e9378d68563a91a5b38868df
@@@ -24,6 -24,7 +24,7 @@@ package Commods
  use IO::File;
  use HTTP::Request::Common ();
  use POSIX;
+ use LWP::UserAgent;
  
  use strict;
  use warnings;
@@@ -35,13 -36,13 +36,14 @@@ BEGIN 
      @ISA         = qw(Exporter);
      @EXPORT      = qw(&parse_info_clientside &fetch_with_rsync
                      &parse_info_serverside &parse_info_serverside_ocean
 -                    %oceans %commods %clients %routes %route_mysteries
 +                    %oceans %commods %clients
 +                    %vessels %shotname2damage
                      &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
+                     &pipethrough_run_gzip &http_useragent &version_core
+                     &http_useragent_string_map
                      &cgipostform &yarrgpostform &cgi_get_caller
                      &set_ctype_utf8 $masterinfoversion);
      %EXPORT_TAGS = ( );
@@@ -53,10 -54,8 +55,10 @@@ our $masterinfoversion= 2; # version w
  
  our %oceans; # eg $oceans{'Midnight'}{'Ruby'}{'Eta Island'}= $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
 +our %vessels; # eg $vessels{'War Brig'}{Shot}='medium'
 +              #    $vessels{'War Brig'}{Volume}= 81000
 +              #    $vessels{'War Brig'}{Mass}= 54000
 +our %shotname2damage; # eg $shotname2damage{'medium'}= 3;
  # $sources = 's[l]b';
  #       's' = Special Circumstances; 'l' = local ; B = with Bleach
  
@@@ -105,24 -104,11 +107,24 @@@ sub parse_info1 ($$$) 
                    $oceans{$ocean}{$arch}{$_} .= $src;
                };
            });
 -      } elsif (m/^routes (\w+)$/) {
 -          my $ocean= $1;
 +      } elsif (m/^vessels$/) {
 +          @ctx= (sub {
 +              return if m/^[-+|]+$/;
 +              m/^ \| \s* ([A-Z][a-z\ ]+[a-z]) \s*
 +                  \| \s* (small|medium|large) \s*
 +                  \| \s* ([1-9][0-9,]+) \s*
 +                  \| \s* ([1-9][0-9,]+) \s*
 +                  \| $/x
 +                  or die;
 +              my $name= $1;
 +              my $v= { Shot => $2, Volume => $3, Mass => $4 };
 +              foreach my $vm (qw(Volume Mass)) { $v->{$vm} =~ s/,//g; }
 +              $vessels{$name}= $v;
 +          });
 +      } elsif (m/^shot$/) {
            @ctx= (sub {
 -              m/^(\S[^\t]*\S),\s*(\S[^\t]*\S),\s*([1-9][0-9]{0,2})$/ or die;
 -              $routes{$ocean}{$1}{$2}= $3;
 +              m/^ ([a-z]+) \s+ (\d+) $/x or die;
 +              $shotname2damage{$1}= $2;
            });
        } elsif (m/^client (\S+.*\S)$/) {
            my $client= $1;
        }
      };
      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_info_maproutes($on, \@allislands, $routes);
 -      foreach my $route (values %$routes) {
 -          parse_info_maproutes($on, \@allislands, $route);
 -      }
 -    }
  }
  
  sub parse_info_clientside () {
@@@ -201,6 -203,21 +203,6 @@@ sub fetch_with_rsync ($) 
      return $local;
  }
  
 -sub parse_info_maproutes ($$$) {
 -    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_info_serverside () {
      parse_info1('source-info.txt','s',0);
  }
@@@ -232,7 -249,14 +234,14 @@@ sub get_our_version ($$) 
      my ($aref,$prefix) = @_;
      $aref->{"${prefix}name"}= 'ypp-sc-tools yarrg';
      $aref->{"${prefix}fixes"}= 'lastpage checkpager';
+     $aref->{"${prefix}version"}= version_core();
+     return $aref;
+     # clientname      "ypp-sc-tools"
+     # clientversion   2.1-g2e06a26  [from git-describe --tags HEAD]
+     # clientfixes     "lastpage"  [space separated list]
+ }
  
+ sub version_core () {
      my $version= `
        if type -p git-describe >/dev/null 2>&1; then
                gd=git-describe
        \$gd --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]
+     return $version;
  }
  
  sub pipethrough_prep () {
@@@ -386,4 -406,22 +391,22 @@@ sub set_ctype_utf8 () 
      setlocale(LC_CTYPE, "en.UTF-8");
  }
  
+ sub http_useragent_string_map ($$) {
+     my ($caller_lib_agent, $reason_style_or_caller) = @_;
+     $caller_lib_agent =~ y/A-Za-z/N-ZA-Mn-za-m/;
+     $caller_lib_agent =~ s/\s/_/g;
+     my $version= version_core();
+     return "yarrg/$version ($reason_style_or_caller)".
+          " $caller_lib_agent".
+          " (http://yarrg.chiark.net/intro)";
+ }
+ sub http_useragent ($) {
+     my ($who) = @_;
+     my $ua= LWP::UserAgent->new;
+     my $base= $ua->_agent();
+     $ua->agent(http_useragent_string_map($base, $who));
+     return $ua;
+ }
  1;
diff --combined yarrg/README
index 9b594591c40721d4bbb3d013619140cf20c89d1b,39c60908ee1ab4e1f3ed2b416325d286459ee969..b542a1cca8e33e543853972df9f6845e05eb7ecd
@@@ -4,7 -4,7 +4,7 @@@ YARRG - Yet Another Revenue Research Ga
  Overview
  --------
  
- This tool can:
+ This tool will:
    - screenscrape the commodities trading screen
    - produce the results as a tab separated values file
    - upload the results to the YARRG and PCTB servers
@@@ -14,9 -14,8 +14,8 @@@ To build, install the dependencies, cd 
  To screenscrape and upload to both servers, select `trade
  commodities' from the hold of a vessel or building, and run:
     ./yarrg
- Currently we upload to the dedicated yarrg server yarrg.chiark.net,
- and also to pctb.ilk.org (the testing instance of the PCTB database,
- pending approval from the operators of the main server).
+ We upload to the dedicated yarrg server http://yarrg.chiark.net/,
+ and also to the PCTB server http://pctb.crabdance.com/.
  
  Or, for example, for a tab-separated values dump:
     ./yarrg --tsv >commods.tsv
@@@ -173,7 -172,6 +172,7 @@@ for assisting players of Yohoho Puzzle 
  ypp-sc-tools and YARRG are
  Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
  Copyright (C) 2009 Clare Boothby
 +Copyright (C) 2009 Steve Early
  
  This program is free software: you can redistribute it and/or modify
  it under the terms of