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
CommitLineData
79fd8837
JB
1package File::Fetch;
2
3use strict;
4use FileHandle;
6e654618 5use File::Temp;
79fd8837
JB
6use File::Copy;
7use File::Spec;
8use File::Spec::Unix;
79fd8837
JB
9use File::Basename qw[dirname];
10
11use Cwd qw[cwd];
12use Carp qw[carp];
6b6e6e92 13use IPC::Cmd qw[can_run run QUOTE];
79fd8837 14use File::Path qw[mkpath];
8d16e270 15use File::Temp qw[tempdir];
79fd8837
JB
16use Params::Check qw[check];
17use Module::Load::Conditional qw[can_load];
18use Locale::Maketext::Simple Style => 'gettext';
19
20use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
21 $BLACKLIST $METHOD_FAIL $VERSION $METHODS
22 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN
23 ];
24
6d3bcdd8 25$VERSION = '0.28';
fe98d82b
RGS
26$VERSION = eval $VERSION; # avoid warnings with development releases
27$PREFER_BIN = 0; # XXX TODO implement
79fd8837 28$FROM_EMAIL = 'File-Fetch@example.com';
6b6e6e92 29$USER_AGENT = "File::Fetch/$VERSION";
79fd8837
JB
30$BLACKLIST = [qw|ftp|];
31$METHOD_FAIL = { };
32$FTP_PASSIVE = 1;
33$TIMEOUT = 0;
34$DEBUG = 0;
35$WARN = 1;
36
37### methods available to fetch the file depending on the scheme
38$METHODS = {
6d3bcdd8
CBW
39 http => [ qw|lwp httplite wget curl lftp fetch lynx iosock| ],
40 ftp => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ],
6e654618 41 file => [ qw|lwp lftp file| ],
79fd8837
JB
42 rsync => [ qw|rsync| ]
43};
44
45### silly warnings ###
46local $Params::Check::VERBOSE = 1;
47local $Params::Check::VERBOSE = 1;
48local $Module::Load::Conditional::VERBOSE = 0;
49local $Module::Load::Conditional::VERBOSE = 0;
50
51### see what OS we are on, important for file:// uris ###
6b6e6e92
SH
52use constant ON_WIN => ($^O eq 'MSWin32');
53use constant ON_VMS => ($^O eq 'VMS');
54use constant ON_UNIX => (!ON_WIN);
55use constant HAS_VOL => (ON_WIN);
56use constant HAS_SHARE => (ON_WIN);
6d3bcdd8 57use constant HAS_FETCH => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! );
6b6e6e92 58
79fd8837
JB
59=pod
60
61=head1 NAME
62
63File::Fetch - A generic file fetching mechanism
64
65=head1 SYNOPSIS
66
67 use File::Fetch;
68
69 ### build a File::Fetch object ###
70 my $ff = File::Fetch->new(uri => 'http://some.where.com/dir/a.txt');
71
72 ### fetch the uri to cwd() ###
73 my $where = $ff->fetch() or die $ff->error;
74
75 ### fetch the uri to /tmp ###
76 my $where = $ff->fetch( to => '/tmp' );
77
78 ### parsed bits from the uri ###
79 $ff->uri;
80 $ff->scheme;
81 $ff->host;
82 $ff->path;
83 $ff->file;
84
85=head1 DESCRIPTION
86
87File::Fetch is a generic file fetching mechanism.
88
89It allows you to fetch any file pointed to by a C<ftp>, C<http>,
90C<file>, or C<rsync> uri by a number of different means.
91
92See the C<HOW IT WORKS> section further down for details.
93
d4b3706f
RGS
94=head1 ACCESSORS
95
96A C<File::Fetch> object has the following accessors
97
98=over 4
99
100=item $ff->uri
101
102The uri you passed to the constructor
103
104=item $ff->scheme
105
106The scheme from the uri (like 'file', 'http', etc)
107
108=item $ff->host
109
fe98d82b
RGS
110The hostname in the uri. Will be empty if host was originally
111'localhost' for a 'file://' url.
112
113=item $ff->vol
114
115On operating systems with the concept of a volume the second element
116of a file:// is considered to the be volume specification for the file.
1f80753b
JM
117Thus on Win32 this routine returns the volume, on other operating
118systems this returns nothing.
fe98d82b
RGS
119
120On Windows this value may be empty if the uri is to a network share, in
121which case the 'share' property will be defined. Additionally, volume
122specifications that use '|' as ':' will be converted on read to use ':'.
123
1f80753b
JM
124On VMS, which has a volume concept, this field will be empty because VMS
125file specifications are converted to absolute UNIX format and the volume
126information is transparently included.
127
fe98d82b
RGS
128=item $ff->share
129
130On systems with the concept of a network share (currently only Windows) returns
131the sharename from a file://// url. On other operating systems returns empty.
d4b3706f
RGS
132
133=item $ff->path
134
135The path from the uri, will be at least a single '/'.
136
137=item $ff->file
138
139The name of the remote file. For the local file name, the
140result of $ff->output_file will be used.
141
142=cut
143
144
145##########################
146### Object & Accessors ###
147##########################
148
149{
6b6e6e92 150 ### template for autogenerated accessors ###
d4b3706f
RGS
151 my $Tmpl = {
152 scheme => { default => 'http' },
153 host => { default => 'localhost' },
154 path => { default => '/' },
155 file => { required => 1 },
156 uri => { required => 1 },
1f80753b 157 vol => { default => '' }, # windows for file:// uris
fe98d82b 158 share => { default => '' }, # windows for file:// uris
d4b3706f
RGS
159 _error_msg => { no_override => 1 },
160 _error_msg_long => { no_override => 1 },
161 };
162
163 for my $method ( keys %$Tmpl ) {
164 no strict 'refs';
165 *$method = sub {
166 my $self = shift;
167 $self->{$method} = $_[0] if @_;
168 return $self->{$method};
169 }
170 }
171
172 sub _create {
173 my $class = shift;
174 my %hash = @_;
175
176 my $args = check( $Tmpl, \%hash ) or return;
177
178 bless $args, $class;
179
180 if( lc($args->scheme) ne 'file' and not $args->host ) {
16610ad9 181 return $class->_error(loc(
d4b3706f
RGS
182 "Hostname required when fetching from '%1'",$args->scheme));
183 }
184
185 for (qw[path file]) {
9e5ea595 186 unless( $args->$_() ) { # 5.5.x needs the ()
16610ad9 187 return $class->_error(loc("No '%1' specified",$_));
d4b3706f
RGS
188 }
189 }
190
191 return $args;
192 }
193}
194
195=item $ff->output_file
196
197The name of the output file. This is the same as $ff->file,
198but any query parameters are stripped off. For example:
199
200 http://example.com/index.html?x=y
201
202would make the output file be C<index.html> rather than
203C<index.html?x=y>.
204
205=back
206
207=cut
208
209sub output_file {
210 my $self = shift;
211 my $file = $self->file;
212
213 $file =~ s/\?.*$//g;
214
215 return $file;
216}
217
218### XXX do this or just point to URI::Escape?
219# =head2 $esc_uri = $ff->escaped_uri
220#
221# =cut
222#
223# ### most of this is stolen straight from URI::escape
224# { ### Build a char->hex map
225# my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
226#
227# sub escaped_uri {
228# my $self = shift;
229# my $uri = $self->uri;
230#
231# ### Default unsafe characters. RFC 2732 ^(uric - reserved)
232# $uri =~ s/([^A-Za-z0-9\-_.!~*'()])/
233# $escapes{$1} || $self->_fail_hi($1)/ge;
234#
235# return $uri;
236# }
237#
238# sub _fail_hi {
239# my $self = shift;
240# my $char = shift;
241#
242# $self->_error(loc(
243# "Can't escape '%1', try using the '%2' module instead",
244# sprintf("\\x{%04X}", ord($char)), 'URI::Escape'
245# ));
246# }
247#
248# sub output_file {
249#
250# }
251#
252#
253# }
254
79fd8837
JB
255=head1 METHODS
256
257=head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' );
258
259Parses the uri and creates a corresponding File::Fetch::Item object,
260that is ready to be C<fetch>ed and returns it.
261
262Returns false on failure.
263
264=cut
265
266sub new {
267 my $class = shift;
268 my %hash = @_;
269
270 my ($uri);
271 my $tmpl = {
272 uri => { required => 1, store => \$uri },
273 };
274
275 check( $tmpl, \%hash ) or return;
276
277 ### parse the uri to usable parts ###
16610ad9 278 my $href = $class->_parse_uri( $uri ) or return;
79fd8837
JB
279
280 ### make it into a FFI object ###
16610ad9 281 my $ff = $class->_create( %$href ) or return;
79fd8837
JB
282
283
284 ### return the object ###
d4b3706f 285 return $ff;
79fd8837
JB
286}
287
288### parses an uri to a hash structure:
289###
290### $class->_parse_uri( 'ftp://ftp.cpan.org/pub/mirror/index.txt' )
291###
292### becomes:
293###
294### $href = {
295### scheme => 'ftp',
296### host => 'ftp.cpan.org',
297### path => '/pub/mirror',
298### file => 'index.html'
299### };
300###
9e5ea595
RGS
301### In the case of file:// urls there maybe be additional fields
302###
5e6d05d2 303### For systems with volume specifications such as Win32 there will be
fe98d82b
RGS
304### a volume specifier provided in the 'vol' field.
305###
306### 'vol' => 'volumename'
307###
9e5ea595
RGS
308### For windows file shares there may be a 'share' key specified
309###
310### 'share' => 'sharename'
311###
fe98d82b
RGS
312### Note that the rules of what a file:// url means vary by the operating system
313### of the host being addressed. Thus file:///d|/foo/bar.txt means the obvious
314### 'D:\foo\bar.txt' on windows, but on unix it means '/d|/foo/bar.txt' and
315### not '/foo/bar.txt'
9e5ea595 316###
fe98d82b
RGS
317### Similarly if the host interpreting the url is VMS then
318### file:///disk$user/my/notes/note12345.txt' means
1f80753b
JM
319### 'DISK$USER:[MY.NOTES]NOTE123456.TXT' but will be returned the same as
320### if it is unix where it means /disk$user/my/notes/note12345.txt'.
321### Except for some cases in the File::Spec methods, Perl on VMS will generally
322### handle UNIX format file specifications.
fe98d82b
RGS
323###
324### This means it is impossible to serve certain file:// urls on certain systems.
325###
326### Thus are the problems with a protocol-less specification. :-(
9e5ea595
RGS
327###
328
79fd8837
JB
329sub _parse_uri {
330 my $self = shift;
331 my $uri = shift or return;
332
333 my $href = { uri => $uri };
334
335 ### find the scheme ###
336 $uri =~ s|^(\w+)://||;
337 $href->{scheme} = $1;
338
9e5ea595
RGS
339 ### See rfc 1738 section 3.10
340 ### http://www.faqs.org/rfcs/rfc1738.html
341 ### And wikipedia for more on windows file:// urls
342 ### http://en.wikipedia.org/wiki/File://
79fd8837 343 if( $href->{scheme} eq 'file' ) {
9e5ea595
RGS
344
345 my @parts = split '/',$uri;
346
347 ### file://hostname/...
348 ### file://hostname/...
fe98d82b 349 ### normalize file://localhost with file:///
9e5ea595
RGS
350 $href->{host} = $parts[0] || '';
351
352 ### index in @parts where the path components begin;
353 my $index = 1;
9e5ea595
RGS
354
355 ### file:////hostname/sharename/blah.txt
fe98d82b
RGS
356 if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) {
357
9e5ea595
RGS
358 $href->{host} = $parts[2] || ''; # avoid warnings
359 $href->{share} = $parts[3] || ''; # avoid warnings
360
361 $index = 4 # index after the share
9e5ea595 362
fe98d82b
RGS
363 ### file:///D|/blah.txt
364 ### file:///D:/blah.txt
fe98d82b
RGS
365 } elsif (HAS_VOL) {
366
367 ### this code comes from dmq's patch, but:
368 ### XXX if volume is empty, wouldn't that be an error? --kane
369 ### if so, our file://localhost test needs to be fixed as wel
370 $href->{vol} = $parts[1] || '';
371
372 ### correct D| style colume descriptors
373 $href->{vol} =~ s/\A([A-Z])\|\z/$1:/i if ON_WIN;
374
375 $index = 2; # index after the volume
376 }
377
378 ### rebuild the path from the leftover parts;
9e5ea595 379 $href->{path} = join '/', '', splice( @parts, $index, $#parts );
79fd8837
JB
380
381 } else {
9e5ea595
RGS
382 ### using anything but qw() in hash slices may produce warnings
383 ### in older perls :-(
384 @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s;
79fd8837
JB
385 }
386
387 ### split the path into file + dir ###
388 { my @parts = File::Spec::Unix->splitpath( delete $href->{path} );
389 $href->{path} = $parts[1];
390 $href->{file} = $parts[2];
391 }
392
fe98d82b
RGS
393 ### host will be empty if the target was 'localhost' and the
394 ### scheme was 'file'
395 $href->{host} = '' if ($href->{host} eq 'localhost') and
396 ($href->{scheme} eq 'file');
79fd8837
JB
397
398 return $href;
399}
400
8d16e270 401=head2 $where = $ff->fetch( [to => /my/output/dir/ | \$scalar] )
79fd8837 402
8d16e270
JB
403Fetches the file you requested and returns the full path to the file.
404
405By default it writes to C<cwd()>, but you can override that by specifying
406the C<to> argument:
407
408 ### file fetch to /tmp, full path to the file in $where
409 $where = $ff->fetch( to => '/tmp' );
410
411 ### file slurped into $scalar, full path to the file in $where
412 ### file is downloaded to a temp directory and cleaned up at exit time
413 $where = $ff->fetch( to => \$scalar );
79fd8837
JB
414
415Returns the full path to the downloaded file on success, and false
416on failure.
417
418=cut
419
420sub fetch {
421 my $self = shift or return;
422 my %hash = @_;
423
8d16e270 424 my $target;
79fd8837 425 my $tmpl = {
8d16e270 426 to => { default => cwd(), store => \$target },
79fd8837
JB
427 };
428
429 check( $tmpl, \%hash ) or return;
430
8d16e270
JB
431 my ($to, $fh);
432 ### you want us to slurp the contents
433 if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) {
434 $to = tempdir( 'FileFetch.XXXXXX', CLEANUP => 1 );
435
436 ### plain old fetch
437 } else {
438 $to = $target;
1f80753b 439
8d16e270
JB
440 ### On VMS force to VMS format so File::Spec will work.
441 $to = VMS::Filespec::vmspath($to) if ON_VMS;
79fd8837 442
8d16e270
JB
443 ### create the path if it doesn't exist yet ###
444 unless( -d $to ) {
445 eval { mkpath( $to ) };
446
447 return $self->_error(loc("Could not create path '%1'",$to)) if $@;
448 }
79fd8837
JB
449 }
450
451 ### set passive ftp if required ###
452 local $ENV{FTP_PASSIVE} = $FTP_PASSIVE;
453
fe98d82b
RGS
454 ### we dont use catfile on win32 because if we are using a cygwin tool
455 ### under cmd.exe they wont understand windows style separators.
456 my $out_to = ON_WIN ? $to.'/'.$self->output_file
457 : File::Spec->catfile( $to, $self->output_file );
458
79fd8837
JB
459 for my $method ( @{ $METHODS->{$self->scheme} } ) {
460 my $sub = '_'.$method.'_fetch';
461
462 unless( __PACKAGE__->can($sub) ) {
463 $self->_error(loc("Cannot call method for '%1' -- WEIRD!",
464 $method));
465 next;
466 }
467
468 ### method is blacklisted ###
469 next if grep { lc $_ eq $method } @$BLACKLIST;
470
471 ### method is known to fail ###
472 next if $METHOD_FAIL->{$method};
473
d4b3706f
RGS
474 ### there's serious issues with IPC::Run and quoting of command
475 ### line arguments. using quotes in the wrong place breaks things,
476 ### and in the case of say,
477 ### C:\cygwin\bin\wget.EXE --quiet --passive-ftp --output-document
478 ### "index.html" "http://www.cpan.org/index.html?q=1&y=2"
479 ### it doesn't matter how you quote, it always fails.
480 local $IPC::Cmd::USE_IPC_RUN = 0;
481
482 if( my $file = $self->$sub(
a0ad4830 483 to => $out_to
d4b3706f 484 )){
79fd8837
JB
485
486 unless( -e $file && -s _ ) {
487 $self->_error(loc("'%1' said it fetched '%2', ".
488 "but it was not created",$method,$file));
489
490 ### mark the failure ###
491 $METHOD_FAIL->{$method} = 1;
492
493 next;
494
495 } else {
496
8d16e270
JB
497 ### slurp mode?
498 if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) {
499
500 ### open the file
0df024e2 501 open my $fh, "<$file" or do {
8d16e270
JB
502 $self->_error(
503 loc("Could not open '%1': %2", $file, $!));
504 return;
505 };
506
507 ### slurp
508 $$target = do { local $/; <$fh> };
509
510 }
511
79fd8837
JB
512 my $abs = File::Spec->rel2abs( $file );
513 return $abs;
8d16e270 514
79fd8837
JB
515 }
516 }
517 }
518
519
520 ### if we got here, we looped over all methods, but we weren't able
521 ### to fetch it.
522 return;
523}
524
79fd8837
JB
525########################
526### _*_fetch methods ###
527########################
528
529### LWP fetching ###
530sub _lwp_fetch {
531 my $self = shift;
532 my %hash = @_;
533
534 my ($to);
535 my $tmpl = {
536 to => { required => 1, store => \$to }
537 };
538 check( $tmpl, \%hash ) or return;
539
540 ### modules required to download with lwp ###
541 my $use_list = {
542 LWP => '0.0',
543 'LWP::UserAgent' => '0.0',
544 'HTTP::Request' => '0.0',
545 'HTTP::Status' => '0.0',
546 URI => '0.0',
547
548 };
549
550 if( can_load(modules => $use_list) ) {
551
552 ### setup the uri object
553 my $uri = URI->new( File::Spec::Unix->catfile(
554 $self->path, $self->file
555 ) );
556
557 ### special rules apply for file:// uris ###
558 $uri->scheme( $self->scheme );
559 $uri->host( $self->scheme eq 'file' ? '' : $self->host );
560 $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file';
561
562 ### set up the useragent object
563 my $ua = LWP::UserAgent->new();
564 $ua->timeout( $TIMEOUT ) if $TIMEOUT;
565 $ua->agent( $USER_AGENT );
566 $ua->from( $FROM_EMAIL );
567 $ua->env_proxy;
568
569 my $res = $ua->mirror($uri, $to) or return;
570
571 ### uptodate or fetched ok ###
572 if ( $res->code == 304 or $res->code == 200 ) {
573 return $to;
574
575 } else {
576 return $self->_error(loc("Fetch failed! HTTP response: %1 %2 [%3]",
577 $res->code, HTTP::Status::status_message($res->code),
578 $res->status_line));
579 }
580
581 } else {
582 $METHOD_FAIL->{'lwp'} = 1;
583 return;
584 }
585}
586
0df024e2
CBW
587### HTTP::Lite fetching ###
588sub _httplite_fetch {
589 my $self = shift;
590 my %hash = @_;
591
592 my ($to);
593 my $tmpl = {
594 to => { required => 1, store => \$to }
595 };
596 check( $tmpl, \%hash ) or return;
597
598 ### modules required to download with lwp ###
599 my $use_list = {
600 'HTTP::Lite' => '2.2',
601
602 };
603
604 # https://github.com/dagolden/cpanpm/compare/master...private%2Fuse-http-lite
605
606 if( can_load(modules => $use_list) ) {
607
608 my $uri = $self->uri;
609 my $retries = 0;
610
611 RETRIES: while ( $retries++ < 5 ) {
612
613 my $http = HTTP::Lite->new();
614 # Naughty naughty but there isn't any accessor/setter
615 $http->{timeout} = $TIMEOUT if $TIMEOUT;
616 $http->http11_mode(1);
617
618 my $fh = FileHandle->new;
619
620 unless ( $fh->open($to,'>') ) {
621 return $self->_error(loc(
622 "Could not open '%1' for writing: %2",$to,$!));
623 }
624
625 $fh->autoflush(1);
626
627 binmode $fh;
628
629 my $rc = $http->request( $uri, sub { my ($self,$dref,$cbargs) = @_; local $\; print {$cbargs} $$dref }, $fh );
630
631 close $fh;
632
633 if ( $rc == 301 || $rc == 302 ) {
634 my $loc;
635 HEADERS: for ($http->headers_array) {
636 /Location: (\S+)/ and $loc = $1, last HEADERS;
637 }
638 #$loc or last; # Think we should squeal here.
639 if ($loc =~ m!^/!) {
640 $uri =~ s{^(\w+?://[^/]+)/.*$}{$1};
641 $uri .= $loc;
642 }
643 else {
644 $uri = $loc;
645 }
646 next RETRIES;
647 }
648 elsif ( $rc == 200 ) {
649 return $to;
650 }
651 else {
652 return $self->_error(loc("Fetch failed! HTTP response: %1 [%2]",
653 $rc, $http->status_message));
654 }
655
656 } # Loop for 5 retries.
657
658 return $self->_error("Fetch failed! Gave up after 5 tries");
659
660 } else {
661 $METHOD_FAIL->{'httplite'} = 1;
662 return;
663 }
664}
665
314f5584
CBW
666### Simple IO::Socket::INET fetching ###
667sub _iosock_fetch {
668 my $self = shift;
669 my %hash = @_;
670
671 my ($to);
672 my $tmpl = {
673 to => { required => 1, store => \$to }
674 };
675 check( $tmpl, \%hash ) or return;
676
677 my $use_list = {
678 'IO::Socket::INET' => '0.0',
679 'IO::Select' => '0.0',
680 };
681
682 if( can_load(modules => $use_list) ) {
683 my $sock = IO::Socket::INET->new(
684 PeerHost => $self->host,
685 ( $self->host =~ /:/ ? () : ( PeerPort => 80 ) ),
686 );
687
688 unless ( $sock ) {
689 return $self->_error(loc("Could not open socket to '%1', '%2'",$self->host,$!));
690 }
691
692 my $fh = FileHandle->new;
693
694 # Check open()
695
696 unless ( $fh->open($to,'>') ) {
697 return $self->_error(loc(
698 "Could not open '%1' for writing: %2",$to,$!));
699 }
700
0df024e2
CBW
701 $fh->autoflush(1);
702 binmode $fh;
703
af24cc9d
CBW
704 my $path = File::Spec::Unix->catfile( $self->path, $self->file );
705 my $req = "GET $path HTTP/1.0\x0d\x0aHost: " . $self->host . "\x0d\x0a\x0d\x0a";
706 $sock->send( $req );
314f5584
CBW
707
708 my $select = IO::Select->new( $sock );
709
710 my $resp = '';
711 my $normal = 0;
712 while ( $select->can_read( $TIMEOUT || 60 ) ) {
713 my $ret = $sock->sysread( $resp, 4096, length($resp) );
714 if ( !defined $ret or $ret == 0 ) {
715 $select->remove( $sock );
716 $normal++;
717 }
718 }
719 close $sock;
720
721 unless ( $normal ) {
722 return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 )));
723 }
724
af24cc9d 725 # Check the "response"
759feaa6 726 # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1)
af24cc9d
CBW
727 $resp =~ s/^(\x0d?\x0a)+//;
728 # Check it is an HTTP response
729 unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) {
730 return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host));
731 }
732
733 # Check for OK
734 my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i;
735 unless ( $code eq '200' ) {
736 return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host));
737 }
738
0df024e2
CBW
739 {
740 local $\;
741 print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0];
742 }
314f5584
CBW
743 close $fh;
744 return $to;
745
746 } else {
747 $METHOD_FAIL->{'iosock'} = 1;
748 return;
749 }
750}
751
79fd8837
JB
752### Net::FTP fetching
753sub _netftp_fetch {
754 my $self = shift;
755 my %hash = @_;
756
757 my ($to);
758 my $tmpl = {
759 to => { required => 1, store => \$to }
760 };
761 check( $tmpl, \%hash ) or return;
762
763 ### required modules ###
764 my $use_list = { 'Net::FTP' => 0 };
765
766 if( can_load( modules => $use_list ) ) {
767
768 ### make connection ###
769 my $ftp;
770 my @options = ($self->host);
771 push(@options, Timeout => $TIMEOUT) if $TIMEOUT;
772 unless( $ftp = Net::FTP->new( @options ) ) {
773 return $self->_error(loc("Ftp creation failed: %1",$@));
774 }
775
776 ### login ###
777 unless( $ftp->login( anonymous => $FROM_EMAIL ) ) {
778 return $self->_error(loc("Could not login to '%1'",$self->host));
779 }
780
781 ### set binary mode, just in case ###
782 $ftp->binary;
783
784 ### create the remote path
785 ### remember remote paths are unix paths! [#11483]
786 my $remote = File::Spec::Unix->catfile( $self->path, $self->file );
787
788 ### fetch the file ###
789 my $target;
790 unless( $target = $ftp->get( $remote, $to ) ) {
791 return $self->_error(loc("Could not fetch '%1' from '%2'",
792 $remote, $self->host));
793 }
794
795 ### log out ###
796 $ftp->quit;
797
798 return $target;
799
800 } else {
801 $METHOD_FAIL->{'netftp'} = 1;
802 return;
803 }
804}
805
806### /bin/wget fetch ###
807sub _wget_fetch {
808 my $self = shift;
809 my %hash = @_;
810
811 my ($to);
812 my $tmpl = {
813 to => { required => 1, store => \$to }
814 };
815 check( $tmpl, \%hash ) or return;
816
817 ### see if we have a wget binary ###
818 if( my $wget = can_run('wget') ) {
819
820 ### no verboseness, thanks ###
821 my $cmd = [ $wget, '--quiet' ];
822
823 ### if a timeout is set, add it ###
824 push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
825
826 ### run passive if specified ###
827 push @$cmd, '--passive-ftp' if $FTP_PASSIVE;
828
829 ### set the output document, add the uri ###
6e654618
JB
830 push @$cmd, '--output-document', $to, $self->uri;
831
832 ### with IPC::Cmd > 0.41, this is fixed in teh library,
833 ### and there's no need for special casing any more.
834 ### DO NOT quote things for IPC::Run, it breaks stuff.
835 # $IPC::Cmd::USE_IPC_RUN
836 # ? ($to, $self->uri)
837 # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
79fd8837
JB
838
839 ### shell out ###
840 my $captured;
d4b3706f
RGS
841 unless(run( command => $cmd,
842 buffer => \$captured,
843 verbose => $DEBUG
844 )) {
79fd8837
JB
845 ### wget creates the output document always, even if the fetch
846 ### fails.. so unlink it in that case
847 1 while unlink $to;
848
849 return $self->_error(loc( "Command failed: %1", $captured || '' ));
850 }
851
852 return $to;
853
854 } else {
855 $METHOD_FAIL->{'wget'} = 1;
856 return;
857 }
858}
859
6e654618
JB
860### /bin/lftp fetch ###
861sub _lftp_fetch {
862 my $self = shift;
863 my %hash = @_;
864
865 my ($to);
866 my $tmpl = {
867 to => { required => 1, store => \$to }
868 };
869 check( $tmpl, \%hash ) or return;
870
871 ### see if we have a wget binary ###
872 if( my $lftp = can_run('lftp') ) {
873
874 ### no verboseness, thanks ###
875 my $cmd = [ $lftp, '-f' ];
876
877 my $fh = File::Temp->new;
878
879 my $str;
880
881 ### if a timeout is set, add it ###
882 $str .= "set net:timeout $TIMEOUT;\n" if $TIMEOUT;
883
884 ### run passive if specified ###
885 $str .= "set ftp:passive-mode 1;\n" if $FTP_PASSIVE;
886
887 ### set the output document, add the uri ###
888 ### quote the URI, because lftp supports certain shell
889 ### expansions, most notably & for backgrounding.
890 ### ' quote does nto work, must be "
891 $str .= q[get ']. $self->uri .q[' -o ]. $to . $/;
892
893 if( $DEBUG ) {
894 my $pp_str = join ' ', split $/, $str;
895 print "# lftp command: $pp_str\n";
896 }
897
898 ### write straight to the file.
899 $fh->autoflush(1);
900 print $fh $str;
901
902 ### the command needs to be 1 string to be executed
903 push @$cmd, $fh->filename;
904
905 ### with IPC::Cmd > 0.41, this is fixed in teh library,
906 ### and there's no need for special casing any more.
907 ### DO NOT quote things for IPC::Run, it breaks stuff.
908 # $IPC::Cmd::USE_IPC_RUN
909 # ? ($to, $self->uri)
910 # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
911
912
913 ### shell out ###
914 my $captured;
915 unless(run( command => $cmd,
916 buffer => \$captured,
917 verbose => $DEBUG
918 )) {
919 ### wget creates the output document always, even if the fetch
920 ### fails.. so unlink it in that case
921 1 while unlink $to;
922
923 return $self->_error(loc( "Command failed: %1", $captured || '' ));
924 }
925
926 return $to;
927
928 } else {
929 $METHOD_FAIL->{'lftp'} = 1;
930 return;
931 }
932}
933
934
79fd8837
JB
935
936### /bin/ftp fetch ###
937sub _ftp_fetch {
938 my $self = shift;
939 my %hash = @_;
940
941 my ($to);
942 my $tmpl = {
943 to => { required => 1, store => \$to }
944 };
945 check( $tmpl, \%hash ) or return;
946
d4b3706f 947 ### see if we have a ftp binary ###
79fd8837
JB
948 if( my $ftp = can_run('ftp') ) {
949
950 my $fh = FileHandle->new;
951
952 local $SIG{CHLD} = 'IGNORE';
953
954 unless ($fh->open("|$ftp -n")) {
955 return $self->_error(loc("%1 creation failed: %2", $ftp, $!));
956 }
957
958 my @dialog = (
959 "lcd " . dirname($to),
960 "open " . $self->host,
961 "user anonymous $FROM_EMAIL",
962 "cd /",
963 "cd " . $self->path,
964 "binary",
d4b3706f 965 "get " . $self->file . " " . $self->output_file,
79fd8837
JB
966 "quit",
967 );
968
969 foreach (@dialog) { $fh->print($_, "\n") }
970 $fh->close or return;
971
972 return $to;
973 }
974}
975
976### lynx is stupid - it decompresses any .gz file it finds to be text
977### use /bin/lynx to fetch files
978sub _lynx_fetch {
979 my $self = shift;
980 my %hash = @_;
981
982 my ($to);
983 my $tmpl = {
984 to => { required => 1, store => \$to }
985 };
986 check( $tmpl, \%hash ) or return;
987
d4b3706f 988 ### see if we have a lynx binary ###
79fd8837
JB
989 if( my $lynx = can_run('lynx') ) {
990
d4b3706f
RGS
991 unless( IPC::Cmd->can_capture_buffer ) {
992 $METHOD_FAIL->{'lynx'} = 1;
993
994 return $self->_error(loc(
995 "Can not capture buffers. Can not use '%1' to fetch files",
996 'lynx' ));
997 }
79fd8837 998
6e654618
JB
999 ### check if the HTTP resource exists ###
1000 if ($self->uri =~ /^https?:\/\//i) {
1001 my $cmd = [
1002 $lynx,
1003 '-head',
1004 '-source',
1005 "-auth=anonymous:$FROM_EMAIL",
1006 ];
1007
1008 push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
1009
1010 push @$cmd, $self->uri;
1011
1012 ### shell out ###
1013 my $head;
1014 unless(run( command => $cmd,
1015 buffer => \$head,
1016 verbose => $DEBUG )
1017 ) {
1018 return $self->_error(loc("Command failed: %1", $head || ''));
1019 }
1020
1021 unless($head =~ /^HTTP\/\d+\.\d+ 200\b/) {
1022 return $self->_error(loc("Command failed: %1", $head || ''));
1023 }
1024 }
1025
79fd8837
JB
1026 ### write to the output file ourselves, since lynx ass_u_mes to much
1027 my $local = FileHandle->new(">$to")
1028 or return $self->_error(loc(
1029 "Could not open '%1' for writing: %2",$to,$!));
1030
1031 ### dump to stdout ###
1032 my $cmd = [
1033 $lynx,
1034 '-source',
1035 "-auth=anonymous:$FROM_EMAIL",
1036 ];
1037
1038 push @$cmd, "-connect_timeout=$TIMEOUT" if $TIMEOUT;
1039
d4b3706f 1040 ### DO NOT quote things for IPC::Run, it breaks stuff.
6e654618
JB
1041 push @$cmd, $self->uri;
1042
1043 ### with IPC::Cmd > 0.41, this is fixed in teh library,
1044 ### and there's no need for special casing any more.
1045 ### DO NOT quote things for IPC::Run, it breaks stuff.
1046 # $IPC::Cmd::USE_IPC_RUN
1047 # ? $self->uri
1048 # : QUOTE. $self->uri .QUOTE;
d4b3706f 1049
79fd8837
JB
1050
1051 ### shell out ###
1052 my $captured;
1053 unless(run( command => $cmd,
1054 buffer => \$captured,
1055 verbose => $DEBUG )
1056 ) {
1057 return $self->_error(loc("Command failed: %1", $captured || ''));
1058 }
1059
1060 ### print to local file ###
1061 ### XXX on a 404 with a special error page, $captured will actually
1062 ### hold the contents of that page, and make it *appear* like the
1063 ### request was a success, when really it wasn't :(
1064 ### there doesn't seem to be an option for lynx to change the exit
1065 ### code based on a 4XX status or so.
1066 ### the closest we can come is using --error_file and parsing that,
1067 ### which is very unreliable ;(
1068 $local->print( $captured );
1069 $local->close or return;
1070
1071 return $to;
1072
1073 } else {
1074 $METHOD_FAIL->{'lynx'} = 1;
1075 return;
1076 }
1077}
1078
1079### use /bin/ncftp to fetch files
1080sub _ncftp_fetch {
1081 my $self = shift;
1082 my %hash = @_;
1083
1084 my ($to);
1085 my $tmpl = {
1086 to => { required => 1, store => \$to }
1087 };
1088 check( $tmpl, \%hash ) or return;
1089
759feaa6 1090 ### we can only set passive mode in interactive sessions, so bail out
79fd8837
JB
1091 ### if $FTP_PASSIVE is set
1092 return if $FTP_PASSIVE;
1093
d4b3706f 1094 ### see if we have a ncftp binary ###
79fd8837
JB
1095 if( my $ncftp = can_run('ncftp') ) {
1096
1097 my $cmd = [
1098 $ncftp,
1099 '-V', # do not be verbose
1100 '-p', $FROM_EMAIL, # email as password
1101 $self->host, # hostname
1102 dirname($to), # local dir for the file
1103 # remote path to the file
d4b3706f
RGS
1104 ### DO NOT quote things for IPC::Run, it breaks stuff.
1105 $IPC::Cmd::USE_IPC_RUN
1106 ? File::Spec::Unix->catdir( $self->path, $self->file )
1107 : QUOTE. File::Spec::Unix->catdir(
1108 $self->path, $self->file ) .QUOTE
1109
79fd8837
JB
1110 ];
1111
1112 ### shell out ###
1113 my $captured;
1114 unless(run( command => $cmd,
1115 buffer => \$captured,
1116 verbose => $DEBUG )
1117 ) {
1118 return $self->_error(loc("Command failed: %1", $captured || ''));
1119 }
1120
1121 return $to;
1122
1123 } else {
1124 $METHOD_FAIL->{'ncftp'} = 1;
1125 return;
1126 }
1127}
1128
1129### use /bin/curl to fetch files
1130sub _curl_fetch {
1131 my $self = shift;
1132 my %hash = @_;
1133
1134 my ($to);
1135 my $tmpl = {
1136 to => { required => 1, store => \$to }
1137 };
1138 check( $tmpl, \%hash ) or return;
1139
1140 if (my $curl = can_run('curl')) {
1141
1142 ### these long opts are self explanatory - I like that -jmb
6e654618 1143 my $cmd = [ $curl, '-q' ];
79fd8837
JB
1144
1145 push(@$cmd, '--connect-timeout', $TIMEOUT) if $TIMEOUT;
1146
1147 push(@$cmd, '--silent') unless $DEBUG;
1148
1149 ### curl does the right thing with passive, regardless ###
1150 if ($self->scheme eq 'ftp') {
1151 push(@$cmd, '--user', "anonymous:$FROM_EMAIL");
1152 }
1153
1154 ### curl doesn't follow 302 (temporarily moved) etc automatically
1155 ### so we add --location to enable that.
6e654618
JB
1156 push @$cmd, '--fail', '--location', '--output', $to, $self->uri;
1157
1158 ### with IPC::Cmd > 0.41, this is fixed in teh library,
1159 ### and there's no need for special casing any more.
1160 ### DO NOT quote things for IPC::Run, it breaks stuff.
1161 # $IPC::Cmd::USE_IPC_RUN
1162 # ? ($to, $self->uri)
1163 # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
1164
79fd8837
JB
1165
1166 my $captured;
1167 unless(run( command => $cmd,
1168 buffer => \$captured,
1169 verbose => $DEBUG )
1170 ) {
1171
1172 return $self->_error(loc("Command failed: %1", $captured || ''));
1173 }
1174
1175 return $to;
1176
1177 } else {
1178 $METHOD_FAIL->{'curl'} = 1;
1179 return;
1180 }
1181}
1182
6d3bcdd8
CBW
1183### /usr/bin/fetch fetch! ###
1184sub _fetch_fetch {
1185 my $self = shift;
1186 my %hash = @_;
1187
1188 my ($to);
1189 my $tmpl = {
1190 to => { required => 1, store => \$to }
1191 };
1192 check( $tmpl, \%hash ) or return;
1193
1194 ### see if we have a wget binary ###
1195 if( HAS_FETCH and my $fetch = can_run('fetch') ) {
1196
1197 ### no verboseness, thanks ###
1198 my $cmd = [ $fetch, '-q' ];
1199
1200 ### if a timeout is set, add it ###
1201 push(@$cmd, '-T', $TIMEOUT) if $TIMEOUT;
1202
1203 ### run passive if specified ###
1204 #push @$cmd, '-p' if $FTP_PASSIVE;
1205 local $ENV{'FTP_PASSIVE_MODE'} = 1 if $FTP_PASSIVE;
1206
1207 ### set the output document, add the uri ###
1208 push @$cmd, '-o', $to, $self->uri;
1209
1210 ### with IPC::Cmd > 0.41, this is fixed in teh library,
1211 ### and there's no need for special casing any more.
1212 ### DO NOT quote things for IPC::Run, it breaks stuff.
1213 # $IPC::Cmd::USE_IPC_RUN
1214 # ? ($to, $self->uri)
1215 # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
1216
1217 ### shell out ###
1218 my $captured;
1219 unless(run( command => $cmd,
1220 buffer => \$captured,
1221 verbose => $DEBUG
1222 )) {
1223 ### wget creates the output document always, even if the fetch
1224 ### fails.. so unlink it in that case
1225 1 while unlink $to;
1226
1227 return $self->_error(loc( "Command failed: %1", $captured || '' ));
1228 }
1229
1230 return $to;
1231
1232 } else {
1233 $METHOD_FAIL->{'wget'} = 1;
1234 return;
1235 }
1236}
79fd8837
JB
1237
1238### use File::Copy for fetching file:// urls ###
9e5ea595
RGS
1239###
1240### See section 3.10 of RFC 1738 (http://www.faqs.org/rfcs/rfc1738.html)
1241### Also see wikipedia on file:// (http://en.wikipedia.org/wiki/File://)
fe98d82b 1242###
9e5ea595 1243
79fd8837
JB
1244sub _file_fetch {
1245 my $self = shift;
1246 my %hash = @_;
1247
1248 my ($to);
1249 my $tmpl = {
1250 to => { required => 1, store => \$to }
1251 };
1252 check( $tmpl, \%hash ) or return;
1253
9e5ea595
RGS
1254
1255
79fd8837
JB
1256 ### prefix a / on unix systems with a file uri, since it would
1257 ### look somewhat like this:
9e5ea595 1258 ### file:///home/kane/file
759feaa6 1259 ### whereas windows file uris for 'c:\some\dir\file' might look like:
9e5ea595
RGS
1260 ### file:///C:/some/dir/file
1261 ### file:///C|/some/dir/file
1262 ### or for a network share '\\host\share\some\dir\file':
1263 ### file:////host/share/some/dir/file
1264 ###
1265 ### VMS file uri's for 'DISK$USER:[MY.NOTES]NOTE123456.TXT' might look like:
1266 ### file://vms.host.edu/disk$user/my/notes/note12345.txt
1267 ###
1268
1269 my $path = $self->path;
1270 my $vol = $self->vol;
1271 my $share = $self->share;
1272
1273 my $remote;
1274 if (!$share and $self->host) {
1275 return $self->_error(loc(
1276 "Currently %1 cannot handle hosts in %2 urls",
1277 'File::Fetch', 'file://'
1278 ));
1279 }
1280
1281 if( $vol ) {
1282 $path = File::Spec->catdir( split /\//, $path );
1283 $remote = File::Spec->catpath( $vol, $path, $self->file);
79fd8837 1284
9e5ea595
RGS
1285 } elsif( $share ) {
1286 ### win32 specific, and a share name, so we wont bother with File::Spec
1287 $path =~ s|/+|\\|g;
1288 $remote = "\\\\".$self->host."\\$share\\$path";
1289
1290 } else {
5e6d05d2
RGS
1291 ### File::Spec on VMS can not currently handle UNIX syntax.
1292 my $file_class = ON_VMS
1293 ? 'File::Spec::Unix'
1294 : 'File::Spec';
1295
1296 $remote = $file_class->catfile( $path, $self->file );
9e5ea595 1297 }
79fd8837
JB
1298
1299 ### File::Copy is littered with 'die' statements :( ###
1300 my $rv = eval { File::Copy::copy( $remote, $to ) };
1301
1302 ### something went wrong ###
1303 if( !$rv or $@ ) {
1304 return $self->_error(loc("Could not copy '%1' to '%2': %3 %4",
1305 $remote, $to, $!, $@));
1306 }
1307
1308 return $to;
1309}
1310
1311### use /usr/bin/rsync to fetch files
1312sub _rsync_fetch {
1313 my $self = shift;
1314 my %hash = @_;
1315
1316 my ($to);
1317 my $tmpl = {
1318 to => { required => 1, store => \$to }
1319 };
1320 check( $tmpl, \%hash ) or return;
1321
1322 if (my $rsync = can_run('rsync')) {
1323
1324 my $cmd = [ $rsync ];
1325
1326 ### XXX: rsync has no I/O timeouts at all, by default
1327 push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
1328
1329 push(@$cmd, '--quiet') unless $DEBUG;
1330
d4b3706f 1331 ### DO NOT quote things for IPC::Run, it breaks stuff.
6e654618
JB
1332 push @$cmd, $self->uri, $to;
1333
1334 ### with IPC::Cmd > 0.41, this is fixed in teh library,
1335 ### and there's no need for special casing any more.
1336 ### DO NOT quote things for IPC::Run, it breaks stuff.
1337 # $IPC::Cmd::USE_IPC_RUN
1338 # ? ($to, $self->uri)
1339 # : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
79fd8837
JB
1340
1341 my $captured;
1342 unless(run( command => $cmd,
1343 buffer => \$captured,
1344 verbose => $DEBUG )
1345 ) {
1346
fe98d82b
RGS
1347 return $self->_error(loc("Command %1 failed: %2",
1348 "@$cmd" || '', $captured || ''));
79fd8837
JB
1349 }
1350
1351 return $to;
1352
1353 } else {
1354 $METHOD_FAIL->{'rsync'} = 1;
1355 return;
1356 }
1357}
1358
1359#################################
1360#
1361# Error code
1362#
1363#################################
1364
1365=pod
1366
1367=head2 $ff->error([BOOL])
1368
1369Returns the last encountered error as string.
1370Pass it a true value to get the C<Carp::longmess()> output instead.
1371
1372=cut
1373
d4b3706f
RGS
1374### error handling the way Archive::Extract does it
1375sub _error {
1376 my $self = shift;
1377 my $error = shift;
1378
1379 $self->_error_msg( $error );
1380 $self->_error_msg_long( Carp::longmess($error) );
1381
1382 if( $WARN ) {
1383 carp $DEBUG ? $self->_error_msg_long : $self->_error_msg;
79fd8837
JB
1384 }
1385
d4b3706f 1386 return;
79fd8837
JB
1387}
1388
d4b3706f
RGS
1389sub error {
1390 my $self = shift;
1391 return shift() ? $self->_error_msg_long : $self->_error_msg;
1392}
79fd8837
JB
1393
1394
13951;
1396
1397=pod
1398
1399=head1 HOW IT WORKS
1400
1401File::Fetch is able to fetch a variety of uris, by using several
1402external programs and modules.
1403
1404Below is a mapping of what utilities will be used in what order
1405for what schemes, if available:
1406
6e654618 1407 file => LWP, lftp, file
6d3bcdd8
CBW
1408 http => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock
1409 ftp => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp
79fd8837
JB
1410 rsync => rsync
1411
1412If you'd like to disable the use of one or more of these utilities
1413and/or modules, see the C<$BLACKLIST> variable further down.
1414
1415If a utility or module isn't available, it will be marked in a cache
1416(see the C<$METHOD_FAIL> variable further down), so it will not be
1417tried again. The C<fetch> method will only fail when all options are
1418exhausted, and it was not able to retrieve the file.
1419
6d3bcdd8
CBW
1420The C<fetch> utility is available on FreeBSD. NetBSD and Dragonfly BSD
1421may also have it from C<pkgsrc>. We only check for C<fetch> on those
1422three platforms.
1423
314f5584
CBW
1424C<iosock> is a very limited L<IO::Socket::INET> based mechanism for
1425retrieving C<http> schemed urls. It doesn't follow redirects for instance.
1426
79fd8837
JB
1427A special note about fetching files from an ftp uri:
1428
1429By default, all ftp connections are done in passive mode. To change
1430that, see the C<$FTP_PASSIVE> variable further down.
1431
1432Furthermore, ftp uris only support anonymous connections, so no
1433named user/password pair can be passed along.
1434
1435C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable
1436further down.
1437
1438=head1 GLOBAL VARIABLES
1439
1440The behaviour of File::Fetch can be altered by changing the following
1441global variables:
1442
1443=head2 $File::Fetch::FROM_EMAIL
1444
1445This is the email address that will be sent as your anonymous ftp
1446password.
1447
1448Default is C<File-Fetch@example.com>.
1449
1450=head2 $File::Fetch::USER_AGENT
1451
1452This is the useragent as C<LWP> will report it.
1453
1454Default is C<File::Fetch/$VERSION>.
1455
1456=head2 $File::Fetch::FTP_PASSIVE
1457
1458This variable controls whether the environment variable C<FTP_PASSIVE>
1459and any passive switches to commandline tools will be set to true.
1460
1461Default value is 1.
1462
1463Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch
1464files, since passive mode can only be set interactively for this binary
1465
1466=head2 $File::Fetch::TIMEOUT
1467
1468When set, controls the network timeout (counted in seconds).
1469
1470Default value is 0.
1471
1472=head2 $File::Fetch::WARN
1473
1474This variable controls whether errors encountered internally by
1475C<File::Fetch> should be C<carp>'d or not.
1476
1477Set to false to silence warnings. Inspect the output of the C<error()>
1478method manually to see what went wrong.
1479
1480Defaults to C<true>.
1481
1482=head2 $File::Fetch::DEBUG
1483
1484This enables debugging output when calling commandline utilities to
1485fetch files.
1486This also enables C<Carp::longmess> errors, instead of the regular
1487C<carp> errors.
1488
1489Good for tracking down why things don't work with your particular
1490setup.
1491
1492Default is 0.
1493
1494=head2 $File::Fetch::BLACKLIST
1495
1496This is an array ref holding blacklisted modules/utilities for fetching
1497files with.
1498
1499To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could
1500set $File::Fetch::BLACKLIST to:
1501
1502 $File::Fetch::BLACKLIST = [qw|lwp netftp|]
1503
1504The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable.
1505
1506See the note on C<MAPPING> below.
1507
1508=head2 $File::Fetch::METHOD_FAIL
1509
1510This is a hashref registering what modules/utilities were known to fail
1511for fetching files (mostly because they weren't installed).
1512
1513You can reset this cache by assigning an empty hashref to it, or
1514individually remove keys.
1515
1516See the note on C<MAPPING> below.
1517
1518=head1 MAPPING
1519
1520
1521Here's a quick mapping for the utilities/modules, and their names for
1522the $BLACKLIST, $METHOD_FAIL and other internal functions.
1523
1524 LWP => lwp
0df024e2 1525 HTTP::Lite => httplite
79fd8837
JB
1526 Net::FTP => netftp
1527 wget => wget
1528 lynx => lynx
1529 ncftp => ncftp
1530 ftp => ftp
1531 curl => curl
1532 rsync => rsync
6e654618 1533 lftp => lftp
6d3bcdd8 1534 fetch => fetch
314f5584 1535 IO::Socket => iosock
79fd8837
JB
1536
1537=head1 FREQUENTLY ASKED QUESTIONS
1538
1539=head2 So how do I use a proxy with File::Fetch?
1540
1541C<File::Fetch> currently only supports proxies with LWP::UserAgent.
1542You will need to set your environment variables accordingly. For
1543example, to use an ftp proxy:
1544
1545 $ENV{ftp_proxy} = 'foo.com';
1546
1547Refer to the LWP::UserAgent manpage for more details.
1548
1549=head2 I used 'lynx' to fetch a file, but its contents is all wrong!
1550
1551C<lynx> can only fetch remote files by dumping its contents to C<STDOUT>,
1552which we in turn capture. If that content is a 'custom' error file
1553(like, say, a C<404 handler>), you will get that contents instead.
1554
1555Sadly, C<lynx> doesn't support any options to return a different exit
1556code on non-C<200 OK> status, giving us no way to tell the difference
759feaa6 1557between a 'successful' fetch and a custom error page.
79fd8837
JB
1558
1559Therefor, we recommend to only use C<lynx> as a last resort. This is
1560why it is at the back of our list of methods to try as well.
1561
d4b3706f
RGS
1562=head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?
1563
1564C<File::Fetch> is relatively smart about things. When trying to write
1565a file to disk, it removes the C<query parameters> (see the
1566C<output_file> method for details) from the file name before creating
1567it. In most cases this suffices.
1568
1569If you have any other characters you need to escape, please install
1570the C<URI::Escape> module from CPAN, and pre-encode your URI before
1571passing it to C<File::Fetch>. You can read about the details of URIs
1572and URI encoding here:
1573
1574 http://www.faqs.org/rfcs/rfc2396.html
1575
79fd8837
JB
1576=head1 TODO
1577
1578=over 4
1579
1580=item Implement $PREFER_BIN
1581
1582To indicate to rather use commandline tools than modules
1583
a0ad4830
JB
1584=back
1585
1586=head1 BUG REPORTS
1587
1588Please report bugs or other issues to E<lt>bug-file-fetch@rt.cpan.org<gt>.
1589
1590=head1 AUTHOR
79fd8837 1591
d4b3706f 1592This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
79fd8837
JB
1593
1594=head1 COPYRIGHT
1595
a0ad4830
JB
1596This library is free software; you may redistribute and/or modify it
1597under the same terms as Perl itself.
79fd8837 1598
79fd8837
JB
1599
1600=cut
1601
1602# Local variables:
1603# c-indentation-style: bsd
1604# c-basic-offset: 4
1605# indent-tabs-mode: nil
1606# End:
1607# vim: expandtab shiftwidth=4:
1608
1609
1610
1611