Update File-Fetch to CPAN version 0.38

  [DELTA]

  Changes for 0.38        Thu Jan 10 20:52:53 2013
  =================================================
  * Add support for an optional tempdir_root
    parameter (Kent Fredric)

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 164f047..6f62d0b 100755 (executable)
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -811,7 +811,7 @@ use File::Glob qw(:case);
 
     'File::Fetch' => {
         'MAINTAINER'   => 'kane',
 
     'File::Fetch' => {
         'MAINTAINER'   => 'kane',

-        'DISTRIBUTION' => 'BINGOS/File-Fetch-0.36.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/File-Fetch-0.38.tar.gz',

         'FILES'        => q[cpan/File-Fetch],
         'UPSTREAM'     => 'cpan',
     },
         'FILES'        => q[cpan/File-Fetch],
         'UPSTREAM'     => 'cpan',
     },

diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm
index 99f1f79..37f7bc6 100644 (file)
--- 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
             ];
 
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN
             ];
 

-$VERSION        = '0.36';
+$VERSION        = '0.38';

 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';


@@ -164,6 +164,7 @@ http://www.abc.net.au/ the contents retrieved may be from a remote file called
         vol             => { default => '' }, # windows for file:// uris
         share           => { default => '' }, # windows for file:// uris
         file_default    => { default => 'file_default' },
         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 },
     };
         _error_msg      => { no_override => 1 },
         _error_msg_long => { no_override => 1 },
     };


@@ -277,10 +278,11 @@ sub new {
     my $class = shift;
     my %hash  = @_;
 
     my $class = shift;
     my %hash  = @_;
 

-    my ($uri, $file_default);
+    my ($uri, $file_default, $tempdir_root);

     my $tmpl = {
         uri          => { required => 1, store => \$uri },
         file_default => { required => 0, store => \$file_default },
     my $tmpl = {
         uri          => { required => 1, store => \$uri },
         file_default => { required => 0, store => \$file_default },

+        tempdir_root => { required => 0, store => \$tempdir_root },

     };
 
     check( $tmpl, \%hash ) or return;
     };
 
     check( $tmpl, \%hash ) or return;


@@ -289,6 +291,8 @@ sub new {
     my $href    = $class->_parse_uri( $uri ) or return;
 
     $href->{file_default} = $file_default if $file_default;
     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;
 
     ### make it into a FFI object ###
     my $ff      = $class->_create( %$href ) or return;


@@ -444,7 +448,7 @@ sub fetch {
     my ($to, $fh);
     ### you want us to slurp the contents
     if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) {
     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 {
 
     ### plain old fetch
     } else {


@@ -560,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 {
 
     } 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 ###
 }
 
 ### HTTP::Tiny fetching ###


@@ -613,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 ###
 }
 
 ### HTTP::Lite fetching ###


@@ -654,64 +655,63 @@ sub _httplite_fetch {
 
     };
 
 
     };
 

-    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 {
           }
           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 ###
 }
 
 ### Simple IO::Socket::INET fetching ###


@@ -730,74 +730,73 @@ sub _iosock_fetch {
         'IO::Select'       => '0.0',
     };
 
         '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
 }
 
 ### Net::FTP fetching


@@ -814,44 +813,43 @@ sub _netftp_fetch {
     ### required modules ###
     my $use_list = { 'Net::FTP' => 0 };
 
     ### 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 ###
 }
 
 ### /bin/wget fetch ###


@@ -865,47 +863,46 @@ sub _wget_fetch {
     };
     check( $tmpl, \%hash ) or return;
 
     };
     check( $tmpl, \%hash ) or return;
 

+    my $wget;

     ### see if we have a wget binary ###
     ### see if we have a wget binary ###

-    if( my $wget = can_run('wget') ) {
+    unless( $wget = can_run('wget') ) {
+        $METHOD_FAIL->{'wget'} = 1;
+        return;
+    }

 
 

-        ### no verboseness, thanks ###
-        my $cmd = [ $wget, '--quiet' ];
+    ### no verboseness, thanks ###
+    my $cmd = [ $wget, '--quiet' ];

 
 

-        ### if a timeout is set, add it ###
-        push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
+    ### if a timeout is set, add it ###
+    push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;

 
 

-        ### run passive if specified ###
-        push @$cmd, '--passive-ftp' if $FTP_PASSIVE;
+    ### run passive if specified ###
+    push @$cmd, '--passive-ftp' if $FTP_PASSIVE;

 
 

-        ### set the output document, add the uri ###
-        push @$cmd, '--output-document', $to, $self->uri;
+    ### set the output document, add the uri ###
+    push @$cmd, '--output-document', $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);

 
 

