File Coverage

blib/lib/CPAN/FTP.pm
Criterion Covered Total %
statement 168 709 23.7
branch 56 454 12.3
condition 16 189 8.4
subroutine 20 31 64.5
pod 0 13 0.0
total 260 1396 18.6


line stmt bran cond sub pod time code
1             # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2             # vim: ts=4 sts=4 sw=4:
3             package CPAN::FTP;
4 13     13   84 use strict;
  13         27  
  13         459  
5              
6 13     13   2486 use Errno ();
  13         7621  
  13         287  
7 13     13   81 use Fcntl qw(:flock);
  13         27  
  13         1996  
8 13     13   92 use File::Basename qw(dirname);
  13         27  
  13         1133  
9 13     13   108 use File::Path qw(mkpath);
  13         39  
  13         768  
10 13     13   4999 use CPAN::FTP::netrc;
  13         33  
  13         406  
11 13     13   70 use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod);
  13         23  
  13         976  
12              
13             @CPAN::FTP::ISA = qw(CPAN::Debug);
14              
15 13         106180 use vars qw(
16             $VERSION
17 13     13   69 );
  13         23  
18             $VERSION = "5.5016";
19              
20             sub _plus_append_open {
21 0     0   0 my($fh, $file) = @_;
22 0         0 my $parent_dir = dirname $file;
23 0         0 mkpath $parent_dir;
24 0         0 my($cnt);
25 0         0 until (open $fh, "+>>$file") {
26 0 0 0     0 next if exists &Errno::EAGAIN && $! == &Errno::EAGAIN; # don't increment on EAGAIN
27 0 0       0 $CPAN::Frontend->mydie("Could not open '$file' after 10000 tries: $!") if ++$cnt > 100000;
28 0         0 sleep 0.0001;
29 0         0 mkpath $parent_dir;
30             }
31             }
32              
33             #-> sub CPAN::FTP::ftp_statistics
34             # if they want to rewrite, they need to pass in a filehandle
35             sub _ftp_statistics {
36 0     0   0 my($self,$fh) = @_;
37 0         0 my $ftpstats_size = $CPAN::Config->{ftpstats_size};
38 0 0 0     0 return if defined $ftpstats_size && $ftpstats_size <= 0;
39 0 0       0 my $locktype = $fh ? LOCK_EX : LOCK_SH;
40             # XXX On Windows flock() implements mandatory locking, so we can
41             # XXX only use shared locking to still allow _yaml_loadfile() to
42             # XXX read from the file using a different filehandle.
43 0 0       0 $locktype = LOCK_SH if $^O eq "MSWin32";
44              
45 0   0     0 $fh ||= FileHandle->new;
46 0         0 my $file = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
47 0         0 _plus_append_open($fh,$file);
48 0         0 my $sleep = 1;
49 0         0 my $waitstart;
50 0         0 while (!CPAN::_flock($fh, $locktype|LOCK_NB)) {
51 0   0     0 $waitstart ||= localtime();
52 0 0       0 if ($sleep>3) {
53 0         0 my $now = localtime();
54 0         0 $CPAN::Frontend->mywarn("$now: waiting for read lock on '$file' (since $waitstart)\n");
55             }
56 0         0 sleep($sleep); # this sleep must not be overridden;
57             # Frontend->mysleep with AUTOMATED_TESTING has
58             # provoked complete lock contention on my NFS
59 0 0       0 if ($sleep <= 6) {
60 0         0 $sleep+=0.5;
61             } else {
62             # retry to get a fresh handle. If it is NFS and the handle is stale, we will never get an flock
63 0         0 _plus_append_open($fh, $file);
64             }
65             }
66 0         0 my $stats = eval { CPAN->_yaml_loadfile($file, {loadblessed => 1}); };
  0         0  
67 0 0       0 if ($@) {
68 0 0       0 if (ref $@) {
69 0 0       0 if (ref $@ eq "CPAN::Exception::yaml_not_installed") {
    0          
70 0         0 chomp $@;
71 0         0 $CPAN::Frontend->myprintonce("Warning (usually harmless): $@\n");
72 0         0 return;
73             } elsif (ref $@ eq "CPAN::Exception::yaml_process_error") {
74 0         0 my $time = time;
75 0         0 my $to = "$file.$time";
76 0         0 $CPAN::Frontend->mywarn("Error reading '$file': $@
77             Trying to stash it away as '$to' to prevent further interruptions.
78             You may want to remove that file later.\n");
79             # may fail because somebody else has moved it away in the meantime:
80 0 0       0 rename $file, $to or $CPAN::Frontend->mywarn("Could not rename '$file' to '$to': $!\n");
81 0         0 return;
82             }
83             } else {
84 0         0 $CPAN::Frontend->mydie($@);
85             }
86             }
87 0         0 CPAN::_flock($fh, LOCK_UN);
88 0         0 return $stats->[0];
89             }
90              
91             #-> sub CPAN::FTP::_mytime
92             sub _mytime () {
93 6 50   6   29 if (CPAN->has_inst("Time::HiRes")) {
94 6         59 return Time::HiRes::time();
95             } else {
96 0         0 return time;
97             }
98             }
99              
100             #-> sub CPAN::FTP::_new_stats
101             sub _new_stats {
102 3     3   9 my($self,$file) = @_;
103 3         16 my $ret = {
104             file => $file,
105             attempts => [],
106             start => _mytime,
107             };
108 3         10 $ret;
109             }
110              
111             #-> sub CPAN::FTP::_add_to_statistics
112             sub _add_to_statistics {
113 3     3   9 my($self,$stats) = @_;
114 3         16 my $yaml_module = CPAN::_yaml_module();
115 3 50       10 $self->debug("yaml_module[$yaml_module]") if $CPAN::DEBUG;
116 3 50       13 if ($CPAN::META->has_inst($yaml_module)) {
117 0         0 $stats->{thesiteurl} = $ThesiteURL;
118 0         0 $stats->{end} = CPAN::FTP::_mytime();
119 0         0 my $fh = FileHandle->new;
120 0         0 my $time = time;
121 0         0 my $sdebug = 0;
122 0         0 my @debug;
123 0 0       0 @debug = $time if $sdebug;
124 0         0 my $fullstats = $self->_ftp_statistics($fh);
125 0 0 0     0 close $fh if $fh && defined(fileno($fh));
126 0   0     0 $fullstats->{history} ||= [];
127 0 0       0 push @debug, scalar @{$fullstats->{history}} if $sdebug;
  0         0  
128 0 0       0 push @debug, time if $sdebug;
129 0         0 push @{$fullstats->{history}}, $stats;
  0         0  
130             # YAML.pm 0.62 is unacceptably slow with 999;
131             # YAML::Syck 0.82 has no noticable performance problem with 999;
132 0         0 my $ftpstats_size = $CPAN::Config->{ftpstats_size};
133 0 0       0 $ftpstats_size = 99 unless defined $ftpstats_size;
134 0   0     0 my $ftpstats_period = $CPAN::Config->{ftpstats_period} || 14;
135 0   0     0 while (
      0        
136 0 0       0 @{$fullstats->{history} || []}
137             &&
138             (
139             @{$fullstats->{history}} > $ftpstats_size
140             || $time - $fullstats->{history}[0]{start} > 86400*$ftpstats_period
141             )
142             ) {
143 0         0 shift @{$fullstats->{history}}
  0         0  
144             }
145 0 0       0 push @debug, scalar @{$fullstats->{history}} if $sdebug;
  0         0  
146 0 0       0 push @debug, time if $sdebug;
147 0 0       0 push @debug, scalar localtime($fullstats->{history}[0]{start}) if $sdebug;
148             # need no eval because if this fails, it is serious
149 0         0 my $sfile = File::Spec->catfile($CPAN::Config->{cpan_home},"FTPstats.yml");
150 0         0 CPAN->_yaml_dumpfile("$sfile.$$",$fullstats);
151 0 0       0 if ( $sdebug ) {
152 0         0 local $CPAN::DEBUG = 512; # FTP
153 0         0 push @debug, time;
154 0         0 CPAN->debug(sprintf("DEBUG history: before_read[%d]before[%d]at[%d]".
155             "after[%d]at[%d]oldest[%s]dumped backat[%d]",
156             @debug,
157             ));
158             }
159             # Win32 cannot rename a file to an existing filename
160 0 0 0     0 unlink($sfile) if ($^O eq 'MSWin32' or $^O eq 'os2');
161 0 0       0 _copy_stat($sfile, "$sfile.$$") if -e $sfile;
162 0 0       0 rename "$sfile.$$", $sfile
163             or $CPAN::Frontend->mywarn("Could not rename '$sfile.$$' to '$sfile': $!\nGiving up\n");
164             }
165             }
166              
167             # Copy some stat information (owner, group, mode and) from one file to
168             # another.
169             # This is a utility function which might be moved to a utility repository.
170             #-> sub CPAN::FTP::_copy_stat
171             sub _copy_stat {
172 0     0   0 my($src, $dest) = @_;
173 0         0 my @stat = stat($src);
174 0 0       0 if (!@stat) {
175 0         0 $CPAN::Frontend->mywarn("Can't stat '$src': $!\n");
176 0         0 return;
177             }
178              
179 0         0 eval {
180 0 0       0 chmod $stat[2], $dest
181             or $CPAN::Frontend->mywarn("Can't chmod '$dest' to " . sprintf("0%o", $stat[2]) . ": $!\n");
182             };
183 0 0       0 warn $@ if $@;
184 0         0 eval {
185             chown $stat[4], $stat[5], $dest
186 0 0       0 or do {
187 0         0 my $save_err = $!; # otherwise it's lost in the get... calls
188 0         0 $CPAN::Frontend->mywarn("Can't chown '$dest' to " .
189             (getpwuid($stat[4]))[0] . "/" .
190             (getgrgid($stat[5]))[0] . ": $save_err\n"
191             );
192             };
193             };
194 0 0       0 warn $@ if $@;
195             }
196              
197             # if file is CHECKSUMS, suggest the place where we got the file to be
198             # checked from, maybe only for young files?
199             #-> sub CPAN::FTP::_recommend_url_for
200             sub _recommend_url_for {
201 3     3   13 my($self, $file, $urllist) = @_;
202 3 50       12 if ($file =~ s|/CHECKSUMS(.gz)?$||) {
203 0         0 my $fullstats = $self->_ftp_statistics();
204 0   0     0 my $history = $fullstats->{history} || [];
205 0         0 while (my $last = pop @$history) {
206 0 0       0 last if $last->{end} - time > 3600; # only young results are interesting
207 0 0       0 next unless $last->{file}; # dirname of nothing dies!
208 0 0       0 next unless $file eq dirname($last->{file});
209 0         0 return $last->{thesiteurl};
210             }
211             }
212 3 50 33     13 if ($CPAN::Config->{randomize_urllist}
213             &&
214             rand(1) < $CPAN::Config->{randomize_urllist}
215             ) {
216 0         0 $urllist->[int rand scalar @$urllist];
217             } else {
218 3         12 return ();
219             }
220             }
221              
222             #-> sub CPAN::FTP::_get_urllist
223             sub _get_urllist {
224 3     3   8 my($self, $with_defaults) = @_;
225 3   50     18 $with_defaults ||= 0;
226 3 50       10 CPAN->debug("with_defaults[$with_defaults]") if $CPAN::DEBUG;
227              
228 3   50     11 $CPAN::Config->{urllist} ||= [];
229 3 50       15 unless (ref $CPAN::Config->{urllist} eq 'ARRAY') {
230 0         0 $CPAN::Frontend->mywarn("Malformed urllist; ignoring. Configuration file corrupt?\n");
231 0         0 $CPAN::Config->{urllist} = [];
232             }
233 3 50       7 my @urllist = grep { defined $_ and length $_ } @{$CPAN::Config->{urllist}};
  3         36  
  3         9  
234 3 50       9 push @urllist, @CPAN::Defaultsites if $with_defaults;
235 3         8 for my $u (@urllist) {
236 3 50       9 CPAN->debug("u[$u]") if $CPAN::DEBUG;
237 3 50       37 if (UNIVERSAL::can($u,"text")) {
238 0 0       0 $u->{TEXT} .= "/" unless substr($u->{TEXT},-1) eq "/";
239             } else {
240 3 50       16 $u .= "/" unless substr($u,-1) eq "/";
241 3         37 $u = CPAN::URL->new(TEXT => $u, FROM => "USER");
242             }
243             }
244 3         12 \@urllist;
245             }
246              
247             #-> sub CPAN::FTP::ftp_get ;
248             sub ftp_get {
249 0     0 0 0 my($class,$host,$dir,$file,$target) = @_;
250 0 0       0 $class->debug(
251             qq[Going to fetch file [$file] from dir [$dir]
252             on host [$host] as local [$target]\n]
253             ) if $CPAN::DEBUG;
254 0         0 my $ftp = Net::FTP->new($host);
255 0 0       0 unless ($ftp) {
256 0         0 $CPAN::Frontend->mywarn(" Could not connect to host '$host' with Net::FTP\n");
257 0         0 return;
258             }
259 0 0       0 return 0 unless defined $ftp;
260 0 0       0 $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
261 0         0 $class->debug(qq[Going to login("anonymous","$Config::Config{cf_email}")]);
262 0 0       0 unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ) {
263 0         0 my $msg = $ftp->message;
264 0         0 $CPAN::Frontend->mywarn(" Couldn't login on $host: $msg\n");
265 0         0 return;
266             }
267 0 0       0 unless ( $ftp->cwd($dir) ) {
268 0         0 my $msg = $ftp->message;
269 0         0 $CPAN::Frontend->mywarn(" Couldn't cwd $dir: $msg\n");
270 0         0 return;
271             }
272 0         0 $ftp->binary;
273 0 0       0 $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
274 0 0       0 unless ( $ftp->get($file,$target) ) {
275 0         0 my $msg = $ftp->message;
276 0         0 $CPAN::Frontend->mywarn(" Couldn't fetch $file from $host: $msg\n");
277 0         0 return;
278             }
279 0         0 $ftp->quit; # it's ok if this fails
280 0         0 return 1;
281             }
282              
283             # If more accuracy is wanted/needed, Chris Leach sent me this patch...
284              
285             # > *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
286             # > --- /tmp/cp Wed Sep 24 13:26:40 1997
287             # > ***************
288             # > *** 1562,1567 ****
289             # > --- 1562,1580 ----
290             # > return 1 if substr($url,0,4) eq "file";
291             # > return 1 unless $url =~ m|://([^/]+)|;
292             # > my $host = $1;
293             # > + my $proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'};
294             # > + if ($proxy) {
295             # > + $proxy =~ m|://([^/:]+)|;
296             # > + $proxy = $1;
297             # > + my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'};
298             # > + if ($noproxy) {
299             # > + if ($host !~ /$noproxy$/) {
300             # > + $host = $proxy;
301             # > + }
302             # > + } else {
303             # > + $host = $proxy;
304             # > + }
305             # > + }
306             # > require Net::Ping;
307             # > return 1 unless $Net::Ping::VERSION >= 2;
308             # > my $p;
309              
310              
311             #-> sub CPAN::FTP::localize ;
312             sub localize {
313 3     3 0 11 my($self,$file,$aslocal,$force,$with_defaults) = @_;
314 3   50     15 $force ||= 0;
315 3 50       11 Carp::croak( "Usage: ->localize(cpan_file,as_local_file[,\$force])" )
316             unless defined $aslocal;
317 3 50       10 if ($CPAN::DEBUG){
318 0         0 require Carp;
319 0         0 my $longmess = Carp::longmess();
320 0         0 $self->debug("file[$file] aslocal[$aslocal] force[$force] carplongmess[$longmess]");
321             }
322 3         10 for ($CPAN::Config->{connect_to_internet_ok}) {
323 3 50 33     30 $connect_to_internet_ok = $_ if not defined $connect_to_internet_ok and defined $_;
324             }
325 3         7 my $ph = $CPAN::Config->{pushy_https};
326 3 50 33     21 if (!defined $ph || $ph) {
327 0         0 return $self->localize_2021($file,$aslocal,$force,$with_defaults);
328             } else {
329 3         29 return $self->localize_1995ff($file,$aslocal,$force,$with_defaults);
330             }
331             }
332              
333             sub have_promising_aslocal {
334 3     3 0 10 my($self, $aslocal, $force) = @_;
335 3 0 33     35 if (-f $aslocal && -r _ && !($force & 1)) {
      33        
336 0         0 my $size;
337 0 0       0 if ($size = -s $aslocal) {
338 0 0       0 $self->debug("aslocal[$aslocal]size[$size]") if $CPAN::DEBUG;
339 0         0 return 1;
340             } else {
341             # empty file from a previous unsuccessful attempt to download it
342 0 0       0 unlink $aslocal or
343             $CPAN::Frontend->mydie("Found a zero-length '$aslocal' that I ".
344             "could not remove.");
345             }
346             }
347 3         12 return;
348             }
349              
350             #-> sub CPAN::FTP::localize ;
351             sub localize_2021 {
352 0     0 0 0 my($self,$file,$aslocal,$force,$with_defaults) = @_;
353 0 0       0 return $aslocal if $self->have_promising_aslocal($aslocal, $force);
354 0         0 my($aslocal_dir) = dirname($aslocal);
355 0         0 my $ret;
356 0         0 $self->mymkpath($aslocal_dir);
357 0         0 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
358 0         0 my $base;
359 0 0 0     0 if (
      0        
      0        
      0        
360             ($CPAN::META->has_usable('HTTP::Tiny')
361             && $CPAN::META->has_usable('Net::SSLeay')
362             && $CPAN::META->has_usable('IO::Socket::SSL')
363             )
364             || $CPAN::Config->{curl}
365             || $CPAN::Config->{wget}
366             ) {
367 0         0 for my $prx (qw(https_proxy no_proxy)) {
368 0 0       0 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
369             }
370 0         0 $base = "https://cpan.org/";
371             } else {
372 0         0 my @missing_modules = grep { ! $CPAN::META->has_usable($_) } qw(HTTP::Tiny Net::SSLeay IO::Socket::SSL);
  0         0  
373 0         0 my $miss = join ", ", map { "'$_'" } @missing_modules;
  0         0  
374 0 0       0 my $modules = @missing_modules == 1 ? "module" : "modules";
375 0         0 $CPAN::Frontend->mywarn("Missing or unusable $modules $miss, and found neither curl nor wget installed.\n");
376 0 0       0 if ($CPAN::META->has_usable('HTTP::Tiny')) {
377 0         0 $CPAN::Frontend->mywarn("Need to fall back to http.\n")
378             }
379 0         0 for my $prx (qw(http_proxy no_proxy)) {
380 0 0       0 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
381             }
382 0         0 $base = "http://www.cpan.org/";
383             }
384 0         0 $ret = $self->hostdl_2021($base,$file,$aslocal_tempfile);
385 0 0       0 if ($ret) { # c&p from below
386 0 0       0 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
387 0 0       0 if ($ret eq $aslocal_tempfile) {
388             # if we got it exactly as we asked for, only then we
389             # want to rename
390 0 0       0 rename $aslocal_tempfile, $aslocal
391             or $CPAN::Frontend->mydie("Error while trying to rename ".
392             "'$ret' to '$aslocal': $!");
393 0         0 $ret = $aslocal;
394             }
395             } else {
396 0         0 unlink $aslocal_tempfile;
397 0         0 return;
398             }
399 0         0 return $ret;
400             }
401              
402             sub hostdl_2021 {
403 0     0 0 0 my($self, $base, $file, $aslocal) = @_; # the $aslocal is $aslocal_tempfile in the caller (old convention)
404 0         0 my $proxy_vars = $self->_proxy_vars($base);
405 0         0 my($proto) = $base =~ /^(https?)/;
406 0         0 my $url = "$base$file";
407             # hostdl_2021 may be called with either http or https urls
408 0 0 0     0 if (
    0 0        
      0        
409             $CPAN::META->has_usable('HTTP::Tiny')
410             &&
411             (
412             $proto eq "http"
413             ||
414             ( $CPAN::META->has_usable('Net::SSLeay')
415             && $CPAN::META->has_usable('IO::Socket::SSL') )
416             )
417             ){
418             # mostly c&p from below
419 0         0 require CPAN::HTTP::Client;
420             my $chc = CPAN::HTTP::Client->new(
421             proxy => $CPAN::Config->{http_proxy} || $ENV{http_proxy},
422             no_proxy => $CPAN::Config->{no_proxy} || $ENV{no_proxy},
423 0   0     0 );
      0        
424 0 0       0 for my $try ( $url, ( $url !~ /\.gz(?!\n)\Z/ ? "$url.gz" : () ) ) {
425 0         0 $CPAN::Frontend->myprint("Fetching with HTTP::Tiny:\n$try\n");
426 0         0 my $res = eval { $chc->mirror($try, $aslocal) };
  0         0  
427 0 0 0     0 if ( $res && $res->{success} ) {
    0 0        
    0 0        
428 0         0 my $now = time;
429 0         0 utime $now, $now, $aslocal; # download time is more
430             # important than upload
431             # time
432 0         0 return $aslocal;
433             }
434             elsif ( $res && $res->{status} ne '599') {
435             $CPAN::Frontend->myprint(sprintf(
436             "HTTP::Tiny failed with code[%s] message[%s]\n",
437             $res->{status},
438             $res->{reason},
439             )
440 0         0 );
441             }
442             elsif ( $res && $res->{status} eq '599') {
443             $CPAN::Frontend->myprint(sprintf(
444             "HTTP::Tiny failed with an internal error: %s\n",
445             $res->{content},
446             )
447 0         0 );
448             }
449             else {
450 0   0     0 my $err = $@ || 'Unknown error';
451 0         0 $CPAN::Frontend->myprint(sprintf(
452             "Error downloading with HTTP::Tiny: %s\n", $err
453             )
454             );
455             }
456             }
457             } elsif ($CPAN::Config->{curl} || $CPAN::Config->{wget}){
458             # c&p from further down
459 0         0 my($src_switch, $stdout_redir);
460 0   0     0 my($devnull) = $CPAN::Config->{devnull} || "";
461 0         0 DLPRG: for my $dlprg (qw(curl wget)) {
462 0         0 my $dlprg_configured = $CPAN::Config->{$dlprg};
463 0 0 0     0 next unless defined $dlprg_configured && length $dlprg_configured;
464 0         0 my $funkyftp = CPAN::HandleConfig->safe_quote($dlprg_configured);
465 0 0       0 if ($dlprg eq "wget") {
    0          
466 0         0 $src_switch = " -O \"$aslocal\"";
467 0         0 $stdout_redir = "";
468             } elsif ($dlprg eq 'curl') {
469 0         0 $src_switch = ' -L -f -s -S --netrc-optional';
470 0         0 $stdout_redir = " > \"$aslocal\"";
471 0 0       0 if ($proxy_vars->{http_proxy}) {
472 0         0 $src_switch .= qq{ -U "$proxy_vars->{proxy_user}:$proxy_vars->{proxy_pass}" -x "$proxy_vars->{http_proxy}"};
473             }
474             }
475             $CPAN::Frontend->myprint(
476 0         0 qq[
477             Trying with
478             $funkyftp$src_switch
479             to get
480             $url
481             ]);
482 0         0 my($system) =
483             "$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
484 0 0       0 $self->debug("system[$system]") if $CPAN::DEBUG;
485 0         0 my($wstatus) = system($system);
486 0 0       0 if ($wstatus == 0) {
487 0         0 return $aslocal;
488             } else {
489 0         0 my $estatus = $wstatus >> 8;
490 0 0       0 my $size = -f $aslocal ?
491             ", left\n$aslocal with size ".-s _ :
492             "\nWarning: expected file [$aslocal] doesn't exist";
493 0         0 $CPAN::Frontend->myprint(qq{
494             Function system("$system")
495             returned status $estatus (wstat $wstatus)$size
496             });
497             }
498             } # DLPRG
499             } # curl, wget
500 0         0 return;
501             }
502              
503             #-> sub CPAN::FTP::localize ;
504             sub localize_1995ff {
505 3     3 0 60 my($self,$file,$aslocal,$force,$with_defaults) = @_;
506 3 50       17 if ($^O eq 'MacOS') {
507             # Comment by AK on 2000-09-03: Uniq short filenames would be
508             # available in CHECKSUMS file
509 0         0 my($name, $path) = File::Basename::fileparse($aslocal, '');
510 0 0       0 if (length($name) > 31) {
511 0         0 $name =~ s/(
512             \.(
513             readme(\.(gz|Z))? |
514             (tar\.)?(gz|Z) |
515             tgz |
516             zip |
517             pm\.(gz|Z)
518             )
519             )$//x;
520 0         0 my $suf = $1;
521 0         0 my $size = 31 - length($suf);
522 0         0 while (length($name) > $size) {
523 0         0 chop $name;
524             }
525 0         0 $name .= $suf;
526 0         0 $aslocal = File::Spec->catfile($path, $name);
527             }
528             }
529              
530 3 50       14 return $aslocal if $self->have_promising_aslocal($aslocal, $force);
531 3         9 my($maybe_restore) = 0;
532 3 50       26 if (-f $aslocal) {
533 0         0 rename $aslocal, "$aslocal.bak$$";
534 0         0 $maybe_restore++;
535             }
536              
537 3         260 my($aslocal_dir) = dirname($aslocal);
538             # Inheritance is not easier to manage than a few if/else branches
539 3 50       23 if ($CPAN::META->has_usable('LWP::UserAgent')) {
540 0 0       0 unless ($Ua) {
541 0         0 CPAN::LWP::UserAgent->config;
542 0         0 eval {$Ua = CPAN::LWP::UserAgent->new;}; # Why is has_usable still not fit enough?
  0         0  
543 0 0       0 if ($@) {
544 0 0       0 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n")
545             if $CPAN::DEBUG;
546             } else {
547 0         0 my($var);
548             $Ua->proxy('ftp', $var)
549 0 0 0     0 if $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy};
550             $Ua->proxy('http', $var)
551 0 0 0     0 if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy};
552             $Ua->no_proxy($var)
553 0 0 0     0 if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy};
554             }
555             }
556             }
557 3         19 for my $prx (qw(ftp_proxy http_proxy no_proxy)) {
558 9 50       23 $ENV{$prx} = $CPAN::Config->{$prx} if $CPAN::Config->{$prx};
559             }
560              
561             # Try the list of urls for each single object. We keep a record
562             # where we did get a file from
563 3         6 my(@reordered,$last);
564 3         18 my $ccurllist = $self->_get_urllist($with_defaults);
565 3         10 $last = $#$ccurllist;
566 3 50       11 if ($force & 2) { # local cpans probably out of date, don't reorder
567 3         12 @reordered = (0..$last);
568             } else {
569             @reordered =
570             sort {
571 0 0 0     0 (substr($ccurllist->[$b],0,4) eq "file")
  0         0  
572             <=>
573             (substr($ccurllist->[$a],0,4) eq "file")
574             or
575             defined($ThesiteURL)
576             and
577             ($ccurllist->[$b] eq $ThesiteURL)
578             <=>
579             ($ccurllist->[$a] eq $ThesiteURL)
580             } 0..$last;
581             }
582 3         7 my(@levels);
583 3   100     19 $Themethod ||= "";
584 3 50       8 $self->debug("Themethod[$Themethod]reordered[@reordered]") if $CPAN::DEBUG;
585 3         43 my @all_levels = (
586             ["dleasy", "file"],
587             ["dleasy"],
588             ["dlhard"],
589             ["dlhardest"],
590             ["dleasy", "http","defaultsites"],
591             ["dlhard", "http","defaultsites"],
592             ["dleasy", "ftp", "defaultsites"],
593             ["dlhard", "ftp", "defaultsites"],
594             ["dlhardest","", "defaultsites"],
595             );
596 3 100       14 if ($Themethod) {
597 2         5 @levels = grep {$_->[0] eq $Themethod} @all_levels;
  18         32  
598 2         6 push @levels, grep {$_->[0] ne $Themethod} @all_levels;
  18         26  
599             } else {
600 1         7 @levels = @all_levels;
601             }
602 3 50       15 @levels = qw/dleasy/ if $^O eq 'MacOS';
603 3         3 my($levelno);
604             local $ENV{FTP_PASSIVE} =
605             exists $CPAN::Config->{ftp_passive} ?
606 3 50       40 $CPAN::Config->{ftp_passive} : 1;
607 3         6 my $ret;
608 3         23 my $stats = $self->_new_stats($file);
609 3         13 LEVEL: for $levelno (0..$#levels) {
610 3         9 my $level_tuple = $levels[$levelno];
611 3         12 my($level,$scheme,$sitetag) = @$level_tuple;
612 3 50 33     65 $self->mymkpath($aslocal_dir) unless $scheme && "file" eq $scheme;
613 3   33     14 my $defaultsites = $sitetag && $sitetag eq "defaultsites" && !@$ccurllist;
614 3         6 my @urllist;
615 3 50       9 if ($defaultsites) {
616 0 0       0 unless (defined $connect_to_internet_ok) {
617             $CPAN::Frontend->myprint(sprintf qq{
618             I would like to connect to one of the following sites to get '%s':
619              
620             %s
621             },
622             $file,
623 0         0 join("",map { " ".$_->text."\n" } @CPAN::Defaultsites),
  0         0  
624             );
625 0         0 my $answer = CPAN::Shell::colorable_makemaker_prompt("Is it OK to try to connect to the Internet?", "yes");
626 0 0       0 if ($answer =~ /^y/i) {
627 0         0 $connect_to_internet_ok = 1;
628             } else {
629 0         0 $connect_to_internet_ok = 0;
630             }
631             }
632 0 0       0 if ($connect_to_internet_ok) {
633 0         0 @urllist = @CPAN::Defaultsites;
634             } else {
635 0         0 my $sleep = 2;
636             # the tricky thing about dying here is that everybody
637             # believes that calls to exists() or all_objects() are
638             # safe.
639 0         0 require CPAN::Exception::blocked_urllist;
640 0         0 die CPAN::Exception::blocked_urllist->new;
641             }
642             } else { # ! $defaultsites
643 3 50       32 my @host_seq = $level =~ /dleasy/ ?
644             @reordered : 0..$last; # reordered has file and $Thesiteurl first
645 3         8 @urllist = map { $ccurllist->[$_] } @host_seq;
  3         16  
646             }
647 3 50       10 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
648 3         18 my $aslocal_tempfile = $aslocal . ".tmp" . $$;
649 3 50       21 if (my $recommend = $self->_recommend_url_for($file,\@urllist)) {
650 0         0 @urllist = grep { $_ ne $recommend } @urllist;
  0         0  
651 0         0 unshift @urllist, $recommend;
652             }
653 3 50       10 $self->debug("synth. urllist[@urllist]") if $CPAN::DEBUG;
654 3         20 $ret = $self->hostdlxxx($level,$scheme,\@urllist,$file,$aslocal_tempfile,$stats);
655 3 50       15 if ($ret) {
656 3 50       10 CPAN->debug("ret[$ret]aslocal[$aslocal]") if $CPAN::DEBUG;
657 3 50 33     105 if ($ret eq $aslocal_tempfile) {
    50          
658             # if we got it exactly as we asked for, only then we
659             # want to rename
660 0 0       0 rename $aslocal_tempfile, $aslocal
661             or $CPAN::Frontend->mydie("Error while trying to rename ".
662             "'$ret' to '$aslocal': $!");
663 0         0 $ret = $aslocal;
664             }
665             elsif (-f $ret && $scheme eq 'file' ) {
666             # it's a local file, so there's nothing left to do, we
667             # let them read from where it is
668             }
669 3         11 $Themethod = $level;
670 3         7 my $now = time;
671             # utime $now, $now, $aslocal; # too bad, if we do that, we
672             # might alter a local mirror
673 3 50       8 $self->debug("level[$level]") if $CPAN::DEBUG;
674 3         13 last LEVEL;
675             } else {
676 0         0 unlink $aslocal_tempfile;
677 0 0       0 last if $CPAN::Signal; # need to cleanup
678             }
679             }
680 3 50       9 if ($ret) {
681 3         41 $stats->{filesize} = -s $ret;
682             }
683 3 50       11 $self->debug("before _add_to_statistics") if $CPAN::DEBUG;
684 3         22 $self->_add_to_statistics($stats);
685 3 50       7 $self->debug("after _add_to_statistics") if $CPAN::DEBUG;
686 3 50       10 if ($ret) {
687 3         40 unlink "$aslocal.bak$$";
688 3         64 return $ret;
689             }
690 0 0       0 unless ($CPAN::Signal) {
691 0         0 my(@mess);
692 0         0 local $" = " ";
693 0 0       0 if (@{$CPAN::Config->{urllist}}) {
  0         0  
694             push @mess,
695             qq{Please check, if the URLs I found in your configuration file \(}.
696 0         0 join(", ", @{$CPAN::Config->{urllist}}).
  0         0  
697             qq{\) are valid.};
698             } else {
699 0         0 push @mess, qq{Your urllist is empty!};
700             }
701 0         0 push @mess, qq{The urllist can be edited.},
702             qq{E.g. with 'o conf urllist push ftp://myurl/'};
703 0         0 $CPAN::Frontend->mywarn(Text::Wrap::wrap("","","@mess"). "\n\n");
704 0         0 $CPAN::Frontend->mydie("Could not fetch $file\n");
705             }
706 0 0       0 if ($maybe_restore) {
707 0         0 rename "$aslocal.bak$$", $aslocal;
708 0         0 $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
709             $self->ls($aslocal) . "\n");
710 0         0 return $aslocal;
711             }
712 0         0 return;
713             }
714              
715             sub mymkpath {
716 0     0 0 0 my($self, $aslocal_dir) = @_;
717 0         0 mkpath($aslocal_dir);
718 0 0       0 $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
719             qq{directory "$aslocal_dir".
720             I\'ll continue, but if you encounter problems, they may be due
721             to insufficient permissions.\n}) unless -w $aslocal_dir;
722             }
723              
724             sub hostdlxxx {
725 3     3 0 7 my $self = shift;
726 3         6 my $level = shift;
727 3         5 my $scheme = shift;
728 3         7 my $h = shift;
729 3 50       85 $h = [ grep /^\Q$scheme\E:/, @$h ] if $scheme;
730 3         20 my $method = "host$level";
731 3         19 $self->$method($h, @_);
732             }
733              
734             sub _set_attempt {
735 3     3   14 my($self,$stats,$method,$url) = @_;
736 3         8 push @{$stats->{attempts}}, {
  3         16  
737             method => $method,
738             start => _mytime,
739             url => $url,
740             };
741             }
742              
743             # package CPAN::FTP;
744             sub hostdleasy { #called from hostdlxxx
745 3     3 0 11 my($self,$host_seq,$file,$aslocal,$stats) = @_;
746 3         7 my($ro_url);
747 3         7 HOSTEASY: for $ro_url (@$host_seq) {
748 3         21 $self->_set_attempt($stats,"dleasy",$ro_url);
749 3         12 my $url = "$ro_url$file";
750 3 50       11 $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
751 3 50       17 if ($url =~ /^file:/) {
752 3         8 my $l;
753 3 50       13 if ($CPAN::META->has_inst('URI::URL')) {
754 3         25 my $u = URI::URL->new($url);
755 3         10564 $l = $u->file;
756             } else { # works only on Unix, is poorly constructed, but
757             # hopefully better than nothing.
758             # RFC 1738 says fileurl BNF is
759             # fileurl = "file://" [ host | "localhost" ] "/" fpath
760             # Thanks to "Mark D. Baushke" for
761             # the code
762 0         0 ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
763 0         0 $l =~ s|^file:||; # assume they
764             # meant
765             # file://localhost
766 0 0 0     0 $l =~ s|^/||s
767             if ! -f $l && $l =~ m|^/\w:|; # e.g. /P:
768             }
769 3 50       3934 $self->debug("local file[$l]") if $CPAN::DEBUG;
770 3 50 33     127 if ( -f $l && -r _) {
771 0         0 $ThesiteURL = $ro_url;
772 0         0 return $l;
773             }
774             # If request is for a compressed file and we can find the
775             # uncompressed file also, return the path of the uncompressed file
776             # otherwise, decompress it and return the resulting path
777 3 50 0     28 if ($l =~ /(.+)\.gz$/) {
    0          
    0          
778 3         13 my $ungz = $1;
779 3 50 33     90 if ( -f $ungz && -r _) {
    0 0        
780 3         15 $ThesiteURL = $ro_url;
781 3         37 return $ungz;
782             }
783             elsif (-f $l && -r _) {
784 0         0 eval { CPAN::Tarzip->new($l)->gunzip($aslocal) };
  0         0  
785 0 0 0     0 if ( -f $aslocal && -s _) {
    0          
    0          
786 0         0 $ThesiteURL = $ro_url;
787 0         0 return $aslocal;
788             }
789             elsif (! -s $aslocal) {
790 0         0 unlink $aslocal;
791             }
792             elsif (-f $l) {
793 0 0       0 $CPAN::Frontend->mywarn("Error decompressing '$l': $@\n")
794             if $@;
795 0         0 return;
796             }
797             }
798             }
799             # Otherwise, return the local file path if it exists
800             elsif ( -f $l && -r _) {
801 0         0 $ThesiteURL = $ro_url;
802 0         0 return $l;
803             }
804             # If we can't find it, but there is a compressed version
805             # of it, then decompress it
806             elsif (-f "$l.gz") {
807 0 0       0 $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
808 0         0 eval { CPAN::Tarzip->new("$l.gz")->gunzip($aslocal) };
  0         0  
809 0 0       0 if ( -f $aslocal) {
810 0         0 $ThesiteURL = $ro_url;
811 0         0 return $aslocal;
812             }
813             else {
814 0 0       0 $CPAN::Frontend->mywarn("Error decompressing '$l': $@\n")
815             if $@;
816 0         0 return;
817             }
818             }
819 0         0 $CPAN::Frontend->mywarn("Could not find '$l'\n");
820             }
821 0 0       0 $self->debug("it was not a file URL") if $CPAN::DEBUG;
822 0 0 0     0 if ($CPAN::META->has_usable('LWP')) {
    0          
823 0         0 $CPAN::Frontend->myprint("Fetching with LWP:\n$url\n");
824 0 0       0 unless ($Ua) {
825 0         0 CPAN::LWP::UserAgent->config;
826 0         0 eval { $Ua = CPAN::LWP::UserAgent->new; };
  0         0  
827 0 0       0 if ($@) {
828 0         0 $CPAN::Frontend->mywarn("CPAN::LWP::UserAgent->new dies with $@\n");
829             }
830             }
831 0         0 my $res = $Ua->mirror($url, $aslocal);
832 0 0       0 if ($res->is_success) {
    0          
833 0         0 $ThesiteURL = $ro_url;
834 0         0 my $now = time;
835 0         0 utime $now, $now, $aslocal; # download time is more
836             # important than upload
837             # time
838 0         0 return $aslocal;
839             } elsif ($url !~ /\.gz(?!\n)\Z/) {
840 0         0 my $gzurl = "$url.gz";
841 0         0 $CPAN::Frontend->myprint("Fetching with LWP:\n$gzurl\n");
842 0         0 $res = $Ua->mirror($gzurl, "$aslocal.gz");
843 0 0       0 if ($res->is_success) {
844 0 0       0 if (eval {CPAN::Tarzip->new("$aslocal.gz")->gunzip($aslocal)}) {
  0         0  
845 0         0 $ThesiteURL = $ro_url;
846 0         0 return $aslocal;
847             }
848             }
849             } else {
850 0         0 $CPAN::Frontend->myprint(sprintf(
851             "LWP failed with code[%s] message[%s]\n",
852             $res->code,
853             $res->message,
854             ));
855             # Alan Burlison informed me that in firewall environments
856             # Net::FTP can still succeed where LWP fails. So we do not
857             # skip Net::FTP anymore when LWP is available.
858             }
859             } elsif ($url =~ /^http:/i && $CPAN::META->has_usable('HTTP::Tiny')) {
860 0         0 require CPAN::HTTP::Client;
861             my $chc = CPAN::HTTP::Client->new(
862             proxy => $CPAN::Config->{http_proxy} || $ENV{http_proxy},
863             no_proxy => $CPAN::Config->{no_proxy} || $ENV{no_proxy},
864 0   0     0 );
      0        
865 0 0       0 for my $try ( $url, ( $url !~ /\.gz(?!\n)\Z/ ? "$url.gz" : () ) ) {
866 0         0 $CPAN::Frontend->myprint("Fetching with HTTP::Tiny:\n$try\n");
867 0         0 my $res = eval { $chc->mirror($try, $aslocal) };
  0         0  
868 0 0 0     0 if ( $res && $res->{success} ) {
    0 0        
    0 0        
869 0         0 $ThesiteURL = $ro_url;
870 0         0 my $now = time;
871 0         0 utime $now, $now, $aslocal; # download time is more
872             # important than upload
873             # time
874 0         0 return $aslocal;
875             }
876             elsif ( $res && $res->{status} ne '599') {
877             $CPAN::Frontend->myprint(sprintf(
878             "HTTP::Tiny failed with code[%s] message[%s]\n",
879             $res->{status},
880             $res->{reason},
881             )
882 0         0 );
883             }
884             elsif ( $res && $res->{status} eq '599') {
885             $CPAN::Frontend->myprint(sprintf(
886             "HTTP::Tiny failed with an internal error: %s\n",
887             $res->{content},
888             )
889 0         0 );
890             }
891             else {
892 0   0     0 my $err = $@ || 'Unknown error';
893 0         0 $CPAN::Frontend->myprint(sprintf(
894             "Error downloading with HTTP::Tiny: %s\n", $err
895             )
896             );
897             }
898             }
899             }
900 0 0       0 return if $CPAN::Signal;
901 0 0       0 if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
902             # that's the nice and easy way thanks to Graham
903 0 0       0 $self->debug("recognized ftp") if $CPAN::DEBUG;
904 0         0 my($host,$dir,$getfile) = ($1,$2,$3);
905 0 0       0 if ($CPAN::META->has_usable('Net::FTP')) {
906 0         0 $dir =~ s|/+|/|g;
907 0         0 $CPAN::Frontend->myprint("Fetching with Net::FTP:\n$url\n");
908 0 0       0 $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
909             "aslocal[$aslocal]") if $CPAN::DEBUG;
910 0 0       0 if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
911 0         0 $ThesiteURL = $ro_url;
912 0         0 return $aslocal;
913             }
914 0 0       0 if ($aslocal !~ /\.gz(?!\n)\Z/) {
915 0         0 my $gz = "$aslocal.gz";
916 0         0 $CPAN::Frontend->myprint("Fetching with Net::FTP\n$url.gz\n");
917 0 0 0     0 if (CPAN::FTP->ftp_get($host,
918             $dir,
919             "$getfile.gz",
920             $gz) &&
921 0         0 eval{CPAN::Tarzip->new($gz)->gunzip($aslocal)}
922             ) {
923 0         0 $ThesiteURL = $ro_url;
924 0         0 return $aslocal;
925             }
926             }
927             # next HOSTEASY;
928             } else {
929 0 0       0 CPAN->debug("Net::FTP does not count as usable atm") if $CPAN::DEBUG;
930             }
931             }
932 0 0 0     0 if (
933             UNIVERSAL::can($ro_url,"text")
934             and
935             $ro_url->{FROM} eq "USER"
936             ) {
937             ##address #17973: default URLs should not try to override
938             ##user-defined URLs just because LWP is not available
939 0         0 my $ret = $self->hostdlhard([$ro_url],$file,$aslocal,$stats);
940 0 0       0 return $ret if $ret;
941             }
942 0 0       0 return if $CPAN::Signal;
943             }
944             }
945              
946             # package CPAN::FTP;
947             sub hostdlhard {
948 0     0 0 0 my($self,$host_seq,$file,$aslocal,$stats) = @_;
949              
950             # Came back if Net::FTP couldn't establish connection (or
951             # failed otherwise) Maybe they are behind a firewall, but they
952             # gave us a socksified (or other) ftp program...
953              
954 0         0 my($ro_url);
955 0   0     0 my($devnull) = $CPAN::Config->{devnull} || "";
956             # < /dev/null ";
957 0         0 my($aslocal_dir) = dirname($aslocal);
958 0         0 mkpath($aslocal_dir);
959 0         0 my $some_dl_success = 0;
960 0         0 my $any_attempt = 0;
961 0         0 HOSTHARD: for $ro_url (@$host_seq) {
962 0         0 $self->_set_attempt($stats,"dlhard",$ro_url);
963 0         0 my $url = "$ro_url$file";
964 0         0 my($proto,$host,$dir,$getfile);
965              
966             # Courtesy Mark Conty mark_conty@cargill.com change from
967             # if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
968             # to
969 0 0       0 if ($url =~ m|^([^:]+)://(.*?)/(.*)/(.*)|) {
970             # proto not yet used
971 0         0 ($proto,$host,$dir,$getfile) = ($1,$2,$3,$4);
972             } else {
973 0         0 next HOSTHARD; # who said, we could ftp anything except ftp?
974             }
975 0 0       0 next HOSTHARD if $proto eq "file"; # file URLs would have had
976             # success above. Likely a bogus URL
977              
978             # making at least one attempt against a host
979 0         0 $any_attempt++;
980              
981 0 0       0 $self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
982              
983             # Try the most capable first and leave ncftp* for last as it only
984             # does FTP.
985 0         0 my $proxy_vars = $self->_proxy_vars($ro_url);
986 0         0 DLPRG: for my $f (qw(curl wget lynx ncftpget ncftp)) {
987 0         0 my $funkyftp = CPAN::HandleConfig->safe_quote($CPAN::Config->{$f});
988 0 0       0 next DLPRG unless defined $funkyftp;
989 0 0       0 next DLPRG if $funkyftp =~ /^\s*$/;
990              
991 0         0 my($src_switch) = "";
992 0         0 my($chdir) = "";
993 0         0 my($stdout_redir) = " > \"$aslocal\"";
994 0 0       0 if ($f eq "lynx") {
    0          
    0          
    0          
    0          
995 0         0 $src_switch = " -source";
996             } elsif ($f eq "ncftp") {
997 0 0       0 next DLPRG unless $url =~ m{\Aftp://};
998 0         0 $src_switch = " -c";
999             } elsif ($f eq "wget") {
1000 0         0 $src_switch = " -O \"$aslocal\"";
1001 0         0 $stdout_redir = "";
1002             } elsif ($f eq 'curl') {
1003 0         0 $src_switch = ' -L -f -s -S --netrc-optional';
1004 0 0       0 if ($proxy_vars->{http_proxy}) {
1005 0         0 $src_switch .= qq{ -U "$proxy_vars->{proxy_user}:$proxy_vars->{proxy_pass}" -x "$proxy_vars->{http_proxy}"};
1006             }
1007             } elsif ($f eq "ncftpget") {
1008 0 0       0 next DLPRG unless $url =~ m{\Aftp://};
1009 0         0 $chdir = "cd $aslocal_dir && ";
1010 0         0 $stdout_redir = "";
1011             }
1012             $CPAN::Frontend->myprint(
1013 0         0 qq[
1014             Trying with
1015             $funkyftp$src_switch
1016             to get
1017             $url
1018             ]);
1019 0         0 my($system) =
1020             "$chdir$funkyftp$src_switch \"$url\" $devnull$stdout_redir";
1021 0 0       0 $self->debug("system[$system]") if $CPAN::DEBUG;
1022 0         0 my($wstatus) = system($system);
1023 0 0       0 if ($f eq "lynx") {
1024             # lynx returns 0 when it fails somewhere
1025 0 0       0 if (-s $aslocal) {
1026 0         0 my $content = do { local *FH;
  0         0  
1027 0 0       0 open FH, $aslocal or die;
1028 0         0 local $/;
1029 0         0 };
1030 0 0       0 if ($content =~ /^<.*([45]|Error [45])/si) { </td> </tr> <tr> <td class="h" > <a name="1031">1031</a> </td> <td class="c0" > <a href="#1035"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mywarn(qq{ </td> </tr> <tr> <td class="h" > <a name="1032">1032</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> No success, the file that lynx has downloaded looks like an error message: </td> </tr> <tr> <td class="h" > <a name="1033">1033</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $content </td> </tr> <tr> <td class="h" > <a name="1034">1034</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="1035">1035</a> </td> <td class="c0" > <a href="#1036"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mysleep(1); </td> </tr> <tr> <td class="h" > <a name="1036">1036</a> </td> <td class="c0" > <a href="#1038"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> next DLPRG; </td> </tr> <tr> <td class="h" > <a name="1037">1037</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1038">1038</a> </td> <td class="c0" > <a href="#1040"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $some_dl_success++; </td> </tr> <tr> <td class="h" > <a name="1039">1039</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1040">1040</a> </td> <td class="c0" > <a href="#1043"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="1041">1041</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> No success, the file that lynx has downloaded is an empty file. </td> </tr> <tr> <td class="h" > <a name="1042">1042</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="1043">1043</a> </td> <td class="c0" > <a href="#1046"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> next DLPRG; </td> </tr> <tr> <td class="h" > <a name="1044">1044</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1045">1045</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1046">1046</a> </td> <td class="c0" > <a href="#1047"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1046-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if ($wstatus == 0) { </td> </tr> <tr> <td class="h" > <a name="1047">1047</a> </td> <td class="c0" > <a href="#1049"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1047-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if (-s $aslocal) { </td> </tr> <tr> <td class="h" > <a name="1048">1048</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # Looks good </td> </tr> <tr> <td class="h" > <a name="1049">1049</a> </td> <td class="c0" > <a href="#1051"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $some_dl_success++; </td> </tr> <tr> <td class="h" > <a name="1050">1050</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1051">1051</a> </td> <td class="c0" > <a href="#1052"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $ThesiteURL = $ro_url; </td> </tr> <tr> <td class="h" > <a name="1052">1052</a> </td> <td class="c0" > <a href="#1054"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return $aslocal; </td> </tr> <tr> <td class="h" > <a name="1053">1053</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1054">1054</a> </td> <td class="c0" > <a href="#1055"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> my $estatus = $wstatus >> 8; </td> </tr> <tr> <td class="h" > <a name="1055">1055</a> </td> <td class="c0" > <a href="#1058"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1055-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> my $size = -f $aslocal ? </td> </tr> <tr> <td class="h" > <a name="1056">1056</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ", left\n$aslocal with size ".-s _ : </td> </tr> <tr> <td class="h" > <a name="1057">1057</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "\nWarning: expected file [$aslocal] doesn't exist"; </td> </tr> <tr> <td class="h" > <a name="1058">1058</a> </td> <td class="c0" > <a href="#1063"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="1059">1059</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Function system("$system") </td> </tr> <tr> <td class="h" > <a name="1060">1060</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> returned status $estatus (wstat $wstatus)$size </td> </tr> <tr> <td class="h" > <a name="1061">1061</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="1062">1062</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1063">1063</a> </td> <td class="c0" > <a href="#1066"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1063-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return if $CPAN::Signal; </td> </tr> <tr> <td class="h" > <a name="1064">1064</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } # download/transfer programs (DLPRG) </td> </tr> <tr> <td class="h" > <a name="1065">1065</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } # host </td> </tr> <tr> <td class="h" > <a name="1066">1066</a> </td> <td class="c0" > <a href="#1067"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1066-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return unless $any_attempt; </td> </tr> <tr> <td class="h" > <a name="1067">1067</a> </td> <td class="c0" > <a href="#1068"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1067-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> if ($some_dl_success) { </td> </tr> <tr> <td class="h" > <a name="1068">1068</a> </td> <td class="c0" > <a href="#1070"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mywarn("Warning: doesn't seem we had substantial success downloading '$aslocal'. Don't know how to proceed.\n"); </td> </tr> <tr> <td class="h" > <a name="1069">1069</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1070">1070</a> </td> <td class="c0" > <a href="#1072"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mywarn("Warning: no success downloading '$aslocal'. Giving up on it.\n"); </td> </tr> <tr> <td class="h" > <a name="1071">1071</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1072">1072</a> </td> <td class="c0" > <a href="#1093"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> return; </td> </tr> <tr> <td class="h" > <a name="1073">1073</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1074">1074</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1075">1075</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> #-> CPAN::FTP::_proxy_vars </td> </tr> <tr> <td class="h" > <a name="1076">1076</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub _proxy_vars { </td> </tr> <tr> <td class="h" > <a name="1077">1077</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td class="c3" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1077-1"> 2 </a> </td> <td >   </td> <td > 5480 </td> <td class="s"> my($self,$url) = @_; </td> </tr> <tr> <td class="h" > <a name="1078">1078</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 4 </td> <td class="s"> my $ret = +{}; </td> </tr> <tr> <td class="h" > <a name="1079">1079</a> </td> <td class="c3" > 2 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1079-1"> 33 </a> </td> <td >   </td> <td >   </td> <td > 8 </td> <td class="s"> my $http_proxy = $CPAN::Config->{'http_proxy'} || $ENV{'http_proxy'}; </td> </tr> <tr> <td class="h" > <a name="1080">1080</a> </td> <td class="c3" > 2 </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1080-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 4 </td> <td class="s"> if ($http_proxy) { </td> </tr> <tr> <td class="h" > <a name="1081">1081</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 17 </td> <td class="s"> my($host) = $url =~ m|://([^/:]+)|; </td> </tr> <tr> <td class="h" > <a name="1082">1082</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 4 </td> <td class="s"> my $want_proxy = 1; </td> </tr> <tr> <td class="h" > <a name="1083">1083</a> </td> <td class="c3" > 2 </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1083-1"> 0 </a> </td> <td >   </td> <td >   </td> <td > 7 </td> <td class="s"> my $noproxy = $CPAN::Config->{'no_proxy'} || $ENV{'no_proxy'} || ""; </td> </tr> <tr> <td class="h" > <a name="1084">1084</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> my @noproxy = split /\s*,\s*/, $noproxy; </td> </tr> <tr> <td class="h" > <a name="1085">1085</a> </td> <td class="c3" > 2 </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1085-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> if ($host) { </td> </tr> <tr> <td class="h" > <a name="1086">1086</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 8 </td> <td class="s"> DOMAIN: for my $domain (@noproxy) { </td> </tr> <tr> <td class="h" > <a name="1087">1087</a> </td> <td class="c3" > 2 </td> <td class="c3" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1087-1"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 40 </td> <td class="s"> if ($host =~ /\Q$domain\E$/) { # cf. LWP::UserAgent </td> </tr> <tr> <td class="h" > <a name="1088">1088</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 4 </td> <td class="s"> $want_proxy = 0; </td> </tr> <tr> <td class="h" > <a name="1089">1089</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 3 </td> <td class="s"> last DOMAIN; </td> </tr> <tr> <td class="h" > <a name="1090">1090</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1091">1091</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1092">1092</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1093">1093</a> </td> <td class="c0" > <a href="#1110"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $CPAN::Frontend->mywarn(" Could not determine host from http_proxy '$http_proxy'\n"); </td> </tr> <tr> <td class="h" > <a name="1094">1094</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1095">1095</a> </td> <td class="c3" > 2 </td> <td class="c3" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1095-1"> 100 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> if ($want_proxy) { </td> </tr> <tr> <td class="h" > <a name="1096">1096</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 21 </td> <td class="s"> my($user, $pass) = </td> </tr> <tr> <td class="h" > <a name="1097">1097</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> CPAN::HTTP::Credentials->get_proxy_credentials(); </td> </tr> <tr> <td class="h" > <a name="1098">1098</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 5 </td> <td class="s"> $ret = { </td> </tr> <tr> <td class="h" > <a name="1099">1099</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> proxy_user => $user, </td> </tr> <tr> <td class="h" > <a name="1100">1100</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> proxy_pass => $pass, </td> </tr> <tr> <td class="h" > <a name="1101">1101</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> http_proxy => $http_proxy </td> </tr> <tr> <td class="h" > <a name="1102">1102</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }; </td> </tr> <tr> <td class="h" > <a name="1103">1103</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1104">1104</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1105">1105</a> </td> <td class="c3" > 2 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 6 </td> <td class="s"> return $ret; </td> </tr> <tr> <td class="h" > <a name="1106">1106</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1107">1107</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1108">1108</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # package CPAN::FTP; </td> </tr> <tr> <td class="h" > <a name="1109">1109</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub hostdlhardest { </td> </tr> <tr> <td class="h" > <a name="1110">1110</a> </td> <td class="c0" > <a href="#1112"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1110-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1110-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self,$host_seq,$file,$aslocal,$stats) = @_; </td> </tr> <tr> <td class="h" > <a name="1111">1111</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1112">1112</a> </td> <td class="c0" > <a href="#1113"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1112-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return unless @$host_seq; </td> </tr> <tr> <td class="h" > <a name="1113">1113</a> </td> <td class="c0" > <a href="#1114"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($ro_url); </td> </tr> <tr> <td class="h" > <a name="1114">1114</a> </td> <td class="c0" > <a href="#1115"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($aslocal_dir) = dirname($aslocal); </td> </tr> <tr> <td class="h" > <a name="1115">1115</a> </td> <td class="c0" > <a href="#1116"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> mkpath($aslocal_dir); </td> </tr> <tr> <td class="h" > <a name="1116">1116</a> </td> <td class="c0" > <a href="#1117"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $ftpbin = $CPAN::Config->{ftp}; </td> </tr> <tr> <td class="h" > <a name="1117">1117</a> </td> <td class="c0" > <a href="#1118"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1117-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1117-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> unless ($ftpbin && length $ftpbin && MM->maybe_command($ftpbin)) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1118">1118</a> </td> <td class="c0" > <a href="#1119"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("No external ftp command available\n\n"); </td> </tr> <tr> <td class="h" > <a name="1119">1119</a> </td> <td class="c0" > <a href="#1121"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return; </td> </tr> <tr> <td class="h" > <a name="1120">1120</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1121">1121</a> </td> <td class="c0" > <a href="#1134"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mywarn(qq{ </td> </tr> <tr> <td class="h" > <a name="1122">1122</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> As a last resort we now switch to the external ftp command '$ftpbin' </td> </tr> <tr> <td class="h" > <a name="1123">1123</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> to get '$aslocal'. </td> </tr> <tr> <td class="h" > <a name="1124">1124</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1125">1125</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Doing so often leads to problems that are hard to diagnose. </td> </tr> <tr> <td class="h" > <a name="1126">1126</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1127">1127</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> If you're the victim of such problems, please consider unsetting the </td> </tr> <tr> <td class="h" > <a name="1128">1128</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ftp config variable with </td> </tr> <tr> <td class="h" > <a name="1129">1129</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1130">1130</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> o conf ftp "" </td> </tr> <tr> <td class="h" > <a name="1131">1131</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> o conf commit </td> </tr> <tr> <td class="h" > <a name="1132">1132</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1133">1133</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }); </td> </tr> <tr> <td class="h" > <a name="1134">1134</a> </td> <td class="c0" > <a href="#1135"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mysleep(2); </td> </tr> <tr> <td class="h" > <a name="1135">1135</a> </td> <td class="c0" > <a href="#1136"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> HOSTHARDEST: for $ro_url (@$host_seq) { </td> </tr> <tr> <td class="h" > <a name="1136">1136</a> </td> <td class="c0" > <a href="#1137"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->_set_attempt($stats,"dlhardest",$ro_url); </td> </tr> <tr> <td class="h" > <a name="1137">1137</a> </td> <td class="c0" > <a href="#1138"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $url = "$ro_url$file"; </td> </tr> <tr> <td class="h" > <a name="1138">1138</a> </td> <td class="c0" > <a href="#1139"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1138-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG; </td> </tr> <tr> <td class="h" > <a name="1139">1139</a> </td> <td class="c0" > <a href="#1140"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1139-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) { </td> </tr> <tr> <td class="h" > <a name="1140">1140</a> </td> <td class="c0" > <a href="#1142"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> next; </td> </tr> <tr> <td class="h" > <a name="1141">1141</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1142">1142</a> </td> <td class="c0" > <a href="#1143"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($host,$dir,$getfile) = ($1,$2,$3); </td> </tr> <tr> <td class="h" > <a name="1143">1143</a> </td> <td class="c0" > <a href="#1144"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $timestamp = 0; </td> </tr> <tr> <td class="h" > <a name="1144">1144</a> </td> <td class="c0" > <a href="#1146"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime, </td> </tr> <tr> <td class="h" > <a name="1145">1145</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ctime,$blksize,$blocks) = stat($aslocal); </td> </tr> <tr> <td class="h" > <a name="1146">1146</a> </td> <td class="c0" > <a href="#1147"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1146-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $timestamp = $mtime ||= 0; </td> </tr> <tr> <td class="h" > <a name="1147">1147</a> </td> <td class="c0" > <a href="#1148"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($netrc) = CPAN::FTP::netrc->new; </td> </tr> <tr> <td class="h" > <a name="1148">1148</a> </td> <td class="c0" > <a href="#1149"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($netrcfile) = $netrc->netrc; </td> </tr> <tr> <td class="h" > <a name="1149">1149</a> </td> <td class="c0" > <a href="#1150"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1149-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : ""; </td> </tr> <tr> <td class="h" > <a name="1150">1150</a> </td> <td class="c0" > <a href="#1151"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $targetfile = File::Basename::basename($aslocal); </td> </tr> <tr> <td class="h" > <a name="1151">1151</a> </td> <td class="c0" > <a href="#1152"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@dialog); </td> </tr> <tr> <td class="h" > <a name="1152">1152</a> </td> <td class="c0" > <a href="#1162"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push( </td> </tr> <tr> <td class="h" > <a name="1153">1153</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @dialog, </td> </tr> <tr> <td class="h" > <a name="1154">1154</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "lcd $aslocal_dir", </td> </tr> <tr> <td class="h" > <a name="1155">1155</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "cd /", </td> </tr> <tr> <td class="h" > <a name="1156">1156</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> map("cd $_", split /\//, $dir), # RFC 1738 </td> </tr> <tr> <td class="h" > <a name="1157">1157</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "bin", </td> </tr> <tr> <td class="h" > <a name="1158">1158</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "passive", </td> </tr> <tr> <td class="h" > <a name="1159">1159</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "get $getfile $targetfile", </td> </tr> <tr> <td class="h" > <a name="1160">1160</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "quit" </td> </tr> <tr> <td class="h" > <a name="1161">1161</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="1162">1162</a> </td> <td class="c0" > <a href="#1163"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1162-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1162-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (! $netrcfile) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1163">1163</a> </td> <td class="c0" > <a href="#1165"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1163-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG; </td> </tr> <tr> <td class="h" > <a name="1164">1164</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } elsif ($netrc->hasdefault || $netrc->contains($host)) { </td> </tr> <tr> <td class="h" > <a name="1165">1165</a> </td> <td class="c0" > <a href="#1168"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1165-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]", </td> </tr> <tr> <td class="h" > <a name="1166">1166</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc->hasdefault, </td> </tr> <tr> <td class="h" > <a name="1167">1167</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc->contains($host))) if $CPAN::DEBUG; </td> </tr> <tr> <td class="h" > <a name="1168">1168</a> </td> <td class="c0" > <a href="#1169"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1168-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($netrc->protected) { </td> </tr> <tr> <td class="h" > <a name="1169">1169</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $dialog = join "", map { " $_\n" } @dialog; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1170"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1170">1170</a> </td> <td class="c0" > <a href="#1171"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $netrc_explain; </td> </tr> <tr> <td class="h" > <a name="1171">1171</a> </td> <td class="c0" > <a href="#1172"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1171-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($netrc->contains($host)) { </td> </tr> <tr> <td class="h" > <a name="1172">1172</a> </td> <td class="c0" > <a href="#1175"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc_explain = "Relying that your .netrc entry for '$host' ". </td> </tr> <tr> <td class="h" > <a name="1173">1173</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "manages the login"; </td> </tr> <tr> <td class="h" > <a name="1174">1174</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1175">1175</a> </td> <td class="c0" > <a href="#1178"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc_explain = "Relying that your default .netrc entry ". </td> </tr> <tr> <td class="h" > <a name="1176">1176</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "manages the login"; </td> </tr> <tr> <td class="h" > <a name="1177">1177</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1178">1178</a> </td> <td class="c0" > <a href="#1186"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="1179">1179</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Trying with external ftp to get </td> </tr> <tr> <td class="h" > <a name="1180">1180</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> '$url' </td> </tr> <tr> <td class="h" > <a name="1181">1181</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $netrc_explain </td> </tr> <tr> <td class="h" > <a name="1182">1182</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Sending the dialog </td> </tr> <tr> <td class="h" > <a name="1183">1183</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $dialog </td> </tr> <tr> <td class="h" > <a name="1184">1184</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1185">1185</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="1186">1186</a> </td> <td class="c0" > <a href="#1188"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->talk_ftp("$ftpbin$verbose $host", </td> </tr> <tr> <td class="h" > <a name="1187">1187</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @dialog); </td> </tr> <tr> <td class="h" > <a name="1188">1188</a> </td> <td class="c0" > <a href="#1190"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, </td> </tr> <tr> <td class="h" > <a name="1189">1189</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal); </td> </tr> <tr> <td class="h" > <a name="1190">1190</a> </td> <td class="c0" > <a href="#1191"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1190-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $mtime ||= 0; </td> </tr> <tr> <td class="h" > <a name="1191">1191</a> </td> <td class="c0" > <a href="#1192"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1191-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($mtime > $timestamp) { </td> </tr> <tr> <td class="h" > <a name="1192">1192</a> </td> <td class="c0" > <a href="#1193"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("GOT $aslocal\n"); </td> </tr> <tr> <td class="h" > <a name="1193">1193</a> </td> <td class="c0" > <a href="#1194"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ThesiteURL = $ro_url; </td> </tr> <tr> <td class="h" > <a name="1194">1194</a> </td> <td class="c0" > <a href="#1196"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $aslocal; </td> </tr> <tr> <td class="h" > <a name="1195">1195</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1196">1196</a> </td> <td class="c0" > <a href="#1198"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("Hmm... Still failed!\n"); </td> </tr> <tr> <td class="h" > <a name="1197">1197</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1198">1198</a> </td> <td class="c0" > <a href="#1200"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1198-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return if $CPAN::Signal; </td> </tr> <tr> <td class="h" > <a name="1199">1199</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1200">1200</a> </td> <td class="c0" > <a href="#1204"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }. </td> </tr> <tr> <td class="h" > <a name="1201">1201</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> qq{correctly protected.\n}); </td> </tr> <tr> <td class="h" > <a name="1202">1202</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1203">1203</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1204">1204</a> </td> <td class="c0" > <a href="#1211"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host </td> </tr> <tr> <td class="h" > <a name="1205">1205</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> nor does it have a default entry\n"); </td> </tr> <tr> <td class="h" > <a name="1206">1206</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1207">1207</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1208">1208</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # OK, they don't have a valid ~/.netrc. Use 'ftp -n' </td> </tr> <tr> <td class="h" > <a name="1209">1209</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # then and login manually to host, using e-mail as </td> </tr> <tr> <td class="h" > <a name="1210">1210</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # password. </td> </tr> <tr> <td class="h" > <a name="1211">1211</a> </td> <td class="c0" > <a href="#1212"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint(qq{Issuing "$ftpbin$verbose -n"\n}); </td> </tr> <tr> <td class="h" > <a name="1212">1212</a> </td> <td class="c0" > <a href="#1217"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> unshift( </td> </tr> <tr> <td class="h" > <a name="1213">1213</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> @dialog, </td> </tr> <tr> <td class="h" > <a name="1214">1214</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "open $host", </td> </tr> <tr> <td class="h" > <a name="1215">1215</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> "user anonymous $Config::Config{'cf_email'}" </td> </tr> <tr> <td class="h" > <a name="1216">1216</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="1217">1217</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $dialog = join "", map { " $_\n" } @dialog; </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1218"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1218">1218</a> </td> <td class="c0" > <a href="#1225"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="1219">1219</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Trying with external ftp to get </td> </tr> <tr> <td class="h" > <a name="1220">1220</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $url </td> </tr> <tr> <td class="h" > <a name="1221">1221</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Sending the dialog </td> </tr> <tr> <td class="h" > <a name="1222">1222</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $dialog </td> </tr> <tr> <td class="h" > <a name="1223">1223</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1224">1224</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="1225">1225</a> </td> <td class="c0" > <a href="#1226"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->talk_ftp("$ftpbin$verbose -n", @dialog); </td> </tr> <tr> <td class="h" > <a name="1226">1226</a> </td> <td class="c0" > <a href="#1228"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, </td> </tr> <tr> <td class="h" > <a name="1227">1227</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal); </td> </tr> <tr> <td class="h" > <a name="1228">1228</a> </td> <td class="c0" > <a href="#1229"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1228-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $mtime ||= 0; </td> </tr> <tr> <td class="h" > <a name="1229">1229</a> </td> <td class="c0" > <a href="#1230"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1229-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($mtime > $timestamp) { </td> </tr> <tr> <td class="h" > <a name="1230">1230</a> </td> <td class="c0" > <a href="#1231"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("GOT $aslocal\n"); </td> </tr> <tr> <td class="h" > <a name="1231">1231</a> </td> <td class="c0" > <a href="#1232"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ThesiteURL = $ro_url; </td> </tr> <tr> <td class="h" > <a name="1232">1232</a> </td> <td class="c0" > <a href="#1234"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $aslocal; </td> </tr> <tr> <td class="h" > <a name="1233">1233</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="1234">1234</a> </td> <td class="c0" > <a href="#1236"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint("Bad luck... Still failed!\n"); </td> </tr> <tr> <td class="h" > <a name="1235">1235</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1236">1236</a> </td> <td class="c0" > <a href="#1237"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1236-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return if $CPAN::Signal; </td> </tr> <tr> <td class="h" > <a name="1237">1237</a> </td> <td class="c0" > <a href="#1238"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mywarn("Can't access URL $url.\n\n"); </td> </tr> <tr> <td class="h" > <a name="1238">1238</a> </td> <td class="c0" > <a href="#1244"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->mysleep(2); </td> </tr> <tr> <td class="h" > <a name="1239">1239</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } # host </td> </tr> <tr> <td class="h" > <a name="1240">1240</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1241">1241</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1242">1242</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # package CPAN::FTP; </td> </tr> <tr> <td class="h" > <a name="1243">1243</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub talk_ftp { </td> </tr> <tr> <td class="h" > <a name="1244">1244</a> </td> <td class="c0" > <a href="#1245"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1244-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1244-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self,$command,@dialog) = @_; </td> </tr> <tr> <td class="h" > <a name="1245">1245</a> </td> <td class="c0" > <a href="#1246"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $fh = FileHandle->new; </td> </tr> <tr> <td class="h" > <a name="1246">1246</a> </td> <td class="c0" > <a href="#1247"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1246-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $fh->open("|$command") or die "Couldn't open ftp: $!"; </td> </tr> <tr> <td class="h" > <a name="1247">1247</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> foreach (@dialog) { $fh->print("$_\n") } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1248"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1248">1248</a> </td> <td class="c0" > <a href="#1249"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $fh->close; # Wait for process to complete </td> </tr> <tr> <td class="h" > <a name="1249">1249</a> </td> <td class="c0" > <a href="#1250"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $wstatus = $?; </td> </tr> <tr> <td class="h" > <a name="1250">1250</a> </td> <td class="c0" > <a href="#1251"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $estatus = $wstatus >> 8; </td> </tr> <tr> <td class="h" > <a name="1251">1251</a> </td> <td class="c0" > <a href="#1261"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1251-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $CPAN::Frontend->myprint(qq{ </td> </tr> <tr> <td class="h" > <a name="1252">1252</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Subprocess "|$command" </td> </tr> <tr> <td class="h" > <a name="1253">1253</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> returned status $estatus (wstat $wstatus) </td> </tr> <tr> <td class="h" > <a name="1254">1254</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }) if $wstatus; </td> </tr> <tr> <td class="h" > <a name="1255">1255</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1256">1256</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1257">1257</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # find2perl needs modularization, too, all the following is stolen </td> </tr> <tr> <td class="h" > <a name="1258">1258</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # from there </td> </tr> <tr> <td class="h" > <a name="1259">1259</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> # CPAN::FTP::ls </td> </tr> <tr> <td class="h" > <a name="1260">1260</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub ls { </td> </tr> <tr> <td class="h" > <a name="1261">1261</a> </td> <td class="c0" > <a href="#1262"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1261-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--subroutine.html#1261-1"> 0 </a> </td> <td >   </td> <td class="s"> my($self,$name) = @_; </td> </tr> <tr> <td class="h" > <a name="1262">1262</a> </td> <td class="c0" > <a href="#1265"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm, </td> </tr> <tr> <td class="h" > <a name="1263">1263</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name); </td> </tr> <tr> <td class="h" > <a name="1264">1264</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1265">1265</a> </td> <td class="c0" > <a href="#1266"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($perms,%user,%group); </td> </tr> <tr> <td class="h" > <a name="1266">1266</a> </td> <td class="c0" > <a href="#1268"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $pname = $name; </td> </tr> <tr> <td class="h" > <a name="1267">1267</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1268">1268</a> </td> <td class="c0" > <a href="#1269"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1268-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ($blocks) { </td> </tr> <tr> <td class="h" > <a name="1269">1269</a> </td> <td class="c0" > <a href="#1272"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $blocks = int(($blocks + 1) / 2); </td> </tr> <tr> <td class="h" > <a name="1270">1270</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1271">1271</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { </td> </tr> <tr> <td class="h" > <a name="1272">1272</a> </td> <td class="c0" > <a href="#1275"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $blocks = int(($sizemm + 1023) / 1024); </td> </tr> <tr> <td class="h" > <a name="1273">1273</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1274">1274</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1275">1275</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1275-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (-f _) { $perms = '-'; } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1276"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-3"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-4"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-5"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#-6"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1276">1276</a> </td> <td class="c0" > <a href="#1277"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-d _) { $perms = 'd'; } </td> </tr> <tr> <td class="h" > <a name="1277">1277</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1278"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1278">1278</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1279"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1279">1279</a> </td> <td class="c0" > <a href="#1280"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-p _) { $perms = 'p'; } </td> </tr> <tr> <td class="h" > <a name="1280">1280</a> </td> <td class="c0" > <a href="#1281"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif (-S _) { $perms = 's'; } </td> </tr> <tr> <td class="h" > <a name="1281">1281</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { $perms = 'l'; $pname .= ' -> ' . readlink($_); } </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#1283"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1282">1282</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1283">1283</a> </td> <td class="c0" > <a href="#1284"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx'); </td> </tr> <tr> <td class="h" > <a name="1284">1284</a> </td> <td class="c0" > <a href="#1285"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); </td> </tr> <tr> <td class="h" > <a name="1285">1285</a> </td> <td class="c0" > <a href="#1286"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $tmpmode = $mode; </td> </tr> <tr> <td class="h" > <a name="1286">1286</a> </td> <td class="c0" > <a href="#1287"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $tmp = $rwx[$tmpmode & 7]; </td> </tr> <tr> <td class="h" > <a name="1287">1287</a> </td> <td class="c0" > <a href="#1288"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tmpmode >>= 3; </td> </tr> <tr> <td class="h" > <a name="1288">1288</a> </td> <td class="c0" > <a href="#1289"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tmp = $rwx[$tmpmode & 7] . $tmp; </td> </tr> <tr> <td class="h" > <a name="1289">1289</a> </td> <td class="c0" > <a href="#1290"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tmpmode >>= 3; </td> </tr> <tr> <td class="h" > <a name="1290">1290</a> </td> <td class="c0" > <a href="#1291"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $tmp = $rwx[$tmpmode & 7] . $tmp; </td> </tr> <tr> <td class="h" > <a name="1291">1291</a> </td> <td class="c0" > <a href="#1292"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1291-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> substr($tmp,2,1) =~ tr/-x/Ss/ if -u _; </td> </tr> <tr> <td class="h" > <a name="1292">1292</a> </td> <td class="c0" > <a href="#1293"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1292-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> substr($tmp,5,1) =~ tr/-x/Ss/ if -g _; </td> </tr> <tr> <td class="h" > <a name="1293">1293</a> </td> <td class="c0" > <a href="#1294"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1293-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> substr($tmp,8,1) =~ tr/-x/Tt/ if -k _; </td> </tr> <tr> <td class="h" > <a name="1294">1294</a> </td> <td class="c0" > <a href="#1296"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $perms .= $tmp; </td> </tr> <tr> <td class="h" > <a name="1295">1295</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1296">1296</a> </td> <td class="c0" > <a href="#1297"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1296-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $user = $user{$uid} || $uid; # too lazy to implement lookup </td> </tr> <tr> <td class="h" > <a name="1297">1297</a> </td> <td class="c0" > <a href="#1299"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--condition.html#1297-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $group = $group{$gid} || $gid; </td> </tr> <tr> <td class="h" > <a name="1298">1298</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1299">1299</a> </td> <td class="c0" > <a href="#1300"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime); </td> </tr> <tr> <td class="h" > <a name="1300">1300</a> </td> <td class="c0" > <a href="#1301"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($timeyear); </td> </tr> <tr> <td class="h" > <a name="1301">1301</a> </td> <td class="c0" > <a href="#1302"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my($moname) = $moname[$mon]; </td> </tr> <tr> <td class="h" > <a name="1302">1302</a> </td> <td class="c0" > <a href="#1303"> 0 </a> </td> <td class="c0" > <a href="blib-lib-CPAN-FTP-pm--branch.html#1302-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (-M _ > 365.25 / 2) { </td> </tr> <tr> <td class="h" > <a name="1303">1303</a> </td> <td class="c0" > <a href="#1306"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $timeyear = $year + 1900; </td> </tr> <tr> <td class="h" > <a name="1304">1304</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1305">1305</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { </td> </tr> <tr> <td class="h" > <a name="1306">1306</a> </td> <td class="c0" > <a href="#1309"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $timeyear = sprintf("%02d:%02d", $hour, $min); </td> </tr> <tr> <td class="h" > <a name="1307">1307</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1308">1308</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1309">1309</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n", </td> </tr> <tr> <td class="h" > <a name="1310">1310</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $ino, </td> </tr> <tr> <td class="h" > <a name="1311">1311</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $blocks, </td> </tr> <tr> <td class="h" > <a name="1312">1312</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $perms, </td> </tr> <tr> <td class="h" > <a name="1313">1313</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $nlink, </td> </tr> <tr> <td class="h" > <a name="1314">1314</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $user, </td> </tr> <tr> <td class="h" > <a name="1315">1315</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $group, </td> </tr> <tr> <td class="h" > <a name="1316">1316</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $sizemm, </td> </tr> <tr> <td class="h" > <a name="1317">1317</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $moname, </td> </tr> <tr> <td class="h" > <a name="1318">1318</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $mday, </td> </tr> <tr> <td class="h" > <a name="1319">1319</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $timeyear, </td> </tr> <tr> <td class="h" > <a name="1320">1320</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $pname; </td> </tr> <tr> <td class="h" > <a name="1321">1321</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="1322">1322</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="1323">1323</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> </table> </body> </html>