Import perl-5.18.2

OK espie@ sthen@ deraadt@

1 files changed, 548 insertions, 542 deletions

diff --git a/gnu/usr.bin/perl/cpan/File-Fetch/lib/File/Fetch.pm b/gnu/usr.bin/perl/cpan/File-Fetch/lib/File/Fetch.pm
index 5d0a51df161..37f7bc6ca9e 100644
--- a/gnu/usr.bin/perl/cpan/File-Fetch/lib/File/Fetch.pm
+++ b/gnu/usr.bin/perl/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.38';
 $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,14 @@ 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.
+
+=item $ff->file_default
+
+The name of the default local file, that $ff->output_file falls back to if
+it would otherwise return no filename. For example when fetching a URI like
+http://www.abc.net.au/ the contents retrieved may be from a remote file called
+'index.html'. The default value of this attribute is literally 'file_default'.
 
 =cut
 
@@ -156,10 +163,12 @@ result of $ff->output_file will be used.
         uri             => { required => 1 },
         vol             => { default => '' }, # windows for file:// uris
         share           => { default => '' }, # windows for file:// uris
+        file_default    => { default => 'file_default' },
+        tempdir_root    => { required => 1 }, # Should be lazy-set at ->new()
         _error_msg      => { no_override => 1 },
         _error_msg_long => { no_override => 1 },
     };
-    
+
     for my $method ( keys %$Tmpl ) {
         no strict 'refs';
         *$method = sub {
@@ -168,28 +177,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]) {
+
+        for (qw[path]) {
             unless( $args->$_() ) { # 5.5.x needs the ()
                 return $class->_error(loc("No '%1' specified",$_));
             }
         }
-        
+
         return $args;
-    }    
+    }
 }
 
 =item $ff->output_file
@@ -199,7 +208,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 +218,49 @@ C<index.html?x=y>.
 sub output_file {
     my $self = shift;
     my $file = $self->file;
-    
+
     $file =~ s/\?.*$//g;
-    
+
+    $file ||= $self->file_default;
+
     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
@@ -267,9 +278,11 @@ sub new {
     my $class = shift;
     my %hash  = @_;
 
-    my ($uri);
+    my ($uri, $file_default, $tempdir_root);
     my $tmpl = {
-        uri => { required => 1, store => \$uri },
+        uri          => { required => 1, store => \$uri },
+        file_default => { required => 0, store => \$file_default },
+        tempdir_root => { required => 0, store => \$tempdir_root },
     };
 
     check( $tmpl, \%hash ) or return;
@@ -277,6 +290,10 @@ sub new {
     ### parse the uri to usable parts ###
     my $href    = $class->_parse_uri( $uri ) or return;
 
+    $href->{file_default} = $file_default if $file_default;
+    $href->{tempdir_root} = File::Spec->rel2abs( $tempdir_root ) if $tempdir_root;
+    $href->{tempdir_root} = File::Spec->rel2abs( Cwd::cwd      ) if not $href->{tempdir_root};
+
     ### make it into a FFI object ###
     my $ff      = $class->_create( %$href ) or return;
 
@@ -300,22 +317,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 +358,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 +367,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 +407,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 +419,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
@@ -431,7 +448,7 @@ sub fetch {
     my ($to, $fh);
     ### you want us to slurp the contents
     if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) {
-        $to = tempdir( 'FileFetch.XXXXXX', CLEANUP => 1 );
+        $to = tempdir( 'FileFetch.XXXXXX', DIR => $self->tempdir_root, CLEANUP => 1 );
 
     ### plain old fetch
     } else {
@@ -443,7 +460,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 +470,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 +490,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 +513,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;
@@ -547,41 +564,40 @@ sub _lwp_fetch {
 
     };
 
-    if( can_load(modules => $use_list) ) {
-
-        ### setup the uri object
-        my $uri = URI->new( File::Spec::Unix->catfile(
-                                    $self->path, $self->file
-                        ) );
+    unless( can_load( modules => $use_list ) ) {
+        $METHOD_FAIL->{'lwp'} = 1;
+        return;
+    }
 
-        ### special rules apply for file:// uris ###
-        $uri->scheme( $self->scheme );
-        $uri->host( $self->scheme eq 'file' ? '' : $self->host );
-        $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file';
+    ### setup the uri object
+    my $uri = URI->new( File::Spec::Unix->catfile(
+                                $self->path, $self->file
+                    ) );
 
-        ### set up the useragent object
-        my $ua = LWP::UserAgent->new();
-        $ua->timeout( $TIMEOUT ) if $TIMEOUT;
-        $ua->agent( $USER_AGENT );
-        $ua->from( $FROM_EMAIL );
-        $ua->env_proxy;
+    ### special rules apply for file:// uris ###
+    $uri->scheme( $self->scheme );
+    $uri->host( $self->scheme eq 'file' ? '' : $self->host );
+    $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file';
 
-        my $res = $ua->mirror($uri, $to) or return;
+    ### set up the useragent object
+    my $ua = LWP::UserAgent->new();
+    $ua->timeout( $TIMEOUT ) if $TIMEOUT;
+    $ua->agent( $USER_AGENT );
+    $ua->from( $FROM_EMAIL );
+    $ua->env_proxy;
 
-        ### uptodate or fetched ok ###
-        if ( $res->code == 304 or $res->code == 200 ) {
-            return $to;
+    my $res = $ua->mirror($uri, $to) or return;
 
-        } else {
-            return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]",
-                        $res->code, HTTP::Status::status_message($res->code),
-                        $res->status_line));
-        }
+    ### uptodate or fetched ok ###
+    if ( $res->code == 304 or $res->code == 200 ) {
+        return $to;
 
     } else {
-        $METHOD_FAIL->{'lwp'} = 1;
-        return;
+        return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]",
+                    $res->code, HTTP::Status::status_message($res->code),
+                    $res->status_line));
     }
