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
1 package File::Fetch;
2
3 use strict;
4 use FileHandle;
5 use File::Temp;
6 use File::Copy;
7 use File::Spec;
8 use File::Spec::Unix;
9 use File::Basename              qw[dirname];
10
11 use Cwd                         qw[cwd];
12 use Carp                        qw[carp];
13 use IPC::Cmd                    qw[can_run run QUOTE];
14 use File::Path                  qw[mkpath];
15 use File::Temp                  qw[tempdir];
16 use Params::Check               qw[check];
17 use Module::Load::Conditional   qw[can_load];
18 use Locale::Maketext::Simple    Style => 'gettext';
19
20 use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
21                 $BLACKLIST $METHOD_FAIL $VERSION $METHODS
22                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN
23             ];
24
25 $VERSION        = '0.28';
26 $VERSION        = eval $VERSION;    # avoid warnings with development releases
27 $PREFER_BIN     = 0;                # XXX TODO implement
28 $FROM_EMAIL     = 'File-Fetch@example.com';
29 $USER_AGENT     = "File::Fetch/$VERSION";
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 = {
39     http    => [ qw|lwp httplite wget curl lftp fetch lynx iosock| ],
40     ftp     => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ],
41     file    => [ qw|lwp lftp file| ],
42     rsync   => [ qw|rsync| ]
43 };
44
45 ### silly warnings ###
46 local $Params::Check::VERBOSE               = 1;
47 local $Params::Check::VERBOSE               = 1;
48 local $Module::Load::Conditional::VERBOSE   = 0;
49 local $Module::Load::Conditional::VERBOSE   = 0;
50
51 ### see what OS we are on, important for file:// uris ###
52 use constant ON_WIN     => ($^O eq 'MSWin32');
53 use constant ON_VMS     => ($^O eq 'VMS');                                
54 use constant ON_UNIX    => (!ON_WIN);
55 use constant HAS_VOL    => (ON_WIN);
56 use constant HAS_SHARE  => (ON_WIN);
57 use constant HAS_FETCH  => ( $^O =~ m!^(freebsd|netbsd|dragonfly)$! );
58
59 =pod
60
61 =head1 NAME
62
63 File::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
87 File::Fetch is a generic file fetching mechanism.
88
89 It allows you to fetch any file pointed to by a C<ftp>, C<http>,
90 C<file>, or C<rsync> uri by a number of different means.
91
92 See the C<HOW IT WORKS> section further down for details.
93
94 =head1 ACCESSORS
95
96 A C<File::Fetch> object has the following accessors
97
98 =over 4
99
100 =item $ff->uri
101
102 The uri you passed to the constructor
103
104 =item $ff->scheme
105
106 The scheme from the uri (like 'file', 'http', etc)
107
108 =item $ff->host
109
110 The hostname in the uri.  Will be empty if host was originally 
111 'localhost' for a 'file://' url.
112
113 =item $ff->vol
114
115 On operating systems with the concept of a volume the second element
116 of a file:// is considered to the be volume specification for the file.
117 Thus on Win32 this routine returns the volume, on other operating
118 systems this returns nothing.
119
120 On Windows this value may be empty if the uri is to a network share, in 
121 which case the 'share' property will be defined. Additionally, volume 
122 specifications that use '|' as ':' will be converted on read to use ':'.
123
124 On VMS, which has a volume concept, this field will be empty because VMS
125 file specifications are converted to absolute UNIX format and the volume
126 information is transparently included.
127
128 =item $ff->share
129
130 On systems with the concept of a network share (currently only Windows) returns 
131 the sharename from a file://// url.  On other operating systems returns empty.
132
133 =item $ff->path
134
135 The path from the uri, will be at least a single '/'.
136
137 =item $ff->file
138
139 The name of the remote file. For the local file name, the
140 result of $ff->output_file will be used. 
141
142 =cut
143
144
145 ##########################
146 ### Object & Accessors ###
147 ##########################
148
149 {
150     ### template for autogenerated accessors ###
151     my $Tmpl = {
152         scheme          => { default => 'http' },
153         host            => { default => 'localhost' },
154         path            => { default => '/' },
155         file            => { required => 1 },
156         uri             => { required => 1 },
157         vol             => { default => '' }, # windows for file:// uris
158         share           => { default => '' }, # windows for file:// uris
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 ) {
181             return $class->_error(loc(
182                 "Hostname required when fetching from '%1'",$args->scheme));
183         }
184         
185         for (qw[path file]) {
186             unless( $args->$_() ) { # 5.5.x needs the ()
187                 return $class->_error(loc("No '%1' specified",$_));
188             }
189         }
190         
191         return $args;
192     }    
193 }
194
195 =item $ff->output_file
196
197 The name of the output file. This is the same as $ff->file,
198 but any query parameters are stripped off. For example:
199
200     http://example.com/index.html?x=y
201
202 would make the output file be C<index.html> rather than 
203 C<index.html?x=y>.
204
205 =back
206
207 =cut
208
209 sub 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
255 =head1 METHODS
256
257 =head2 $ff = File::Fetch->new( uri => 'http://some.where.com/dir/file.txt' );
258
259 Parses the uri and creates a corresponding File::Fetch::Item object,
260 that is ready to be C<fetch>ed and returns it.
261
262 Returns false on failure.
263
264 =cut
265
266 sub 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 ###
278     my $href    = $class->_parse_uri( $uri ) or return;
279
280     ### make it into a FFI object ###
281     my $ff      = $class->_create( %$href ) or return;
282
283
284     ### return the object ###
285     return $ff;
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 ###
301 ### In the case of file:// urls there maybe be additional fields
302 ###
303 ### For systems with volume specifications such as Win32 there will be 
304 ### a volume specifier provided in the 'vol' field.
305 ###
306 ###   'vol' => 'volumename'
307 ###
308 ### For windows file shares there may be a 'share' key specified
309 ###
310 ###   'share' => 'sharename' 
311 ###
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'
316 ###
317 ### Similarly if the host interpreting the url is VMS then 
318 ### file:///disk$user/my/notes/note12345.txt' means 
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.
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. :-(
327 ###
328
329 sub _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
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://
343     if( $href->{scheme} eq 'file' ) {
344         
345         my @parts = split '/',$uri;
346
347         ### file://hostname/...
348         ### file://hostname/...
349         ### normalize file://localhost with file:///
350         $href->{host} = $parts[0] || '';
351
352         ### index in @parts where the path components begin;
353         my $index = 1;  
354
355         ### file:////hostname/sharename/blah.txt        
356         if ( HAS_SHARE and not length $parts[0] and not length $parts[1] ) {
357             
358             $href->{host}   = $parts[2] || '';  # avoid warnings
359             $href->{share}  = $parts[3] || '';  # avoid warnings        
360
361             $index          = 4         # index after the share
362
363         ### file:///D|/blah.txt
364         ### file:///D:/blah.txt
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;
379         $href->{path} = join '/', '', splice( @parts, $index, $#parts );
380
381     } else {
382         ### using anything but qw() in hash slices may produce warnings 
383         ### in older perls :-(
384         @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s;
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
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');
397
398     return $href;
399 }
400
401 =head2 $where = $ff->fetch( [to => /my/output/dir/ | \$scalar] )
402
403 Fetches the file you requested and returns the full path to the file.
404
405 By default it writes to C<cwd()>, but you can override that by specifying 
406 the 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 );
414
415 Returns the full path to the downloaded file on success, and false
416 on failure.
417
418 =cut
419
420 sub fetch {
421     my $self = shift or return;
422     my %hash = @_;
423
424     my $target;
425     my $tmpl = {
426         to  => { default => cwd(), store => \$target },
427     };
428
429     check( $tmpl, \%hash ) or return;
430
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;
439
440         ### On VMS force to VMS format so File::Spec will work.
441         $to = VMS::Filespec::vmspath($to) if ON_VMS;
442
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         }
449     }
450
451     ### set passive ftp if required ###
452     local $ENV{FTP_PASSIVE} = $FTP_PASSIVE;
453
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     
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
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( 
483                         to => $out_to
484         )){
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
497                 ### slurp mode?
498                 if( ref $target and UNIVERSAL::isa( $target, 'SCALAR' ) ) {
499                     
500                     ### open the file
501                     open my $fh, "<$file" or do {
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
512                 my $abs = File::Spec->rel2abs( $file );
513                 return $abs;
514
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
525 ########################
526 ### _*_fetch methods ###
527 ########################
528
529 ### LWP fetching ###
530 sub _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
587 ### HTTP::Lite fetching ###
588 sub _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
666 ### Simple IO::Socket::INET fetching ###
667 sub _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
701         $fh->autoflush(1);
702         binmode $fh;
703
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 );
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
725         # Check the "response"
726         # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1)
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
739         {
740           local $\;
741           print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0];
742         }
743         close $fh;
744         return $to;
745
746     } else {
747         $METHOD_FAIL->{'iosock'} = 1;
748         return;
749     }
750 }
751
752 ### Net::FTP fetching
753 sub _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 ###
807 sub _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 ###
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);
838
839         ### shell out ###
840         my $captured;
841         unless(run( command => $cmd, 
842                     buffer  => \$captured, 
843                     verbose => $DEBUG  
844         )) {
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
860 ### /bin/lftp fetch ###
861 sub _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
935
936 ### /bin/ftp fetch ###
937 sub _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
947     ### see if we have a ftp binary ###
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",
965             "get " . $self->file . " " . $self->output_file,
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
978 sub _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
988     ### see if we have a lynx binary ###
989     if( my $lynx = can_run('lynx') ) {
990
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         }            
998
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
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
1040         ### DO NOT quote things for IPC::Run, it breaks stuff.
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;
1049
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
1080 sub _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
1090     ### we can only set passive mode in interactive sessions, so bail out
1091     ### if $FTP_PASSIVE is set
1092     return if $FTP_PASSIVE;
1093
1094     ### see if we have a ncftp binary ###
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
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             
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
1130 sub _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
1143             my $cmd = [ $curl, '-q' ];
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.
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
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
1183 ### /usr/bin/fetch fetch! ###
1184 sub _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 }
1237
1238 ### use File::Copy for fetching file:// urls ###
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://)
1242 ###
1243     
1244 sub _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
1254     
1255     
1256     ### prefix a / on unix systems with a file uri, since it would
1257     ### look somewhat like this:
1258     ###     file:///home/kane/file
1259     ### whereas windows file uris for 'c:\some\dir\file' might look like:
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);
1284
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 {
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 );
1297     }
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
1312 sub _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
1331         ### DO NOT quote things for IPC::Run, it breaks stuff.
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);
1340
1341         my $captured;
1342         unless(run( command => $cmd,
1343                     buffer  => \$captured,
1344                     verbose => $DEBUG )
1345         ) {
1346
1347             return $self->_error(loc("Command %1 failed: %2", 
1348                 "@$cmd" || '', $captured || ''));
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
1369 Returns the last encountered error as string.
1370 Pass it a true value to get the C<Carp::longmess()> output instead.
1371
1372 =cut
1373
1374 ### error handling the way Archive::Extract does it
1375 sub _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;
1384     }
1385
1386     return;
1387 }
1388
1389 sub error {
1390     my $self = shift;
1391     return shift() ? $self->_error_msg_long : $self->_error_msg;
1392 }
1393
1394
1395 1;
1396
1397 =pod
1398
1399 =head1 HOW IT WORKS
1400
1401 File::Fetch is able to fetch a variety of uris, by using several
1402 external programs and modules.
1403
1404 Below is a mapping of what utilities will be used in what order
1405 for what schemes, if available:
1406
1407     file    => LWP, lftp, file
1408     http    => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock
1409     ftp     => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp
1410     rsync   => rsync
1411
1412 If you'd like to disable the use of one or more of these utilities
1413 and/or modules, see the C<$BLACKLIST> variable further down.
1414
1415 If 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
1417 tried again. The C<fetch> method will only fail when all options are
1418 exhausted, and it was not able to retrieve the file.
1419
1420 The C<fetch> utility is available on FreeBSD. NetBSD and Dragonfly BSD
1421 may also have it from C<pkgsrc>. We only check for C<fetch> on those 
1422 three platforms.
1423
1424 C<iosock> is a very limited L<IO::Socket::INET> based mechanism for
1425 retrieving C<http> schemed urls. It doesn't follow redirects for instance.
1426
1427 A special note about fetching files from an ftp uri:
1428
1429 By default, all ftp connections are done in passive mode. To change
1430 that, see the C<$FTP_PASSIVE> variable further down.
1431
1432 Furthermore, ftp uris only support anonymous connections, so no
1433 named user/password pair can be passed along.
1434
1435 C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable
1436 further down.
1437
1438 =head1 GLOBAL VARIABLES
1439
1440 The behaviour of File::Fetch can be altered by changing the following
1441 global variables:
1442
1443 =head2 $File::Fetch::FROM_EMAIL
1444
1445 This is the email address that will be sent as your anonymous ftp
1446 password.
1447
1448 Default is C<File-Fetch@example.com>.
1449
1450 =head2 $File::Fetch::USER_AGENT
1451
1452 This is the useragent as C<LWP> will report it.
1453
1454 Default is C<File::Fetch/$VERSION>.
1455
1456 =head2 $File::Fetch::FTP_PASSIVE
1457
1458 This variable controls whether the environment variable C<FTP_PASSIVE>
1459 and any passive switches to commandline tools will be set to true.
1460
1461 Default value is 1.
1462
1463 Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch
1464 files, since passive mode can only be set interactively for this binary
1465
1466 =head2 $File::Fetch::TIMEOUT
1467
1468 When set, controls the network timeout (counted in seconds).
1469
1470 Default value is 0.
1471
1472 =head2 $File::Fetch::WARN
1473
1474 This variable controls whether errors encountered internally by
1475 C<File::Fetch> should be C<carp>'d or not.
1476
1477 Set to false to silence warnings. Inspect the output of the C<error()>
1478 method manually to see what went wrong.
1479
1480 Defaults to C<true>.
1481
1482 =head2 $File::Fetch::DEBUG
1483
1484 This enables debugging output when calling commandline utilities to
1485 fetch files.
1486 This also enables C<Carp::longmess> errors, instead of the regular
1487 C<carp> errors.
1488
1489 Good for tracking down why things don't work with your particular
1490 setup.
1491
1492 Default is 0.
1493
1494 =head2 $File::Fetch::BLACKLIST
1495
1496 This is an array ref holding blacklisted modules/utilities for fetching
1497 files with.
1498
1499 To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could
1500 set $File::Fetch::BLACKLIST to:
1501
1502     $File::Fetch::BLACKLIST = [qw|lwp netftp|]
1503
1504 The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable.
1505
1506 See the note on C<MAPPING> below.
1507
1508 =head2 $File::Fetch::METHOD_FAIL
1509
1510 This is a hashref registering what modules/utilities were known to fail
1511 for fetching files (mostly because they weren't installed).
1512
1513 You can reset this cache by assigning an empty hashref to it, or
1514 individually remove keys.
1515
1516 See the note on C<MAPPING> below.
1517
1518 =head1 MAPPING
1519
1520
1521 Here's a quick mapping for the utilities/modules, and their names for
1522 the $BLACKLIST, $METHOD_FAIL and other internal functions.
1523
1524     LWP         => lwp
1525     HTTP::Lite  => httplite
1526     Net::FTP    => netftp
1527     wget        => wget
1528     lynx        => lynx
1529     ncftp       => ncftp
1530     ftp         => ftp
1531     curl        => curl
1532     rsync       => rsync
1533     lftp        => lftp
1534     fetch       => fetch
1535     IO::Socket  => iosock
1536
1537 =head1 FREQUENTLY ASKED QUESTIONS
1538
1539 =head2 So how do I use a proxy with File::Fetch?
1540
1541 C<File::Fetch> currently only supports proxies with LWP::UserAgent.
1542 You will need to set your environment variables accordingly. For
1543 example, to use an ftp proxy:
1544
1545     $ENV{ftp_proxy} = 'foo.com';
1546
1547 Refer 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
1551 C<lynx> can only fetch remote files by dumping its contents to C<STDOUT>,
1552 which 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
1555 Sadly, C<lynx> doesn't support any options to return a different exit
1556 code on non-C<200 OK> status, giving us no way to tell the difference
1557 between a 'successful' fetch and a custom error page.
1558
1559 Therefor, we recommend to only use C<lynx> as a last resort. This is 
1560 why it is at the back of our list of methods to try as well.
1561
1562 =head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?
1563
1564 C<File::Fetch> is relatively smart about things. When trying to write 
1565 a file to disk, it removes the C<query parameters> (see the 
1566 C<output_file> method for details) from the file name before creating
1567 it. In most cases this suffices.
1568
1569 If you have any other characters you need to escape, please install 
1570 the C<URI::Escape> module from CPAN, and pre-encode your URI before
1571 passing it to C<File::Fetch>. You can read about the details of URIs 
1572 and URI encoding here:
1573
1574   http://www.faqs.org/rfcs/rfc2396.html
1575
1576 =head1 TODO
1577
1578 =over 4
1579
1580 =item Implement $PREFER_BIN
1581
1582 To indicate to rather use commandline tools than modules
1583
1584 =back
1585
1586 =head1 BUG REPORTS
1587
1588 Please report bugs or other issues to E<lt>bug-file-fetch@rt.cpan.org<gt>.
1589
1590 =head1 AUTHOR
1591
1592 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
1593
1594 =head1 COPYRIGHT
1595
1596 This library is free software; you may redistribute and/or modify it 
1597 under the same terms as Perl itself.
1598
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