| CC: | bdfoy [...] cpan.org |
| Subject: | App::Cpan::_get_file ignores return value from LWP::Simple::getstore |
I stumbled upon this problem when attempting to call the 'cpan' utility from inside another Perl program.
'cpan' uses LWP::Simple as its transport mechanism -- specifically, that module's getstore() function. That function, however, does not return a TRUE/FALSE; rather, it returns an HTTP::Status code. A code such as '400' is Perl-true but does not DWIM. The patch attached uses HTTP::Status::is_success() inside _get_file() to see whether we actually made the call we wanted.
Also, there was an incorrect variable assignment within sub _download() which meant that if you were using INFO for the logger you would get an uninitialized value warning.
The patch passes 'make test', but I didn't measure the test coverage before or after. Please review.
Thank you very much.
Jim Keenan
| Subject: | 0001-Don-t-ignore-return-value-from-LWP-Simple-getstore.patch |
From edb68bc34d990fff50db03f7788a1edb5f909246 Mon Sep 17 00:00:00 2001
From: James E Keenan <jkeenan@cpan.org>
Date: Mon, 15 Jan 2018 21:42:44 -0500
Subject: [PATCH] Don't ignore return value from LWP::Simple::getstore().
The return value is an HTTP::Status code returned from HTTP::Response. If
this code is, say, '400', then the fetch has failed -- even though it is
"Perl-true". At the very least, warn if we HTTP::Status::is_success returns
false.
Also, correct variable assignment. Otherwise, the '$logger->info' call throws
an uninitialized value warning.
Per style of subroutine, use hard tabs rather than spaces.
---
lib/App/Cpan.pm | 16 +++++++++++-----
1 file changed, 11 insertions(+), 5 deletions(-)
diff --git a/lib/App/Cpan.pm b/lib/App/Cpan.pm
index 8754912..0bbd6e1 100644
--- a/lib/App/Cpan.pm
+++ b/lib/App/Cpan.pm
@@ -3,6 +3,7 @@ package App::Cpan;
use strict;
use warnings;
use vars qw($VERSION);
+use HTTP::Status qw(:constants :is);
use if $] < 5.008 => 'IO::Scalar';
@@ -1165,9 +1166,9 @@ sub _download
$logger->debug( "Inst file would be $path\n" );
- $paths{$arg} = _get_file( _make_path( $path ) );
+ $paths{$module} = _get_file( _make_path( $path ) );
- $logger->info( "Downloaded [$arg] to [$paths{$module}]" );
+ $logger->info( "Downloaded [$arg] to [$paths{$module}]" );
}
return \%paths;
@@ -1191,11 +1192,16 @@ sub _get_file
{
my $fetch_path = join "/", $site, $path;
$logger->debug( "Trying $fetch_path" );
- last if LWP::Simple::getstore( $fetch_path, $store_path );
+ my $status_code = LWP::Simple::getstore( $fetch_path, $store_path );
+ if (is_success($status_code)) {
+ last;
+ }
+ else {
+ $logger->warn( "LWP::Simple::getstore returned code $status_code from $site" );
}
-
- return $store_path;
}
+ return $store_path;
+}
sub _gitify
{
--
2.7.4