+
 }
 
 ### HTTP::Tiny fetching ###
@@ -600,28 +616,26 @@ sub _httptiny_fetch {
 
     };
 
-    if( can_load(modules => $use_list) ) {
+    unless( can_load(modules => $use_list) ) {
+        $METHOD_FAIL->{'httptiny'} = 1;
+        return;
+    }
 
-        my $uri = $self->uri;
+    my $uri = $self->uri;
 
-        my $http = HTTP::Tiny->new( ( $TIMEOUT ? ( timeout => $TIMEOUT ) : () ) );
+    my $http = HTTP::Tiny->new( ( $TIMEOUT ? ( timeout => $TIMEOUT ) : () ) );
 
-        my $rc = $http->mirror( $uri, $to );
+    my $rc = $http->mirror( $uri, $to );
 
-        unless ( $rc->{success} ) {
+    unless ( $rc->{success} ) {
 
-            return $self->_error(loc( "Fetch failed! HTTP response: %1 [%2]",
-                        $rc->{status}, $rc->{reason} ) );
+        return $self->_error(loc( "Fetch failed! HTTP response: %1 [%2]",
+                    $rc->{status}, $rc->{reason} ) );
 
-        }
+    }
 
-        return $to;
+    return $to;
 
-    }
-    else {
-        $METHOD_FAIL->{'httptiny'} = 1;
-        return;
-    }
 }
 
 ### HTTP::Lite fetching ###
@@ -641,66 +655,63 @@ sub _httplite_fetch {
 
     };
 
-    # https://github.com/dagolden/cpanpm/compare/master...private%2Fuse-http-lite
-
-    if( can_load(modules => $use_list) ) {
+    unless( can_load(modules => $use_list) ) {
+        $METHOD_FAIL->{'httplite'} = 1;
+        return;
+    }
 
-        my $uri = $self->uri;
-        my $retries = 0;
+    my $uri = $self->uri;
+    my $retries = 0;
 
-        RETRIES: while ( $retries++ < 5 ) {
+    RETRIES: while ( $retries++ < 5 ) {
 
-          my $http = HTTP::Lite->new();
-          # Naughty naughty but there isn't any accessor/setter
-          $http->{timeout} = $TIMEOUT if $TIMEOUT;
-          $http->http11_mode(1);
+      my $http = HTTP::Lite->new();
+      # Naughty naughty but there isn't any accessor/setter
+      $http->{timeout} = $TIMEOUT if $TIMEOUT;
+      $http->http11_mode(1);
 
-          my $fh = FileHandle->new;
+      my $fh = FileHandle->new;
 
-          unless ( $fh->open($to,'>') ) {
-            return $self->_error(loc(
-                 "Could not open '%1' for writing: %2",$to,$!));
-          }
+      unless ( $fh->open($to,'>') ) {
+        return $self->_error(loc(
+             "Could not open '%1' for writing: %2",$to,$!));
+      }
 
-          $fh->autoflush(1);
+      $fh->autoflush(1);
 
-          binmode $fh;
+      binmode $fh;
 
-          my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh );
+      my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh );
 
-          close $fh;
+      close $fh;
 
-          if ( $rc == 301 || $rc == 302 ) {
-              my $loc;
-              HEADERS: for ($http->headers_array) {
-                /Location: (\S+)/ and $loc = $1, last HEADERS;
-              }
-              #$loc or last; # Think we should squeal here.
-              if ($loc =~ m!^/!) {
-                $uri =~ s{^(\w+?://[^/]+)/.*$}{$1};
-                $uri .= $loc;
-              } 
-              else {
-                $uri = $loc;
-              }
-              next RETRIES;
+      if ( $rc == 301 || $rc == 302 ) {
+          my $loc;
+          HEADERS: for ($http->headers_array) {
+            /Location: (\S+)/ and $loc = $1, last HEADERS;
           }
-          elsif ( $rc == 200 ) {
-              return $to;
+          #$loc or last; # Think we should squeal here.
+          if ($loc =~ m!^/!) {
+            $uri =~ s{^(\w+?://[^/]+)/.*$}{$1};
+            $uri .= $loc;
           }
           else {
-            return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]",
-                        $rc, $http->status_message));
+            $uri = $loc;
           }
+          next RETRIES;
+      }
+      elsif ( $rc == 200 ) {
+          return $to;
+      }
+      else {
+        return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]",
+                    $rc, $http->status_message));
+      }
 
-        } # Loop for 5 retries.
+    } # Loop for 5 retries.
 
