cpan/File-Fetch - Update to version 1.08

1.08        Mon Apr 28 17:06:58 2025

* Switched from httpbin.org to httpbingo.org

1.06        Mon Apr 28 16:49:13 2025

* httpbin.org is being a bit unreliable at the moment
  and highlighted that lftp is like the little engine
  that could and it will keep trying and trying. Added
  restrictions to how many times it will retry.

Author: bingos

MANIFEST

@@ -1132,7 +1132,7 @@ cpan/ExtUtils-PL2Bat/lib/ExtUtils/PL2Bat.pm	Implement pl2bat
 cpan/ExtUtils-PL2Bat/t/make_executable.t	Tests if ExtUtils::PL2Bat makes bat files that are executable
 cpan/File-Fetch/lib/File/Fetch.pm	File::Fetch
 cpan/File-Fetch/t/01_File-Fetch.t	File::Fetch tests
-cpan/File-Fetch/t/null_subclass.t
+cpan/File-Fetch/t/null_subclass.t	Test file related to File::Fetch
 cpan/File-Path/lib/File/Path.pm		Do things like 'mkdir -p' and 'rm -r'
 cpan/File-Path/t/FilePathTest.pm	See if File::Path works
 cpan/File-Path/t/Path.t			See if File::Path works

Porting/Maintainers.pl

@@ -533,7 +533,8 @@ package Maintainers;
     },
 
     'File::Fetch' => {
-        'DISTRIBUTION' => 'BINGOS/File-Fetch-1.04.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/File-Fetch-1.08.tar.gz',
+        'SYNCINFO'     => 'jkeenan on Thu May  1 07:12:12 2025',
         'FILES'        => q[cpan/File-Fetch],
     },
 

cpan/File-Fetch/lib/File/Fetch.pm

@@ -1,6 +1,7 @@
 package File::Fetch;
 
 use strict;
+use warnings;
 use FileHandle;
 use File::Temp;
 use File::Copy;
@@ -22,7 +23,7 @@ use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN $FORCEIPV4
             ];
 
-$VERSION        = '1.04';
+$VERSION        = '1.08';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = '[email protected]';
@@ -39,7 +40,7 @@ $FORCEIPV4      = 0;
 ### methods available to fetch the file depending on the scheme
 $METHODS = {
     http    => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ],
-    https   => [ qw|lwp wget curl| ],
+    https   => [ qw|lwp httptiny wget curl| ],
     ftp     => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ],
     file    => [ qw|lwp lftp file| ],
     rsync   => [ qw|rsync| ],
@@ -58,7 +59,7 @@ use constant ON_VMS     => ($^O eq 'VMS');
 use constant ON_UNIX    => (!ON_WIN);
 use constant HAS_VOL    => (ON_WIN);
 use constant HAS_SHARE  => (ON_WIN);
-use constant HAS_FETCH  => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! );
+use constant HAS_FETCH  => ( $^O =~ m!^(freebsd|netbsd|dragonfly|midnightbsd)$! );
 
 =pod
 
