Updated File-Fetch to CPAN version 0.34

  [DELTA]

  Changes for 0.34        Thu Apr 12 22:25:01 2012
  =================================================
  * Added heuristics to skip tests when no
    Internet access

2 files changed, 148 insertions, 124 deletions

diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm
index 5d0a51df16..8a540a41b7 100644
--- a/cpan/File-Fetch/lib/File/Fetch.pm
+++ b/cpan/File-Fetch/lib/File/Fetch.pm
@@ -22,7 +22,7 @@ use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN
             ];
 
-$VERSION        = '0.32';
+$VERSION        = '0.34';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';
@@ -50,7 +50,7 @@ local $Module::Load::Conditional::VERBOSE   = 0;
 
 ### see what OS we are on, important for file:// uris ###
 use constant ON_WIN     => ($^O eq 'MSWin32');
-use constant ON_VMS     => ($^O eq 'VMS');                                
+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);
@@ -107,7 +107,7 @@ The scheme from the uri (like 'file', 'http', etc)
 
 =item $ff->host
 
-The hostname in the uri.  Will be empty if host was originally 
+The hostname in the uri.  Will be empty if host was originally
 'localhost' for a 'file://' url.
 
 =item $ff->vol
@@ -117,8 +117,8 @@ of a file:// is considered to the be volume specification for the file.
 Thus on Win32 this routine returns the volume, on other operating
 systems this returns nothing.
 
-On Windows this value may be empty if the uri is to a network share, in 
-which case the 'share' property will be defined. Additionally, volume 
+On Windows this value may be empty if the uri is to a network share, in
+which case the 'share' property will be defined. Additionally, volume
 specifications that use '|' as ':' will be converted on read to use ':'.
 
 On VMS, which has a volume concept, this field will be empty because VMS
@@ -127,7 +127,7 @@ information is transparently included.
 
 =item $ff->share
 
-On systems with the concept of a network share (currently only Windows) returns 
+On systems with the concept of a network share (currently only Windows) returns
 the sharename from a file://// url.  On other operating systems returns empty.
 
 =item $ff->path
@@ -137,7 +137,7 @@ The path from the uri, will be at least a single '/'.
 =item $ff->file
 
 The name of the remote file. For the local file name, the
-result of $ff->output_file will be used. 
+result of $ff->output_file will be used.
 
 =cut
 
@@ -159,7 +159,7 @@ result of $ff->output_file will be used.
         _error_msg      => { no_override => 1 },
         _error_msg_long => { no_override => 1 },
     };
-    
+
     for my $method ( keys %$Tmpl ) {
         no strict 'refs';
         *$method = sub {
@@ -168,28 +168,28 @@ result of $ff->output_file will be used.
                         return $self->{$method};
                     }
     }
-    
+
     sub _create {
         my $class = shift;
         my %hash  = @_;
-        
+
         my $args = check( $Tmpl, \%hash ) or return;
-        
+
         bless $args, $class;
-    
+
         if( lc($args->scheme) ne 'file' and not $args->host ) {
             return $class->_error(loc(
                 "Hostname required when fetching from '%1'",$args->scheme));
         }
-        
+
         for (qw[path file]) {
             unless( $args->$_() ) { # 5.5.x needs the ()
                 return $class->_error(loc("No '%1' specified",$_));
             }
         }
-        
+
         return $args;
-    }    
+    }
 }
 
 =item $ff->output_file
@@ -199,7 +199,7 @@ but any query parameters are stripped off. For example:
 
     http://example.com/index.html?x=y
 
-would make the output file be C<index.html> rather than 
+would make the output file be C<index.html> rather than
 C<index.html?x=y>.
 
 =back
@@ -209,47 +209,47 @@ C<index.html?x=y>.
 sub output_file {
     my $self = shift;
     my $file = $self->file;
-    
+
     $file =~ s/\?.*$//g;
-    
+
     return $file;
 }
 
 ### XXX do this or just point to URI::Escape?
 # =head2 $esc_uri = $ff->escaped_uri
-# 
+#
 # =cut
-# 
+#
 # ### most of this is stolen straight from URI::escape
 # {   ### Build a char->hex map
 #     my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
-# 
+#
 #     sub escaped_uri {
 #         my $self = shift;
 #         my $uri  = $self->uri;
-# 
+#
 #         ### Default unsafe characters.  RFC 2732 ^(uric - reserved)
 #         $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/
 #                     $escapes{$1} || $self->_fail_hi($1)/ge;