-        return $self->_error("Fetch failed! Gave up after 5 tries");
+    return $self->_error("Fetch failed! Gave up after 5 tries");
 
-    } else {
-        $METHOD_FAIL->{'httplite'} = 1;
-        return;
-    }
 }
 
 ### Simple IO::Socket::INET fetching ###
@@ -719,74 +730,73 @@ sub _iosock_fetch {
         'IO::Select'       => '0.0',
     };
 
-    if( can_load(modules => $use_list) ) {
-        my $sock = IO::Socket::INET->new( 
-            PeerHost => $self->host,
-            ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ),
-        );
+    unless( can_load(modules => $use_list) ) {
+        $METHOD_FAIL->{'iosock'} = 1;
+        return;
+    }
 
-        unless ( $sock ) {
-            return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!));
-        }
+    my $sock = IO::Socket::INET->new(
+        PeerHost => $self->host,
+        ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ),
+    );
 
-        my $fh = FileHandle->new;
+    unless ( $sock ) {
+        return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!));
+    }
 
-        # Check open()
+    my $fh = FileHandle->new;
 
-        unless ( $fh->open($to,'>') ) {
-            return $self->_error(loc(
-                 "Could not open '%1' for writing: %2",$to,$!));
-        }
+    # Check open()
 
-        $fh->autoflush(1);
-        binmode $fh;
+    unless ( $fh->open($to,'>') ) {
+        return $self->_error(loc(
+             "Could not open '%1' for writing: %2",$to,$!));
+    }
 
-        my $path = File::Spec::Unix->catfile( $self->path, $self->file );
-        my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a";
-        $sock->send( $req );
+    $fh->autoflush(1);
+    binmode $fh;
 
-        my $select = IO::Select->new( $sock );
+    my $path = File::Spec::Unix->catfile( $self->path, $self->file );
+    my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a";
+    $sock->send( $req );
 
-        my $resp = '';
-        my $normal = 0;
-        while ( $select->can_read( $TIMEOUT || 60 ) ) {
-          my $ret = $sock->sysread( $resp, 4096, length($resp) );
-          if ( !defined $ret or $ret == 0 ) {
-            $select->remove( $sock );
-            $normal++;
-          }
-        }
-        close $sock;
+    my $select = IO::Select->new( $sock );
 
-        unless ( $normal ) {
-            return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 )));
-        }
+    my $resp = '';
+    my $normal = 0;
+    while ( $select->can_read( $TIMEOUT || 60 ) ) {
+      my $ret = $sock->sysread( $resp, 4096, length($resp) );
+      if ( !defined $ret or $ret == 0 ) {
+        $select->remove( $sock );
+        $normal++;
+      }
+    }
+    close $sock;
 
-        # Check the "response"
-        # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1)
-        $resp =~ s/^(\x0d?\x0a)+//;
-        # Check it is an HTTP response
-        unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) {
-            return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host));
-        }
+    unless ( $normal ) {
+        return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 )));
+    }
 
