diff options
Diffstat (limited to 'tpnotify')
-rwxr-xr-x | tpnotify | 48 |
1 files changed, 25 insertions, 23 deletions
@@ -18,7 +18,8 @@ use strict; use Getopt::Long qw(:config gnu_getopt no_ignore_case); use Pod::Usage; use Pod::Man; -use WWW::Curl::Easy; +use LWP::UserAgent; +use URI; use Unix::Sysexits; use File::Basename; use File::Temp qw(tempdir); @@ -30,7 +31,7 @@ use Sys::Hostname;; use Data::Dumper; my $progname = basename($0); -my $progdescr = "FIXME"; +my $progdescr = "Notifies translationproject.org about new POT file"; our $VERSION = "1.0"; my $keep; # Keep temporary directory on errors @@ -95,30 +96,29 @@ sub info { } sub download { - my ($url) = @_; - my $curl = WWW::Curl::Easy->new; - $curl->setopt(CURLOPT_HEADER,0); - $curl->setopt(CURLOPT_URL, $url); - $filename = basename($url); - info("downloading $filename from $url") if $verbose; - open(my $fd, '>', $filename) - or abend(EX_CANTCREAT, "can't open $wd/$filename for writing: $!"); - $curl->setopt(CURLOPT_WRITEDATA, $fd); - my $retcode = $curl->perform; - if ($retcode) { + my ($source) = @_; + my $url = new URI($source); + + $filename = basename($url->path); + info("downloading $source to $wd/$filename") if $verbose; + + my $scheme = $url->scheme; + eval { + require "LWP/Protocol/$scheme.pm"; + }; + if ($@) { + $@ =~ s/\s+at [^\s]+ line \d+\.$//; + abend(EX_OSERR, "$@"); + } + my $ua = LWP::UserAgent->new(); + $ua->agent("tpnotify/$VERSION"); + my $response = $ua->get($url->as_string, ':content_file' => $filename); + unless ($response->is_success) { abend(EX_UNAVAILABLE, - "failed to download: ".$curl->strerror($retcode)." ".$curl->errbuf); - } else { - my $code = $curl->getinfo(CURLINFO_HTTP_CODE); - if ($code != 200) { - print STDERR "error downloading: HTTP code $code\n"; -#FIXME system("cat >&2 $filename"); - die "aborted"; - } + "downloading $source failed: " . $response->status_line); } - close($fd); info("scanning $filename") if $verbose; - open($fd, '-|', "tar tf $filename") + open(my $fd, '-|', "tar tf $filename") or abend(EX_NOINPUT, "can't open $filename: $!"); while (<$fd>) { chomp; @@ -193,6 +193,8 @@ EOT ($package_name, $package_version) = @lines; $package_tarname = $package_name; $package_tarname =~ s/GNU\s+//; + $package_tarname = lc $package_tarname; # FIXME: this is not always right, + # perhaps info("package $package_name, tarname $package_tarname, version $package_version") if $verbose; $package_base = "$package_tarname-$package_version"; |