From cb600e1bbcab3ddcf31bdd9f9babe30dec965420 Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org>
Date: Fri, 26 Jul 2019 15:26:30 +0300
Subject: Switch to using LWP; other minor changes.

* Makefile.PL: Fix dependencies.
* tpnotify (download): Use LWP instead of WWW::Curl::Easy
(verify): Lowercase package_tarname
---
 tpnotify | 48 +++++++++++++++++++++++++-----------------------
 1 file changed, 25 insertions(+), 23 deletions(-)

(limited to 'tpnotify')

diff --git a/tpnotify b/tpnotify
index 3916d61..68acc00 100755
--- a/tpnotify
+++ b/tpnotify
@@ -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";
 
-- 
cgit v1.2.1