-        # Check for OK
-        my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i;
-        unless ( $code eq '200' ) {
-            return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host));
-        }
+    # Check the "response"
+    # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1)
+    $resp =~ s/^(\x0d?\x0a)+//;
+    # Check it is an HTTP response
+    unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) {
+        return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host));
+    }
 
-        {
-          local $\;
-          print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0];
-        }
-        close $fh;
-        return $to;
+    # Check for OK
+    my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i;
+    unless ( $code eq '200' ) {
+        return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host));
+    }
 
-    } else {
-        $METHOD_FAIL->{'iosock'} = 1;
-        return;
+    {
+      local $\;
+      print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0];
     }
+    close $fh;
+    return $to;
 }
 
 ### Net::FTP fetching
@@ -803,44 +813,43 @@ sub _netftp_fetch {
     ### required modules ###
     my $use_list = { 'Net::FTP' => 0 };
 
-    if( can_load( modules => $use_list ) ) {
+    unless( can_load( modules => $use_list ) ) {
+        $METHOD_FAIL->{'netftp'} = 1;
+        return;
+    }
 
-        ### make connection ###
-        my $ftp;
-        my @options = ($self->host);
-        push(@options, Timeout => $TIMEOUT) if $TIMEOUT;
-        unless( $ftp = Net::FTP->new( @options ) ) {
-            return $self->_error(loc("Ftp creation failed: %1",$@));
-        }
+    ### make connection ###
+    my $ftp;
+    my @options = ($self->host);
+    push(@options, Timeout => $TIMEOUT) if $TIMEOUT;
+    unless( $ftp = Net::FTP->new( @options ) ) {
+        return $self->_error(loc("Ftp creation failed: %1",$@));
+    }
 
-        ### login ###
-        unless( $ftp->login( anonymous => $FROM_EMAIL ) ) {
-            return $self->_error(loc("Could not login to '%1'",$self->host));
-        }
+    ### login ###
+    unless( $ftp->login( anonymous => $FROM_EMAIL ) ) {
+        return $self->_error(loc("Could not login to '%1'",$self->host));
+    }
 
-        ### set binary mode, just in case ###
-        $ftp->binary;
+    ### set binary mode, just in case ###
+    $ftp->binary;
 
-        ### create the remote path 
-        ### remember remote paths are unix paths! [#11483]
-        my $remote = File::Spec::Unix->catfile( $self->path, $self->file );
+    ### create the remote path
+    ### remember remote paths are unix paths! [#11483]
+    my $remote = File::Spec::Unix->catfile( $self->path, $self->file );
 
-        ### fetch the file ###
-        my $target;
-        unless( $target = $ftp->get( $remote, $to ) ) {
-            return $self->_error(loc("Could not fetch '%1' from '%2'",
-                        $remote, $self->host));
-        }
+    ### fetch the file ###
+    my $target;
+    unless( $target = $ftp->get( $remote, $to ) ) {
+        return $self->_error(loc("Could not fetch '%1' from '%2'",
+                    $remote, $self->host));
+    }
 
-        ### log out ###
-        $ftp->quit;
+    ### log out ###
+    $ftp->quit;
 
-        return $target;
+    return $target;
 
-    } else {
-        $METHOD_FAIL->{'netftp'} = 1;
-        return;
-    }
 }
 
 ### /bin/wget fetch ###
@@ -854,47 +863,46 @@ sub _wget_fetch {
     };
     check( $tmpl, \%hash ) or return;
 
+    my $wget;
     ### see if we have a wget binary ###
-    if( my $wget = can_run('wget') ) {
-
-        ### no verboseness, thanks ###
-        my $cmd = [ $wget, '--quiet' ];
+    unless( $wget = can_run('wget') ) {
+        $METHOD_FAIL->{'wget'} = 1;
+        return;
+    }
 
-        ### if a timeout is set, add it ###
-        push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
+    ### no verboseness, thanks ###
+    my $cmd = [ $wget, '--quiet' ];
 
-        ### run passive if specified ###
-        push @$cmd, '--passive-ftp' if $FTP_PASSIVE;
+    ### if a timeout is set, add it ###
+    push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
 
-        ### set the output document, add the uri ###
-        push @$cmd, '--output-document', $to, $self->uri;
+    ### run passive if specified ###
+    push @$cmd, '--passive-ftp' if $FTP_PASSIVE;
 
-        ### 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.
-        # $IPC::Cmd::USE_IPC_RUN
-        #    ? ($to, $self->uri)
-        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+    ### set the output document, add the uri ###
+    push @$cmd, '--output-document', $to, $self->uri;
 
-        ### shell out ###
-        my $captured;
-        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 || '' ));
-        }
+    ### 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.
+    # $IPC::Cmd::USE_IPC_RUN
+    #    ? ($to, $self->uri)
+    #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
 
