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