X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2FCommods.pm;h=59ad3e1384cf9dcab67d350a775a617ce9613ba6;hb=207dec6556d4642ce7223e243f08af3bbe8fd157;hp=83d308e7b783337f59acb26ac73df837baafdc4f;hpb=7074ce340ebe05c16b539567be551ac65322a5bb;p=ypp-sc-tools.main.git diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm index 83d308e..59ad3e1 100644 --- a/yarrg/Commods.pm +++ b/yarrg/Commods.pm @@ -24,6 +24,7 @@ package Commods; use IO::File; use HTTP::Request::Common (); use POSIX; +use LWP::UserAgent; use strict; use warnings; @@ -40,7 +41,8 @@ BEGIN { &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 = ( ); @@ -180,8 +182,6 @@ sub parse_info1 ($$$) { } sub parse_info_clientside () { - my $yarrg= $ENV{'YPPSC_YARRG_DICT_UPDATE'}; - return unless $yarrg; my $master= fetch_with_rsync("info-v$masterinfoversion"); parse_info1($master,'s',1); parse_info1('_local-info.txt','s',1); @@ -249,7 +249,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 @@ -259,11 +266,7 @@ sub get_our_version ($$) { \$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 () { @@ -403,4 +406,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;