-        return $to;
+    ### shell out ###
+    my $captured;
+    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;
 
-    } else {
-        $METHOD_FAIL->{'wget'} = 1;
-        return;
+        return $self->_error(loc( "Command failed: %1", $captured || '' ));
     }
+
+    return $to;
 }
 
 ### /bin/lftp fetch ###
@@ -908,67 +916,66 @@ sub _lftp_fetch {
     };
     check( $tmpl, \%hash ) or return;
 
-    ### see if we have a wget binary ###
-    if( my $lftp = can_run('lftp') ) {
+    ### see if we have a lftp binary ###
+    my $lftp;
+    unless( $lftp = can_run('lftp') ) {
+        $METHOD_FAIL->{'lftp'} = 1;
+        return;
+    }
 
-        ### no verboseness, thanks ###
-        my $cmd = [ $lftp, '-f' ];
+    ### no verboseness, thanks ###
+    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;
+    my $fh = File::Temp->new;
 
-        ### run passive if specified ###
-        $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;
+    my $str;
 
-        ### set the output document, add the uri ###
-        ### quote the URI, because lftp supports certain shell
-        ### expansions, most notably & for backgrounding.
-        ### ' quote does nto work, must be "
-        $str .= q[get ']. $self->uri .q[' -o ]. $to . $/;
+    ### if a timeout is set, add it ###
+    $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;
 
-        if( $DEBUG ) {
-            my $pp_str = join ' ', split $/, $str;
-            print "# lftp command: $pp_str\n";
-        }              
+    ### run passive if specified ###
+    $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;
 
-        ### write straight to the file.
-        $fh->autoflush(1);
-        print $fh $str;
+    ### set the output document, add the uri ###
+    ### quote the URI, because lftp supports certain shell
+    ### expansions, most notably & for backgrounding.
+    ### ' quote does nto work, must be "
+    $str .= q[get ']. $self->uri .q[' -o ]. $to . $/;
 
-        ### the command needs to be 1 string to be executed
-        push @$cmd, $fh->filename;
+    if( $DEBUG ) {
+        my $pp_str = join ' ', split $/, $str;
+        print "# lftp command: $pp_str\n";
+    }
 
-        ### 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.
-        # $IPC::Cmd::USE_IPC_RUN
-        #    ? ($to, $self->uri)
-        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+    ### write straight to the file.
+    $fh->autoflush(1);
+    print $fh $str;
 
+    ### the command needs to be 1 string to be executed
+    push @$cmd, $fh->filename;
 
-        ### shell out ###
-        my $captured;
-        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 || '' ));
-        }
+    ### 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.
+    # $IPC::Cmd::USE_IPC_RUN
+    #    ? ($to, $self->uri)
+    #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
 
-        return $to;
 
-    } else {
-        $METHOD_FAIL->{'lftp'} = 1;
-        return;
+    ### shell out ###
+    my $captured;
+    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 || '' ));
     }
+
+    return $to;
 }
 
 
@@ -985,32 +992,35 @@ sub _ftp_fetch {
     check( $tmpl, \%hash ) or return;
 
     ### see if we have a ftp binary ###
-    if( my $ftp = can_run('ftp') ) {
+    my $ftp;
+    unless( $ftp = can_run('ftp') ) {
+        $METHOD_FAIL->{'ftp'} = 1;
+        return;
+    }
 
-        my $fh = FileHandle->new;
+    my $fh = FileHandle->new;
 
-        local $SIG{CHLD} = 'IGNORE';
+    local $SIG{CHLD} = 'IGNORE';
 
-        unless ($fh->open("|$ftp -n")) {
-            return $self->_error(loc("%1 creation failed: %2", $ftp, $!));
-        }
+    unless ($fh->open("$ftp -n", '|-')) {
+        return $self->_error(loc("%1 creation failed: %2", $ftp, $!));
+    }
 
-        my @dialog = (
-            "lcd " . dirname($to),
-            "open " . $self->host,
-            "user anonymous $FROM_EMAIL",
-            "cd /",
-            "cd " . $self->path,
-            "binary",
-            "get " . $self->file . " " . $self->output_file,
-            "quit",
-        );
+    my @dialog = (
+        "lcd " . dirname($to),
+        "open " . $self->host,
+        "user anonymous $FROM_EMAIL",
+        "cd /",
+        "cd " . $self->path,
+        "binary",
+        "get " . $self->file . " " . $self->output_file,
+        "quit",
+    );
 
-        foreach (@dialog) { $fh->print($_, "\n") }
-        $fh->close or return;
+    foreach (@dialog) { $fh->print($_, "\n") }
+    $fh->close or return;
 
-        return $to;
-    }
+    return $to;
 }
 
 ### lynx is stupid - it decompresses any .gz file it finds to be text
