This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update File-Fetch to CPAN version 0.26
[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.26';
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 lynx iosock| ],
40     ftp     => [ qw|lwp netftp wget curl lftp 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
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 preceeding 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 sesssions, 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
1184 ### use File::Copy for fetching file:// urls ###
1185 ###
1186 ### See section 3.10 of RFC 1738 (http://www.faqs.org/rfcs/rfc1738.html)
1187 ### Also see wikipedia on file:// (http://en.wikipedia.org/wiki/File://)
1188 ###
1189     
1190 sub _file_fetch {
1191     my $self = shift;
1192     my %hash = @_;
1193
1194     my ($to);
1195     my $tmpl = {
1196         to  => { required => 1, store => \$to }
1197     };
1198     check( $tmpl, \%hash ) or return;
1199
1200     
1201     
1202     ### prefix a / on unix systems with a file uri, since it would
1203     ### look somewhat like this:
1204     ###     file:///home/kane/file
1205     ### wheras windows file uris for 'c:\some\dir\file' might look like:
1206     ###     file:///C:/some/dir/file
1207     ###     file:///C|/some/dir/file
1208     ### or for a network share '\\host\share\some\dir\file':
1209     ###     file:////host/share/some/dir/file
1210     ###    
1211     ### VMS file uri's for 'DISK$USER:[MY.NOTES]NOTE123456.TXT' might look like:
1212     ###     file://vms.host.edu/disk$user/my/notes/note12345.txt
1213     ###
1214     
1215     my $path    = $self->path;
1216     my $vol     = $self->vol;
1217     my $share   = $self->share;
1218
1219     my $remote;
1220     if (!$share and $self->host) {
1221         return $self->_error(loc( 
1222             "Currently %1 cannot handle hosts in %2 urls",
1223             'File::Fetch', 'file://'
1224         ));            
1225     }
1226     
1227     if( $vol ) {
1228         $path   = File::Spec->catdir( split /\//, $path );
1229         $remote = File::Spec->catpath( $vol, $path, $self->file);
1230
1231     } elsif( $share ) {
1232         ### win32 specific, and a share name, so we wont bother with File::Spec
1233         $path   =~ s|/+|\\|g;
1234         $remote = "\\\\".$self->host."\\$share\\$path";
1235
1236     } else {
1237         ### File::Spec on VMS can not currently handle UNIX syntax.
1238         my $file_class = ON_VMS
1239             ? 'File::Spec::Unix'
1240             : 'File::Spec';
1241
1242         $remote  = $file_class->catfile( $path, $self->file );
1243     }
1244
1245     ### File::Copy is littered with 'die' statements :( ###
1246     my $rv = eval { File::Copy::copy( $remote, $to ) };
1247
1248     ### something went wrong ###
1249     if( !$rv or $@ ) {
1250         return $self->_error(loc("Could not copy '%1' to '%2': %3 %4",
1251                              $remote, $to, $!, $@));
1252     }
1253
1254     return $to;
1255 }
1256
1257 ### use /usr/bin/rsync to fetch files
1258 sub _rsync_fetch {
1259     my $self = shift;
1260     my %hash = @_;
1261
1262     my ($to);
1263     my $tmpl = {
1264         to  => { required => 1, store => \$to }
1265     };
1266     check( $tmpl, \%hash ) or return;
1267
1268     if (my $rsync = can_run('rsync')) {
1269
1270         my $cmd = [ $rsync ];
1271
1272         ### XXX: rsync has no I/O timeouts at all, by default
1273         push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;
1274
1275         push(@$cmd, '--quiet') unless $DEBUG;
1276
1277         ### DO NOT quote things for IPC::Run, it breaks stuff.
1278         push @$cmd, $self->uri, $to;
1279
1280         ### with IPC::Cmd > 0.41, this is fixed in teh library,
1281         ### and there's no need for special casing any more.
1282         ### DO NOT quote things for IPC::Run, it breaks stuff.
1283         # $IPC::Cmd::USE_IPC_RUN
1284         #    ? ($to, $self->uri)
1285         #    : (QUOTE. $to .QUOTE, QUOTE. $self->uri .QUOTE);
1286
1287         my $captured;
1288         unless(run( command => $cmd,
1289                     buffer  => \$captured,
1290                     verbose => $DEBUG )
1291         ) {
1292
1293             return $self->_error(loc("Command %1 failed: %2", 
1294                 "@$cmd" || '', $captured || ''));
1295         }
1296
1297         return $to;
1298
1299     } else {
1300         $METHOD_FAIL->{'rsync'} = 1;
1301         return;
1302     }
1303 }
1304
1305 #################################
1306 #
1307 # Error code
1308 #
1309 #################################
1310
1311 =pod
1312
1313 =head2 $ff->error([BOOL])
1314
1315 Returns the last encountered error as string.
1316 Pass it a true value to get the C<Carp::longmess()> output instead.
1317
1318 =cut
1319
1320 ### error handling the way Archive::Extract does it
1321 sub _error {
1322     my $self    = shift;
1323     my $error   = shift;
1324     
1325     $self->_error_msg( $error );
1326     $self->_error_msg_long( Carp::longmess($error) );
1327     
1328     if( $WARN ) {
1329         carp $DEBUG ? $self->_error_msg_long : $self->_error_msg;
1330     }
1331
1332     return;
1333 }
1334
1335 sub error {
1336     my $self = shift;
1337     return shift() ? $self->_error_msg_long : $self->_error_msg;
1338 }
1339
1340
1341 1;
1342
1343 =pod
1344
1345 =head1 HOW IT WORKS
1346
1347 File::Fetch is able to fetch a variety of uris, by using several
1348 external programs and modules.
1349
1350 Below is a mapping of what utilities will be used in what order
1351 for what schemes, if available:
1352
1353     file    => LWP, lftp, file
1354     http    => LWP, HTTP::Lite, wget, curl, lftp, lynx, iosock
1355     ftp     => LWP, Net::FTP, wget, curl, lftp, ncftp, ftp
1356     rsync   => rsync
1357
1358 If you'd like to disable the use of one or more of these utilities
1359 and/or modules, see the C<$BLACKLIST> variable further down.
1360
1361 If a utility or module isn't available, it will be marked in a cache
1362 (see the C<$METHOD_FAIL> variable further down), so it will not be
1363 tried again. The C<fetch> method will only fail when all options are
1364 exhausted, and it was not able to retrieve the file.
1365
1366 C<iosock> is a very limited L<IO::Socket::INET> based mechanism for
1367 retrieving C<http> schemed urls. It doesn't follow redirects for instance.
1368
1369 A special note about fetching files from an ftp uri:
1370
1371 By default, all ftp connections are done in passive mode. To change
1372 that, see the C<$FTP_PASSIVE> variable further down.
1373
1374 Furthermore, ftp uris only support anonymous connections, so no
1375 named user/password pair can be passed along.
1376
1377 C</bin/ftp> is blacklisted by default; see the C<$BLACKLIST> variable
1378 further down.
1379
1380 =head1 GLOBAL VARIABLES
1381
1382 The behaviour of File::Fetch can be altered by changing the following
1383 global variables:
1384
1385 =head2 $File::Fetch::FROM_EMAIL
1386
1387 This is the email address that will be sent as your anonymous ftp
1388 password.
1389
1390 Default is C<File-Fetch@example.com>.
1391
1392 =head2 $File::Fetch::USER_AGENT
1393
1394 This is the useragent as C<LWP> will report it.
1395
1396 Default is C<File::Fetch/$VERSION>.
1397
1398 =head2 $File::Fetch::FTP_PASSIVE
1399
1400 This variable controls whether the environment variable C<FTP_PASSIVE>
1401 and any passive switches to commandline tools will be set to true.
1402
1403 Default value is 1.
1404
1405 Note: When $FTP_PASSIVE is true, C<ncftp> will not be used to fetch
1406 files, since passive mode can only be set interactively for this binary
1407
1408 =head2 $File::Fetch::TIMEOUT
1409
1410 When set, controls the network timeout (counted in seconds).
1411
1412 Default value is 0.
1413
1414 =head2 $File::Fetch::WARN
1415
1416 This variable controls whether errors encountered internally by
1417 C<File::Fetch> should be C<carp>'d or not.
1418
1419 Set to false to silence warnings. Inspect the output of the C<error()>
1420 method manually to see what went wrong.
1421
1422 Defaults to C<true>.
1423
1424 =head2 $File::Fetch::DEBUG
1425
1426 This enables debugging output when calling commandline utilities to
1427 fetch files.
1428 This also enables C<Carp::longmess> errors, instead of the regular
1429 C<carp> errors.
1430
1431 Good for tracking down why things don't work with your particular
1432 setup.
1433
1434 Default is 0.
1435
1436 =head2 $File::Fetch::BLACKLIST
1437
1438 This is an array ref holding blacklisted modules/utilities for fetching
1439 files with.
1440
1441 To disallow the use of, for example, C<LWP> and C<Net::FTP>, you could
1442 set $File::Fetch::BLACKLIST to:
1443
1444     $File::Fetch::BLACKLIST = [qw|lwp netftp|]
1445
1446 The default blacklist is [qw|ftp|], as C</bin/ftp> is rather unreliable.
1447
1448 See the note on C<MAPPING> below.
1449
1450 =head2 $File::Fetch::METHOD_FAIL
1451
1452 This is a hashref registering what modules/utilities were known to fail
1453 for fetching files (mostly because they weren't installed).
1454
1455 You can reset this cache by assigning an empty hashref to it, or
1456 individually remove keys.
1457
1458 See the note on C<MAPPING> below.
1459
1460 =head1 MAPPING
1461
1462
1463 Here's a quick mapping for the utilities/modules, and their names for
1464 the $BLACKLIST, $METHOD_FAIL and other internal functions.
1465
1466     LWP         => lwp
1467     HTTP::Lite  => httplite
1468     Net::FTP    => netftp
1469     wget        => wget
1470     lynx        => lynx
1471     ncftp       => ncftp
1472     ftp         => ftp
1473     curl        => curl
1474     rsync       => rsync
1475     lftp        => lftp
1476     IO::Socket  => iosock
1477
1478 =head1 FREQUENTLY ASKED QUESTIONS
1479
1480 =head2 So how do I use a proxy with File::Fetch?
1481
1482 C<File::Fetch> currently only supports proxies with LWP::UserAgent.
1483 You will need to set your environment variables accordingly. For
1484 example, to use an ftp proxy:
1485
1486     $ENV{ftp_proxy} = 'foo.com';
1487
1488 Refer to the LWP::UserAgent manpage for more details.
1489
1490 =head2 I used 'lynx' to fetch a file, but its contents is all wrong!
1491
1492 C<lynx> can only fetch remote files by dumping its contents to C<STDOUT>,
1493 which we in turn capture. If that content is a 'custom' error file
1494 (like, say, a C<404 handler>), you will get that contents instead.
1495
1496 Sadly, C<lynx> doesn't support any options to return a different exit
1497 code on non-C<200 OK> status, giving us no way to tell the difference
1498 between a 'successfull' fetch and a custom error page.
1499
1500 Therefor, we recommend to only use C<lynx> as a last resort. This is 
1501 why it is at the back of our list of methods to try as well.
1502
1503 =head2 Files I'm trying to fetch have reserved characters or non-ASCII characters in them. What do I do?
1504
1505 C<File::Fetch> is relatively smart about things. When trying to write 
1506 a file to disk, it removes the C<query parameters> (see the 
1507 C<output_file> method for details) from the file name before creating
1508 it. In most cases this suffices.
1509
1510 If you have any other characters you need to escape, please install 
1511 the C<URI::Escape> module from CPAN, and pre-encode your URI before
1512 passing it to C<File::Fetch>. You can read about the details of URIs 
1513 and URI encoding here:
1514
1515   http://www.faqs.org/rfcs/rfc2396.html
1516
1517 =head1 TODO
1518
1519 =over 4
1520
1521 =item Implement $PREFER_BIN
1522
1523 To indicate to rather use commandline tools than modules
1524
1525 =back
1526
1527 =head1 BUG REPORTS
1528
1529 Please report bugs or other issues to E<lt>bug-file-fetch@rt.cpan.org<gt>.
1530
1531 =head1 AUTHOR
1532
1533 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
1534
1535 =head1 COPYRIGHT
1536
1537 This library is free software; you may redistribute and/or modify it 
1538 under the same terms as Perl itself.
1539
1540
1541 =cut
1542
1543 # Local variables:
1544 # c-indentation-style: bsd
1545 # c-basic-offset: 4
1546 # indent-tabs-mode: nil
1547 # End:
1548 # vim: expandtab shiftwidth=4:
1549
1550
1551
1552