@@ -400,9 +401,12 @@ sub _parse_uri {
         ### rebuild the path from the leftover parts;
         $href->{path} = join '/', '', splice( @parts, $index, $#parts );
 
-    } else {
+    } elsif ( $href->{scheme} eq 'http' || $href->{scheme} eq 'https' ) {
         ### using anything but qw() in hash slices may produce warnings
         ### in older perls :-(
+        @{$href}{ qw(userinfo host path) } = $uri =~ m|(?:([^\@:]*:[^\:\@]*)@)?([^/]*)(/.*)?$|s;
+        $href->{path} = '/' unless defined $href->{path};
+    } else {
         @{$href}{ qw(userinfo host path) } = $uri =~ m|(?:([^\@:]*:[^\:\@]*)@)?([^/]*)(/.*)$|s;
     }
 
@@ -491,7 +495,9 @@ sub fetch {
         next if grep { lc $_ eq $method } @$BLACKLIST;
 
         ### method is known to fail ###
-        next if $METHOD_FAIL->{$method};
+        next if ref $METHOD_FAIL->{$method}
+            ? $METHOD_FAIL->{$method}{$self->scheme}
+            : $METHOD_FAIL->{$method};
 
         ### there's serious issues with IPC::Run and quoting of command
         ### line arguments. using quotes in the wrong place breaks things,
@@ -569,17 +575,24 @@ sub _lwp_fetch {
 
     };
 
-    if ($self->scheme eq 'https') {
-        $use_list->{'LWP::Protocol::https'} = '0';
-    }
-
     ### Fix CVE-2016-1238 ###
     local $Module::Load::Conditional::FORCE_SAFE_INC = 1;
     unless( can_load( modules => $use_list ) ) {
         $METHOD_FAIL->{'lwp'} = 1;
         return;
     }
 
+    if ($self->scheme eq 'https') {
+        my $https_use_list = {
+            'LWP::Protocol::https' => '0.0',
+        };
+
+        unless ( can_load(modules => $https_use_list) ) {
+            $METHOD_FAIL->{'lwp'} = { 'https' => 1 };
+            return;
+        }
+    }
+
     ### setup the uri object
     my $uri = URI->new( File::Spec::Unix->catfile(
                                 $self->path, $self->file
@@ -638,6 +651,10 @@ sub _httptiny_fetch {
         $METHOD_FAIL->{'httptiny'} = 1;
         return;
     }
+    if ( $self->scheme eq 'https' && !HTTP::Tiny->can_ssl ) {
+        $METHOD_FAIL->{'httptiny'} = 1;
+        return;
+    }
 
     my $uri = $self->uri;
 
@@ -962,6 +979,9 @@ sub _lftp_fetch {
     ### if a timeout is set, add it ###
     $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;
 
+    ### lftp can get stuck in a loop of retries without this
+    $str .= "set net:reconnect-interval-base 5;\nset net:max-retries 2;\n";
+
     ### run passive if specified ###
     $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;
 

cpan/File-Fetch/t/01_File-Fetch.t

@@ -1,6 +1,7 @@
 BEGIN { chdir 't' if -d 't' };
 
 use strict;
+use warnings;
 use lib '../lib';
 
 use Test::More 'no_plan';
@@ -16,7 +17,9 @@ use_ok('File::Fetch');
 $File::Fetch::DEBUG = $File::Fetch::DEBUG   = 1 if $ARGV[0];
 $IPC::Cmd::DEBUG    = $IPC::Cmd::DEBUG      = 1 if $ARGV[0];
 
-$File::Fetch::FORCEIPV4=1;
+$File::Fetch::FORCEIPV4 = $File::Fetch::FORCEIPV4 = 1;
+
+$File::Fetch::TIMEOUT = $File::Fetch::TIMEOUT = 30;
 
 unless( $ENV{PERL_CORE} ) {
     warn qq[
@@ -77,6 +80,12 @@ my @map = (
         path    => '/tmp/',
         file    => 'index.txt',
     },
+    {   uri     => 'http://localhost',   # non-canonical URI
+        scheme  => 'http',
+        host    => 'localhost',
+        path    => '/',                  # default path is '/'
+        file    => '',
+    },
 
     ### only test host part, the rest is OS dependant
     {   uri     => 'file://localhost/tmp/index.txt',
@@ -195,14 +204,15 @@ for my $entry (@map) {
 ### Heuristics
 {
   require IO::Socket::INET;
-  my $sock = IO::Socket::INET->new( PeerAddr => 'httpbin.org', PeerPort => 80, Timeout => 20 )
+  my $sock = IO::Socket::INET->new( PeerAddr => 'httpbingo.org', PeerPort => 80, Timeout => 20 )
      or $heuristics{http} = 0;
 }
 
 ### http:// tests ###
-{   for my $uri ( 'http://httpbin.org/html',
-                  'http://httpbin.org/response-headers?q=1',
-                  'http://httpbin.org/response-headers?q=1&y=2',
+{   for my $uri ( 'http://httpbingo.org',
+                  'http://httpbingo.org/html',
+                  'http://httpbingo.org/response-headers?q=1',
+                  'http://httpbingo.org/response-headers?q=1&y=2',
                   #'http://www.cpan.org/index.html?q=1&y=2',
                   #'http://user:[email protected]/basic-auth/user/passwd',
     ) {
@@ -300,11 +310,3 @@ sub _fetch_uri {
         }}
     }
 }
-
-
-
-
-
-
-
-