@@ -1026,94 +1036,93 @@ sub _lynx_fetch {
     check( $tmpl, \%hash ) or return;
 
     ### see if we have a lynx binary ###
-    if( my $lynx = can_run('lynx') ) {
-
-        unless( IPC::Cmd->can_capture_buffer ) {
-            $METHOD_FAIL->{'lynx'} = 1;
-
-            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) {
-            my $cmd = [
-                $lynx,
-                '-head',
-                '-source',
-                "-auth=anonymous:$FROM_EMAIL",
-            ];
-
-            push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
-
-            push @$cmd, $self->uri;
-
-            ### shell out ###
-            my $head;
-            unless(run( command => $cmd,
-                        buffer  => \$head,
-                        verbose => $DEBUG )
-            ) {
-                return $self->_error(loc("Command failed: %1", $head || ''));
-            }
+    my $lynx;
+    unless ( $lynx = can_run('lynx') ){
+        $METHOD_FAIL->{'lynx'} = 1;
+        return;
+    }
 
-            unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) {
-                return $self->_error(loc("Command failed: %1", $head || ''));
-            }
-        }
+    unless( IPC::Cmd->can_capture_buffer ) {
+        $METHOD_FAIL->{'lynx'} = 1;
 
-        ### write to the output file ourselves, since lynx ass_u_mes to much
-        my $local = FileHandle->new(">$to")
-                        or return $self->_error(loc(
-                            "Could not open '%1' for writing: %2",$to,$!));
+        return $self->_error(loc(
+            "Can not capture buffers. Can not use '%1' to fetch files",
+            'lynx' ));
+    }
 
-        ### dump to stdout ###
+    ### check if the HTTP resource exists ###
+    if ($self->uri =~ /^https?:\/\//i) {
         my $cmd = [
             $lynx,
+            '-head',
             '-source',
             "-auth=anonymous:$FROM_EMAIL",
         ];
 
         push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
 
-        ### 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.
-        # $IPC::Cmd::USE_IPC_RUN
-        #    ? $self->uri
-        #    : QUOTE. $self->uri .QUOTE;
-
 
         ### shell out ###
-        my $captured;
+        my $head;
         unless(run( command => $cmd,
-                    buffer  => \$captured,
+                    buffer  => \$head,
                     verbose => $DEBUG )
         ) {
-            return $self->_error(loc("Command failed: %1", $captured || ''));
+            return $self->_error(loc("Command failed: %1", $head || ''));
         }
 
-        ### print to local file ###
-        ### XXX on a 404 with a special error page, $captured will actually
-        ### hold the contents of that page, and make it *appear* like the
-        ### request was a success, when really it wasn't :(
-        ### there doesn't seem to be an option for lynx to change the exit
-        ### code based on a 4XX status or so.
-        ### the closest we can come is using --error_file and parsing that,
-        ### which is very unreliable ;(
-        $local->print( $captured );
-        $local->close or return;
-
-        return $to;
+        unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) {
+            return $self->_error(loc("Command failed: %1", $head || ''));
+        }
+    }
 
-    } else {
-        $METHOD_FAIL->{'lynx'} = 1;
-        return;
+    ### write to the output file ourselves, since lynx ass_u_mes to much
+    my $local = FileHandle->new( $to, 'w' )
+                    or return $self->_error(loc(
+                        "Could not open '%1' for writing: %2",$to,$!));
+
+    ### dump to stdout ###
+    my $cmd = [
+        $lynx,
+        '-source',
+        "-auth=anonymous:$FROM_EMAIL",
+    ];
+
+    push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
+
+    ### 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.
+    # $IPC::Cmd::USE_IPC_RUN
+    #    ? $self->uri
+    #    : QUOTE. $self->uri .QUOTE;
+
+
+    ### shell out ###
+    my $captured;
+    unless(run( command => $cmd,
+                buffer  => \$captured,
+                verbose => $DEBUG )
+    ) {
+        return $self->_error(loc("Command failed: %1", $captured || ''));
     }
+
+    ### print to local file ###
+    ### XXX on a 404 with a special error page, $captured will actually
+    ### hold the contents of that page, and make it *appear* like the
+    ### request was a success, when really it wasn't :(
+    ### there doesn't seem to be an option for lynx to change the exit
+    ### code based on a 4XX status or so.
+    ### the closest we can come is using --error_file and parsing that,
+    ### which is very unreliable ;(
+    $local->print( $captured );
+    $local->close or return;
+
+    return $to;
 }
 
 ### use /bin/ncftp to fetch files