-# 
+#
 #         return $uri;
 #     }
-# 
+#
 #     sub _fail_hi {
 #         my $self = shift;
 #         my $char = shift;
-#         
+#
 #         $self->_error(loc(
-#             "Can't escape '%1', try using the '%2' module instead", 
+#             "Can't escape '%1', try using the '%2' module instead",
 #             sprintf("\\x{%04X}", ord($char)), 'URI::Escape'
-#         ));            
+#         ));
 #     }
-# 
+#
 #     sub output_file {
-#     
+#
 #     }
-#     
-#     
+#
+#
 # }
 
 =head1 METHODS
@@ -300,22 +300,22 @@ sub new {
 ###
 ### In the case of file:// urls there maybe be additional fields
 ###
-### For systems with volume specifications such as Win32 there will be 
+### For systems with volume specifications such as Win32 there will be
 ### a volume specifier provided in the 'vol' field.
 ###
 ###   'vol' => 'volumename'
 ###
 ### For windows file shares there may be a 'share' key specified
 ###
-###   'share' => 'sharename' 
+###   'share' => 'sharename'
 ###
-### Note that the rules of what a file:// url means vary by the operating system 
+### Note that the rules of what a file:// url means vary by the operating system
 ### of the host being addressed. Thus file:///d|/foo/bar.txt means the obvious
-### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and 
+### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and
 ### not '/foo/bar.txt'
 ###
-### Similarly if the host interpreting the url is VMS then 
-### file:///disk$user/my/notes/note12345.txt' means 
+### Similarly if the host interpreting the url is VMS then
+### file:///disk$user/my/notes/note12345.txt' means
 ### 'DISK$USER:[MY.NOTES]NOTE123456.TXT' but will be returned the same as
 ### if it is unix where it means /disk$user/my/notes/note12345.txt'.
 ### Except for some cases in the File::Spec methods, Perl on VMS will generally
@@ -341,7 +341,7 @@ sub _parse_uri {
     ### And wikipedia for more on windows file:// urls
     ### http://en.wikipedia.org/wiki/File://
     if( $href->{scheme} eq 'file' ) {
-        
+
         my @parts = split '/',$uri;
 
         ### file://hostname/...
@@ -350,36 +350,36 @@ sub _parse_uri {
         $href->{host} = $parts[0] || '';
 
         ### index in @parts where the path components begin;
-        my $index = 1;  
+        my $index = 1;
 
-        ### file:////hostname/sharename/blah.txt        
+        ### file:////hostname/sharename/blah.txt
         if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) {
-            
+
             $href->{host}   = $parts[2] || '';  # avoid warnings
-            $href->{share}  = $parts[3] || '';  # avoid warnings        
+            $href->{share}  = $parts[3] || '';  # avoid warnings
 
             $index          = 4         # index after the share
 
         ### file:///D|/blah.txt
         ### file:///D:/blah.txt
         } elsif (HAS_VOL) {
-        
+
             ### this code comes from dmq's patch, but:
             ### XXX if volume is empty, wouldn't that be an error? --kane
-            ### if so, our file://localhost test needs to be fixed as wel            
+            ### if so, our file://localhost test needs to be fixed as wel
             $href->{vol}    = $parts[1] || '';
 
             ### correct D| style colume descriptors
             $href->{vol}    =~ s/\A([A-Z])\|\z/$1:/i if ON_WIN;
 
             $index          = 2;        # index after the volume
-        } 
+        }
 
         ### rebuild the path from the leftover parts;
         $href->{path} = join '/', '', splice( @parts, $index, $#parts );
 
     } else {
-        ### using anything but qw() in hash slices may produce warnings 
+        ### using anything but qw() in hash slices may produce warnings
         ### in older perls :-(
         @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s;
     }
@@ -390,7 +390,7 @@ sub _parse_uri {
         $href->{file} = $parts[2];
     }
 
-    ### host will be empty if the target was 'localhost' and the 
+    ### host will be empty if the target was 'localhost' and the
     ### scheme was 'file'
     $href->{host} = '' if   ($href->{host}      eq 'localhost') and
                             ($href->{scheme}    eq 'file');
@@ -402,7 +402,7 @@ sub _parse_uri {
 
 Fetches the file you requested and returns the full path to the file.
 
-By default it writes to C<cwd()>, but you can override that by specifying 
+By default it writes to C<cwd()>, but you can override that by specifying
 the C<to> argument:
 
     ### file fetch to /tmp, full path to the file in $where
@@ -443,7 +443,7 @@ sub fetch {
         ### create the path if it doesn't exist yet ###
         unless( -d $to ) {
             eval { mkpath( $to ) };
-    
+
             return $self->_error(loc("Could not create path '%1'",$to)) if $@;
         }
     }
@@ -453,9 +453,9 @@ sub fetch {
 
     ### we dont use catfile on win32 because if we are using a cygwin tool
     ### under cmd.exe they wont understand windows style separators.
-    my $out_to = ON_WIN ? $to.'/'.$self->output_file 
+    my $out_to = ON_WIN ? $to.'/'.$self->output_file
                         : File::Spec->catfile( $to, $self->output_file );
-    
+
     for my $method ( @{ $METHODS->{$self->scheme} } ) {
         my $sub =  '_'.$method.'_fetch';
 
@@ -473,13 +473,13 @@ sub fetch {
 
         ### there's serious issues with IPC::Run and quoting of command
         ### line arguments. using quotes in the wrong place breaks things,
-        ### and in the case of say, 
+        ### and in the case of say,
         ### C:\cygwin\bin\wget.EXE --quiet --passive-ftp --output-document
         ### "index.html" "http://www.cpan.org/index.html?q=1&y=2"
         ### it doesn't matter how you quote, it always fails.
         local $IPC::Cmd::USE_IPC_RUN = 0;
-        
-        if( my $file = $self->$sub( 
+
+        if( my $file = $self->$sub(
                         to => $out_to
         )){
 
@@ -496,18 +496,18 @@ sub fetch {
 
                 ### slurp mode?
                 if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) {
-                    
+
                     ### open the file
                     open my $fh, "<$file" or do {
                         $self->_error(
                             loc("Could not open '%1': %2", $file, $!));
-                        return;                            
+                        return;
                     };
-                    
+
                     ### slurp
                     $$target = do { local $/; <$fh> };
-                
-                } 
+
+                }
 
                 my $abs = File::Spec->rel2abs( $file );
                 return $abs;
@@ -641,8 +641,6 @@ sub _httplite_fetch {
 
     };
 
-    # https://github.com/dagolden/cpanpm/compare/master...private%2Fuse-http-lite
-
     if( can_load(modules => $use_list) ) {
 
         my $uri = $self->uri;
@@ -679,7 +677,7 @@ sub _httplite_fetch {
               if ($loc =~ m!^/!) {
                 $uri =~ s{^(\w+?://[^/]+)/.*$}{$1};
                 $uri .= $loc;
-              } 
+              }
               else {
                 $uri = $loc;
               }
@@ -720,7 +718,7 @@ sub _iosock_fetch {
     };
 
     if( can_load(modules => $use_list) ) {
-        my $sock = IO::Socket::INET->new( 
+        my $sock = IO::Socket::INET->new(
             PeerHost => $self->host,
             ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ),
         );
@@ -821,7 +819,7 @@ sub _netftp_fetch {
         ### set binary mode, just in case ###
         $ftp->binary;
 
-        ### create the remote path 
+        ### create the remote path
         ### remember remote paths are unix paths! [#11483]
         my $remote = File::Spec::Unix->catfile( $self->path, $self->file );
 
@@ -878,14 +876,14 @@ sub _wget_fetch {
 
         ### shell out ###
         my $captured;
-        unless(run( command => $cmd, 
-                    buffer  => \$captured, 
-                    verbose => $DEBUG  
+        unless(run( command => $cmd,
+                    buffer  => \$captured,
+                    verbose => $DEBUG
         )) {
             ### wget creates the output document always, even if the fetch
             ### fails.. so unlink it in that case
             1 while unlink $to;
-            
+
             return $self->_error(loc( "Command failed: %1", $captured || '' ));
         }
 
@@ -915,9 +913,9 @@ sub _lftp_fetch {
         my $cmd = [ $lftp, '-f' ];
 
         my $fh = File::Temp->new;
-        
+
         my $str;
-        
+
         ### if a timeout is set, add it ###
         $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;
 
@@ -933,7 +931,7 @@ sub _lftp_fetch {
         if( $DEBUG ) {
             my $pp_str = join ' ', split $/, $str;
             print "# lftp command: $pp_str\n";
-        }              
+        }
 
         ### write straight to the file.
         $fh->autoflush(1);
@@ -1031,10 +1029,10 @@ sub _lynx_fetch {
         unless( IPC::Cmd->can_capture_buffer ) {
             $METHOD_FAIL->{'lynx'} = 1;
 
-            return $self->_error(loc( 
+            return $self->_error(loc(
                 "Can not capture buffers. Can not use '%1' to fetch files",
                 'lynx' ));
-        }            
+        }
 
         ### check if the HTTP resource exists ###
         if ($self->uri =~ /^https?:\/\//i) {
@@ -1079,7 +1077,7 @@ sub _lynx_fetch {
 
         ### DO NOT quote things for IPC::Run, it breaks stuff.
         push @$cmd, $self->uri;
-        
+
         ### with IPC::Cmd > 0.41, this is fixed in teh library,
         ### and there's no need for special casing any more.
         ### DO NOT quote things for IPC::Run, it breaks stuff.
@@ -1144,9 +1142,9 @@ sub _ncftp_fetch {
             ### DO NOT quote things for IPC::Run, it breaks stuff.
             $IPC::Cmd::USE_IPC_RUN
                         ? File::Spec::Unix->catdir( $self->path, $self->file )
-                        : QUOTE. File::Spec::Unix->catdir( 
+                        : QUOTE. File::Spec::Unix->catdir(
                                         $self->path, $self->file ) .QUOTE
-            
+
         ];
 
         ### shell out ###
@@ -1256,14 +1254,14 @@ sub _fetch_fetch {
 
         ### shell out ###
         my $captured;
-        unless(run( command => $cmd, 
-                    buffer  => \$captured, 
-                    verbose => $DEBUG  
+        unless(run( command => $cmd,
+                    buffer  => \$captured,
+                    verbose => $DEBUG
         )) {
             ### wget creates the output document always, even if the fetch
             ### fails.. so unlink it in that case
             1 while unlink $to;
-            
+
             return $self->_error(loc( "Command failed: %1", $captured || '' ));
         }
 
@@ -1280,7 +1278,7 @@ sub _fetch_fetch {
 ### See section 3.10 of RFC 1738 (http://www.faqs.org/rfcs/rfc1738.html)
 ### Also see wikipedia on file:// (http://en.wikipedia.org/wiki/File://)
 ###
-    
+
 sub _file_fetch {
     my $self = shift;
     my %hash = @_;
@@ -1291,8 +1289,8 @@ sub _file_fetch {
     };
     check( $tmpl, \%hash ) or return;
 
-    
-    
+
+
     ### prefix a / on unix systems with a file uri, since it would
     ### look somewhat like this:
     ###     file:///home/kane/file
@@ -1301,23 +1299,23 @@ sub _file_fetch {
     ###     file:///C|/some/dir/file
     ### or for a network share '\\host\share\some\dir\file':
     ###     file:////host/share/some/dir/file
-    ###    
+    ###
     ### VMS file uri's for 'DISK$USER:[MY.NOTES]NOTE123456.TXT' might look like:
     ###     file://vms.host.edu/disk$user/my/notes/note12345.txt
     ###
-    
+
     my $path    = $self->path;
     my $vol     = $self->vol;
     my $share   = $self->share;
 
     my $remote;
     if (!$share and $self->host) {
-        return $self->_error(loc( 
+        return $self->_error(loc(
             "Currently %1 cannot handle hosts in %2 urls",
             'File::Fetch', 'file://'
-        ));            
+        ));
     }
-    
+
     if( $vol ) {
         $path   = File::Spec->catdir( split /\//, $path );
         $remote = File::Spec->catpath( $vol, $path, $self->file);
@@ -1384,7 +1382,7 @@ sub _rsync_fetch {
                     verbose => $DEBUG )
         ) {
 
-            return $self->_error(loc("Command %1 failed: %2", 
+            return $self->_error(loc("Command %1 failed: %2",
                 "@$cmd" || '', $captured || ''));
         }
 
@@ -1415,10 +1413,10 @@ Pass it a true value to get the C<Carp::longmess()> output instead.
 sub _error {
     my $self    = shift;
     my $error   = shift;
-    
+
     $self->_error_msg( $error );
     $self->_error_msg_long( Carp::longmess($error) );
-    
+
     if( $WARN ) {
         carp $DEBUG ? $self->_error_msg_long : $self->_error_msg;
     }
@@ -1458,7 +1456,7 @@ tried again. The C<fetch> method will only fail when all options are
 exhausted, and it was not able to retrieve the file.
 
 The C<fetch> utility is available on FreeBSD. NetBSD and Dragonfly BSD
-may also have it from C<pkgsrc>. We only check for C<fetch> on those 
+may also have it from C<pkgsrc>. We only check for C<fetch> on those
 three platforms.
 
 C<iosock> is a very limited L<IO::Socket::INET> based mechanism for
@@ -1597,19 +1595,19 @@ Sadly, C<lynx> doesn't support any options to return a different exit
 code on non-C<200 OK> status, giving us no way to tell the difference
 between a 'successful' fetch and a custom error page.
 
-Therefor, we recommend to only use C<lynx> as a last resort. This is 
+Therefor, we recommend to only use C<lynx> as a last resort. This is
 why it is at the back of our list of methods to try as well.
 
 =head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?
 
-C<File::Fetch> is relatively smart about things. When trying to write 
-a file to disk, it removes the C<query parameters> (see the 
+C<File::Fetch> is relatively smart about things. When trying to write
+a file to disk, it removes the C<query parameters> (see the
 C<output_file> method for details) from the file name before creating
 it. In most cases this suffices.
 
-If you have any other characters you need to escape, please install 
+If you have any other characters you need to escape, please install
 the C<URI::Escape> module from CPAN, and pre-encode your URI before
-passing it to C<File::Fetch>. You can read about the details of URIs 
+passing it to C<File::Fetch>. You can read about the details of URIs
 and URI encoding here:
 
   http://www.faqs.org/rfcs/rfc2396.html
@@ -1634,7 +1632,7 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
 
 =head1 COPYRIGHT
 
-This library is free software; you may redistribute and/or modify it 
+This library is free software; you may redistribute and/or modify it
 under the same terms as Perl itself.
 
 
diff --git a/cpan/File-Fetch/t/01_File-Fetch.t b/cpan/File-Fetch/t/01_File-Fetch.t
index c780de1f88..538c55ed64 100644
--- a/cpan/File-Fetch/t/01_File-Fetch.t
+++ b/cpan/File-Fetch/t/01_File-Fetch.t
@@ -35,16 +35,18 @@ to no fault of the module itself.
 ### show us the tools IPC::Cmd will use to run binary programs
 if( $File::Fetch::DEBUG ) {
     ### stupid 'used only once' warnings ;(
-    diag( "IPC::Run enabled: " . 
+    diag( "IPC::Run enabled: " .
             $IPC::Cmd::USE_IPC_RUN || $IPC::Cmd::USE_IPC_RUN );
     diag( "IPC::Run available: " . IPC::Cmd->can_use_ipc_run );
     diag( "IPC::Run vesion: $IPC::Run::VERSION" );
-    diag( "IPC::Open3 enabled: " . 
+    diag( "IPC::Open3 enabled: " .
             $IPC::Cmd::USE_IPC_OPEN3 || $IPC::Cmd::USE_IPC_OPEN3 );
     diag( "IPC::Open3 available: " . IPC::Cmd->can_use_ipc_open3 );
     diag( "IPC::Open3 vesion: $IPC::Open3::VERSION" );
 }
 
+### Heuristics
+my %heuristics = map { $_ => 1 } qw(http ftp rsync file);
 ### _parse_uri tests
 ### these go on all platforms
 my @map = (
@@ -62,15 +64,15 @@ my @map = (
     },
     {   uri     => 'http://localhost/tmp/index.txt',
         scheme  => 'http',
-        host    => 'localhost',          # host is empty only on 'file://' 
+        host    => 'localhost',          # host is empty only on 'file://'
         path    => '/tmp/',
         file    => 'index.txt',
-    },  
-    
+    },
+
     ### only test host part, the rest is OS dependant
     {   uri     => 'file://localhost/tmp/index.txt',
         host    => '',                  # host should be empty on 'file://'
-    },        
+    },
 );
 
 ### these only if we're not on win32/vms
@@ -86,7 +88,7 @@ push @map, (
         host    => 'hostname',
         path    => '/tmp/',
         file    => 'foo.txt',
-    },    
+    },
 ) if not &File::Fetch::ON_WIN and not &File::Fetch::ON_VMS;
 
 ### these only on win32
@@ -104,25 +106,25 @@ push @map, (
         vol     => 'D:',
         path    => '/tmp/',
         file    => 'foo.txt',
-    },    
+    },
     {   uri     => 'file:///D|/tmp/foo.txt',
         scheme  => 'file',
         host    => '',
         vol     => 'D:',
         path    => '/tmp/',
         file    => 'foo.txt',
-    },    
+    },
 ) if &File::Fetch::ON_WIN;
 
 
 ### sanity tests
-{   
+{
     no warnings;
     like( $File::Fetch::USER_AGENT, qr/$File::Fetch::VERSION/,
                                 "User agent contains version" );
     like( $File::Fetch::FROM_EMAIL, qr/@/,
                                 q[Email contains '@'] );
-}                                
+}
 
 ### parse uri tests ###
 for my $entry (@map ) {
@@ -162,6 +164,13 @@ for my $entry (@map) {
     }
 }
 
+### Heuristics
+{
+  require IO::Socket::INET;
+  my $sock = IO::Socket::INET->new( PeerAddr => 'ftp.funet.fi', PeerPort => 21, Timeout => 20 )
+     or $heuristics{ftp} = 0;
+}
+
 ### ftp:// tests ###
 {   my $uri = 'ftp://ftp.funet.fi/pub/CPAN/index.html';
     for (qw[lwp netftp wget curl lftp fetch ncftp]) {
@@ -174,6 +183,13 @@ for my $entry (@map) {
     }
 }
 
+### Heuristics
+{
+  require IO::Socket::INET;
+  my $sock = IO::Socket::INET->new( PeerAddr => 'www.cpan.org', PeerPort => 80, Timeout => 20 )
+     or $heuristics{http} = 0;
+}
+
 ### http:// tests ###
 {   for my $uri ( 'http://www.cpan.org/index.html',
                   'http://www.cpan.org/index.html?q=1',
@@ -185,6 +201,13 @@ for my $entry (@map) {
     }
 }
 
+### Heuristics
+{
+  require IO::Socket::INET;
+  my $sock = IO::Socket::INET->new( PeerAddr => 'cpan.pair.com', PeerPort => 873, Timeout => 20 )
+     or $heuristics{rsync} = 0;
+}
+
 ### rsync:// tests ###
 {   my $uri = 'rsync://cpan.pair.com/CPAN/MIRRORING.FROM';
 
@@ -201,34 +224,37 @@ sub _fetch_uri {
     SKIP: {
         skip "'$method' fetching tests disabled under perl core", 4
                 if $ENV{PERL_CORE};
-    
+
+        skip "'$type' fetching tests disabled due to heuristic failure", 4
+                unless $heuristics{ $type };
+
         ### stupid warnings ###
         $File::Fetch::METHODS =
         $File::Fetch::METHODS = { $type => [$method] };
-    
+
         ### fetch regularly
         my $ff  = File::Fetch->new( uri => $uri );
-        
+
         ok( $ff,                "FF object for $uri (fetch with $method)" );
-        
+
         for my $to ( 'tmp', do { \my $o } ) { SKIP: {
-        
-            
+
+
             my $how     = ref $to ? 'slurp' : 'file';
             my $skip    = ref $to ? 4       : 3;
-        
+
             ok( 1,              "   Fetching '$uri' in $how mode" );
-         
+
             my $file = $ff->fetch( to => $to );
-        
+
             skip "You do not have '$method' installed/available", $skip
                 if $File::Fetch::METHOD_FAIL->{$method} &&
                    $File::Fetch::METHOD_FAIL->{$method};
-                
-            ### if the file wasn't fetched, it may be a network/firewall issue                
-            skip "Fetch failed; no network connectivity for '$type'?", $skip 
+
+            ### if the file wasn't fetched, it may be a network/firewall issue
+            skip "Fetch failed; no network connectivity for '$type'?", $skip
                 unless $file;
-                
+
             ok( $file,          "   File ($file) fetched with $method ($uri)" );
 
             ### check we got some contents if we were meant to slurp
@@ -236,11 +262,11 @@ sub _fetch_uri {
                 ok( $$to,       "   Contents slurped" );
             }
 
-            ok( $file && -s $file,   
+            ok( $file && -s $file,
                                 "   File has size" );
             is( $file && basename($file), $ff->output_file,
                                 "   File has expected name" );
-    
+
             unlink $file;
         }}
     }