-        ### 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 || '' ));
-        }
+    ### 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 $to;
-
-    } else {
-        $METHOD_FAIL->{'wget'} = 1;
-        return;
+        return $self->_error(loc( "Command failed: %1", $captured || '' ));

     }
     }

+
+    return $to;

 }
 
 ### /bin/lftp fetch ###
 }
 
 ### /bin/lftp fetch ###


@@ -919,67 +916,66 @@ sub _lftp_fetch {
     };
     check( $tmpl, \%hash ) or return;
 
     };
     check( $tmpl, \%hash ) or return;
 

-    ### see if we have a wget binary ###
-    if( my $lftp = can_run('lftp') ) {
-
-        ### no verboseness, thanks ###
-        my $cmd = [ $lftp, '-f' ];
+    ### see if we have a lftp binary ###
+    my $lftp;
+    unless( $lftp = can_run('lftp') ) {
+        $METHOD_FAIL->{'lftp'} = 1;
+        return;
+    }

 
 

-        my $fh = File::Temp->new;
+    ### no verboseness, thanks ###
+    my $cmd = [ $lftp, '-f' ];

 
 

-        my $str;
+    my $fh = File::Temp->new;

 
 

-        ### if a timeout is set, add it ###
-        $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;
+    my $str;

 
 

-        ### run passive if specified ###
-        $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;
+    ### if a timeout is set, add it ###
+    $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;

 
 

-        ### 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 . $/;
+    ### run passive if specified ###
+    $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;

 
 

-        if( $DEBUG ) {
-            my $pp_str = join ' ', split $/, $str;
-            print "# lftp command: $pp_str\n";
-        }
+    ### 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 . $/;

 
 

-        ### write straight to the file.
-        $fh->autoflush(1);
-        print $fh $str;
+    if( $DEBUG ) {
+        my $pp_str = join ' ', split $/, $str;
+        print "# lftp command: $pp_str\n";
+    }

 
 

-        ### the command needs to be 1 string to be executed
-        push @$cmd, $fh->filename;
+    ### write straight to the file.
+    $fh->autoflush(1);
+    print $fh $str;

 
 

-        ### 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);
+    ### the command needs to be 1 string to be executed
+    push @$cmd, $fh->filename;

 
 

+    ### 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;
+    ### 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->{'lftp'} = 1;
-        return;
+        return $self->_error(loc( "Command failed: %1", $captured || '' ));

     }
     }

+
+    return $to;

 }
 
 
 }
 
 


@@ -996,32 +992,35 @@ sub _ftp_fetch {
     check( $tmpl, \%hash ) or return;
 
     ### see if we have a ftp binary ###
     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
 }
 
 ### lynx is stupid - it decompresses any .gz file it finds to be text


@@ -1037,94 +1036,93 @@ sub _lynx_fetch {
     check( $tmpl, \%hash ) or return;
 
     ### see if we have a lynx binary ###
     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,
         my $cmd = [
             $lynx,

+            '-head',

             '-source',
             "-auth=anonymous:$FROM_EMAIL",
         ];
 
         push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
 
             '-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;
 
         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 ###
         ### shell out ###

-        my $captured;
+        my $head;

         unless(run( command => $cmd,
         unless(run( command => $cmd,

-                    buffer  => \$captured,
+                    buffer  => \$head,

                     verbose => $DEBUG )
         ) {
                     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
 }
 
 ### use /bin/ncftp to fetch files


@@ -1143,38 +1141,38 @@ sub _ncftp_fetch {
     return if $FTP_PASSIVE;
 
     ### see if we have a ncftp binary ###
     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;
     }
         $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
 }
 
 ### use /bin/curl to fetch files


@@ -1187,48 +1185,47 @@ sub _curl_fetch {
         to  => { required => 1, store => \$to }
     };
     check( $tmpl, \%hash ) or return;
         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! ###
 }
 
 ### /usr/bin/fetch fetch! ###


@@ -1242,48 +1239,47 @@ sub _fetch_fetch {
     };
     check( $tmpl, \%hash ) or return;
 
     };
     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;
     }
         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 ###
 }
 
 ### use File::Copy for fetching file:// urls ###


@@ -1369,42 +1365,41 @@ sub _rsync_fetch {
         to  => { required => 1, store => \$to }
     };
     check( $tmpl, \%hash ) or return;
         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;
-    }

 }
 
 #################################
 }
 
 #################################