@@ -1132,38 +1141,38 @@ sub _ncftp_fetch {
     return if $FTP_PASSIVE;
 
     ### see if we have a ncftp binary ###
-    if( my $ncftp = can_run('ncftp') ) {
-
-        my $cmd = [
-            $ncftp,
-            '-V',                   # do not be verbose
-            '-p', $FROM_EMAIL,      # email as password
-            $self->host,            # hostname
-            dirname($to),           # local dir for the file
-                                    # remote path to the file
-            ### 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( 
-                                        $self->path, $self->file ) .QUOTE
-            
-        ];
-
-        ### shell out ###
-        my $captured;
-        unless(run( command => $cmd,
-                    buffer  => \$captured,
-                    verbose => $DEBUG )
-        ) {
-            return $self->_error(loc("Command failed: %1", $captured || ''));
-        }
-
-        return $to;
-
-    } else {
+    my $ncftp;
+    unless( $ncftp = can_run('ncftp') ) {
         $METHOD_FAIL->{'ncftp'} = 1;
         return;
     }
+
+    my $cmd = [
+        $ncftp,
+        '-V',                   # do not be verbose
+        '-p', $FROM_EMAIL,      # email as password
+        $self->host,            # hostname
+        dirname($to),           # local dir for the file
+                                # remote path to the file
+        ### 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(
+                                    $self->path, $self->file ) .QUOTE
+
+    ];
+
+    ### shell out ###
+    my $captured;
+    unless(run( command => $cmd,
+                buffer  => \$captured,
+                verbose => $DEBUG )
+    ) {
+        return $self->_error(loc("Command failed: %1", $captured || ''));
+    }
+
+    return $to;
+
 }
 
 ### use /bin/curl to fetch files
@@ -1176,48 +1185,47 @@ sub _curl_fetch {
         to  => { required => 1, store => \$to }
     };
     check( $tmpl, \%hash ) or return;
+    my $curl;
+    unless ( $curl = can_run('curl') ) {
+        $METHOD_FAIL->{'curl'} = 1;
+        return;
+    }
 
-    if (my $curl = can_run('curl')) {
-
-        ### these long opts are self explanatory - I like that -jmb
-	    my $cmd = [ $curl, '-q' ];
+    ### these long opts are self explanatory - I like that -jmb
+    my $cmd = [ $curl, '-q' ];
 
-	    push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT;
+    push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT;
 
-	    push(@$cmd, '--silent') unless $DEBUG;
+    push(@$cmd, '--silent') unless $DEBUG;
 
-        ### curl does the right thing with passive, regardless ###
-    	if ($self->scheme eq 'ftp') {
-    		push(@$cmd, '--user', "anonymous:$FROM_EMAIL");
-    	}
+    ### curl does the right thing with passive, regardless ###
+    if ($self->scheme eq 'ftp') {
+        push(@$cmd, '--user', "anonymous:$FROM_EMAIL");
+    }
 
-        ### curl doesn't follow 302 (temporarily moved) etc automatically
-        ### so we add --location to enable that.
-        push @$cmd, '--fail', '--location', '--output', $to, $self->uri;
+    ### curl doesn't follow 302 (temporarily moved) etc automatically
+    ### so we add --location to enable that.
+    push @$cmd, '--fail', '--location', '--output', $to, $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.
-        # $IPC::Cmd::USE_IPC_RUN
-        #    ? ($to, $self->uri)
-        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+    ### 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.
+    # $IPC::Cmd::USE_IPC_RUN
+    #    ? ($to, $self->uri)
+    #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
 
 
-        my $captured;
-        unless(run( command => $cmd,
-                    buffer  => \$captured,
-                    verbose => $DEBUG )
-        ) {
+    my $captured;
+    unless(run( command => $cmd,
+                buffer  => \$captured,
+                verbose => $DEBUG )
+    ) {
 
-            return $self->_error(loc("Command failed: %1", $captured || ''));
-        }
+        return $self->_error(loc("Command failed: %1", $captured || ''));
+    }
 
-        return $to;
+    return $to;
 
-    } else {
-        $METHOD_FAIL->{'curl'} = 1;
-        return;
-    }
 }
 
 ### /usr/bin/fetch fetch! ###
