This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix typos (spelling errors) in cpan/File-Fetch/*.
[perl5.git] / cpan / File-Fetch / lib / File / Fetch.pm
index 0a7969f..2223a5e 100644 (file)
@@ -22,7 +22,7 @@ use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN
             ];
 
-$VERSION        = '0.26';
+$VERSION        = '0.28';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';
@@ -36,8 +36,8 @@ $WARN           = 1;
 
 ### methods available to fetch the file depending on the scheme
 $METHODS = {
-    http    => [ qw|lwp httplite wget curl lftp lynx iosock| ],
-    ftp     => [ qw|lwp netftp wget curl lftp ncftp ftp| ],
+    http    => [ qw|lwp httplite wget curl lftp fetch lynx iosock| ],
+    ftp     => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ],
     file    => [ qw|lwp lftp file| ],
     rsync   => [ qw|rsync| ]
 };
@@ -54,7 +54,7 @@ use constant ON_VMS     => ($^O eq 'VMS');
 use constant ON_UNIX    => (!ON_WIN);
 use constant HAS_VOL    => (ON_WIN);
 use constant HAS_SHARE  => (ON_WIN);
-
+use constant HAS_FETCH  => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! );
 
 =pod
 
@@ -723,7 +723,7 @@ sub _iosock_fetch {
         }
 
         # Check the "response"
-        # Strip preceeding blank lines apparently they are allowed (RFC 2616 4.1)
+        # 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 ) {
@@ -1087,7 +1087,7 @@ sub _ncftp_fetch {
     };
     check( $tmpl, \%hash ) or return;
 
-    ### we can only set passive mode in interactive sesssions, so bail out
+    ### we can only set passive mode in interactive sessions, so bail out
     ### if $FTP_PASSIVE is set
     return if $FTP_PASSIVE;
 
@@ -1180,6 +1180,60 @@ sub _curl_fetch {
     }
 }
 
+### /usr/bin/fetch fetch! ###
+sub _fetch_fetch {
+    my $self = shift;
+    my %hash = @_;
+
+    my ($to);
+    my $tmpl = {
+        to  => { required => 1, store => \$to }
+    };
+    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;
+        return;
+    }
+}
 
 ### use File::Copy for fetching file:// urls ###
 ###
@@ -1202,7 +1256,7 @@ sub _file_fetch {
     ### prefix a / on unix systems with a file uri, since it would
     ### look somewhat like this:
     ###     file:///home/kane/file
-    ### wheras windows file uris for 'c:\some\dir\file' might look like:
+    ### whereas windows file uris for 'c:\some\dir\file' might look like:
     ###     file:///C:/some/dir/file
     ###     file:///C|/some/dir/file
     ### or for a network share '\\host\share\some\dir\file':
@@ -1351,8 +1405,8 @@ Below is a mapping of what utilities will be used in what order
 for what schemes, if available:
 
     file    => LWP, lftp, file
-    http    => LWP, HTTP::Lite, wget, curl, lftp, lynx, iosock
-    ftp     => LWP, Net::FTP, wget, curl, lftp, ncftp, ftp
+    http    => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock
+    ftp     => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp
     rsync   => rsync
 
 If you'd like to disable the use of one or more of these utilities
@@ -1363,6 +1417,10 @@ If a utility or module isn't available, it will be marked in a cache
 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 
+three platforms.
+
 C<iosock> is a very limited L<IO::Socket::INET> based mechanism for
 retrieving C<http> schemed urls. It doesn't follow redirects for instance.
 
@@ -1473,6 +1531,7 @@ the $BLACKLIST, $METHOD_FAIL and other internal functions.
     curl        => curl
     rsync       => rsync
     lftp        => lftp
+    fetch       => fetch
     IO::Socket  => iosock
 
 =head1 FREQUENTLY ASKED QUESTIONS
@@ -1495,7 +1554,7 @@ which we in turn capture. If that content is a 'custom' error file
 
 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 'successfull' fetch and a custom error page.
+between a 'successful' fetch and a custom error page.
 
 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.