diff options
| -rwxr-xr-x | Porting/Maintainers.pl | 2 | ||||
| -rw-r--r-- | cpan/File-Fetch/lib/File/Fetch.pm | 71 | ||||
| -rw-r--r-- | cpan/File-Fetch/t/01_File-Fetch.t | 4 | ||||
| -rw-r--r-- | pod/perldelta.pod | 5 |
4 files changed, 72 insertions, 10 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index e9ecdb7eaa..d2ab44c4bb 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -620,7 +620,7 @@ use File::Glob qw(:case); 'File::Fetch' => { 'MAINTAINER' => 'kane', - 'DISTRIBUTION' => 'BINGOS/File-Fetch-0.26.tar.gz', + 'DISTRIBUTION' => 'BINGOS/File-Fetch-0.28.tar.gz', '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 0a7969f3f8..8bdae35746 100644 --- a/cpan/File-Fetch/lib/File/Fetch.pm +++ b/cpan/File-Fetch/lib/File/Fetch.pm @@ -22,7 +22,7 @@ use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT $FTP_PASSIVE $TIMEOUT $DEBUG $WARN ]; -$VERSION = '0.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 @@ -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 ### ### @@ -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 diff --git a/cpan/File-Fetch/t/01_File-Fetch.t b/cpan/File-Fetch/t/01_File-Fetch.t index 2ab7a7c2c2..7a79f6daac 100644 --- a/cpan/File-Fetch/t/01_File-Fetch.t +++ b/cpan/File-Fetch/t/01_File-Fetch.t @@ -164,7 +164,7 @@ for my $entry (@map) { ### ftp:// tests ### { my $uri = 'ftp://ftp.funet.fi/pub/CPAN/index.html'; - for (qw[lwp netftp wget curl lftp ncftp]) { + for (qw[lwp netftp wget curl lftp fetch ncftp]) { ### STUPID STUPID warnings ### next if $_ eq 'ncftp' and $File::Fetch::FTP_PASSIVE @@ -179,7 +179,7 @@ for my $entry (@map) { 'http://www.cpan.org/index.html?q=1', 'http://www.cpan.org/index.html?q=1&y=2', ) { - for (qw[lwp httplite wget curl lftp lynx iosock]) { + for (qw[lwp httplite wget curl lftp fetch lynx iosock]) { _fetch_uri( http => $uri, $_ ); } } diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ada95f12f5..b898064ae0 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -299,10 +299,13 @@ C<Fcntl> has been upgraded from 1.09 to 1.10. =item * -C<File::Fetch> has been upgraded from 0.24 to 0.26 +C<File::Fetch> has been upgraded from 0.24 to 0.28 C<HTTP::Lite> is now supported for 'http' scheme. +The C<fetch> utility is supported on FreeBSD, NetBSD and +Dragonfly BSD for the C<http> and C<ftp> schemes. + =item * C<File::Glob> has been upgraded from 1.09 to 1.10. |