@@ -1231,48 +1239,47 @@ sub _fetch_fetch {
     };
     check( $tmpl, \%hash ) or return;
 
-    ### see if we have a wget binary ###
-    if( HAS_FETCH and my $fetch = can_run('fetch') ) {
-
-        ### no verboseness, thanks ###
-        my $cmd = [ $fetch, '-q' ];
-
-        ### if a timeout is set, add it ###
-        push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT;
-
-        ### run passive if specified ###
-        #push @$cmd, '-p' if $FTP_PASSIVE;
-        local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE;
-
-        ### set the output document, add the uri ###
-        push @$cmd, '-o', $to, $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.
-        # $IPC::Cmd::USE_IPC_RUN
-        #    ? ($to, $self->uri)
-        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
-
-        ### shell out ###
-        my $captured;
-        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 || '' ));
-        }
-
-        return $to;
-
-    } else {
-        $METHOD_FAIL->{'wget'} = 1;
+    ### see if we have a fetch binary ###
+    my $fetch;
+    unless( HAS_FETCH and $fetch = can_run('fetch') ) {
+        $METHOD_FAIL->{'fetch'} = 1;
         return;
     }
+
+    ### no verboseness, thanks ###
+    my $cmd = [ $fetch, '-q' ];
+
+    ### if a timeout is set, add it ###
+    push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT;
+
+    ### run passive if specified ###
+    #push @$cmd, '-p' if $FTP_PASSIVE;
+    local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE;
+
+    ### set the output document, add the uri ###
+    push @$cmd, '-o', $to, $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.
+    # $IPC::Cmd::USE_IPC_RUN
+    #    ? ($to, $self->uri)
+    #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+
+    ### shell out ###
+    my $captured;
+    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 || '' ));
+    }
+
+    return $to;
 }
 
 ### use File::Copy for fetching file:// urls ###
@@ -1280,7 +1287,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 +1298,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 +1308,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);
@@ -1358,42 +1365,41 @@ sub _rsync_fetch {
         to  => { required => 1, store => \$to }
     };
     check( $tmpl, \%hash ) or return;
+    my $rsync;
+    unless ( $rsync = can_run('rsync') ) {
+        $METHOD_FAIL->{'rsync'} = 1;
+        return;
+    }
 
-    if (my $rsync = can_run('rsync')) {
-
-        my $cmd = [ $rsync ];
+    my $cmd = [ $rsync ];
 
-        ### XXX: rsync has no I/O timeouts at all, by default
-        push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
+    ### XXX: rsync has no I/O timeouts at all, by default
+    push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
 
-        push(@$cmd, '--quiet') unless $DEBUG;
+    push(@$cmd, '--quiet') unless $DEBUG;
 
-        ### DO NOT quote things for IPC::Run, it breaks stuff.
-        push @$cmd, $self->uri, $to;
+    ### DO NOT quote things for IPC::Run, it breaks stuff.
+    push @$cmd, $self->uri, $to;
 
-        ### 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.
-        # $IPC::Cmd::USE_IPC_RUN
-        #    ? ($to, $self->uri)
-        #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
+    ### 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.
+    # $IPC::Cmd::USE_IPC_RUN
+    #    ? ($to, $self->uri)
+    #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
 
-        my $captured;
-        unless(run( command => $cmd,
-                    buffer  => \$captured,
-                    verbose => $DEBUG )
-        ) {
+    my $captured;
+    unless(run( command => $cmd,
+                buffer  => \$captured,
+                verbose => $DEBUG )
+    ) {
 
-            return $self->_error(loc("Command %1 failed: %2", 
-                "@$cmd" || '', $captured || ''));
-        }
+        return $self->_error(loc("Command %1 failed: %2",
+            "@$cmd" || '', $captured || ''));
+    }
 
-        return $to;
+    return $to;
 
-    } else {
-        $METHOD_FAIL->{'rsync'} = 1;
-        return;
-    }
 }
 
 #################################
@@ -1415,10 +1421,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 +1464,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 +1603,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 +1640,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.