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::Distribution; |
4
|
12
|
|
|
12
|
|
44
|
use strict; |
|
12
|
|
|
|
|
15
|
|
|
12
|
|
|
|
|
327
|
|
5
|
12
|
|
|
12
|
|
38
|
use Cwd qw(chdir); |
|
12
|
|
|
|
|
11
|
|
|
12
|
|
|
|
|
461
|
|
6
|
12
|
|
|
12
|
|
4286
|
use CPAN::Distroprefs; |
|
12
|
|
|
|
|
21
|
|
|
12
|
|
|
|
|
301
|
|
7
|
12
|
|
|
12
|
|
55
|
use CPAN::InfoObj; |
|
12
|
|
|
|
|
13
|
|
|
12
|
|
|
|
|
197
|
|
8
|
12
|
|
|
12
|
|
38
|
use File::Path (); |
|
12
|
|
|
|
|
14
|
|
|
12
|
|
|
|
|
275
|
|
9
|
|
|
|
|
|
|
@CPAN::Distribution::ISA = qw(CPAN::InfoObj); |
10
|
12
|
|
|
12
|
|
37
|
use vars qw($VERSION); |
|
12
|
|
|
|
|
11
|
|
|
12
|
|
|
|
|
589
|
|
11
|
|
|
|
|
|
|
$VERSION = "2.16"; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# no prepare, because prepare is not a command on the shell command line |
14
|
|
|
|
|
|
|
# TODO: clear instance cache on reload |
15
|
|
|
|
|
|
|
my %instance; |
16
|
|
|
|
|
|
|
for my $method (qw(get make test install)) { |
17
|
12
|
|
|
12
|
|
38
|
no strict 'refs'; |
|
12
|
|
|
|
|
18
|
|
|
12
|
|
|
|
|
115493
|
|
18
|
|
|
|
|
|
|
for my $prefix (qw(pre post)) { |
19
|
|
|
|
|
|
|
my $hookname = sprintf "%s_%s", $prefix, $method; |
20
|
|
|
|
|
|
|
*$hookname = sub { |
21
|
0
|
|
|
0
|
|
0
|
my($self) = @_; |
22
|
0
|
|
|
|
|
0
|
for my $plugin (@{$CPAN::Config->{plugin_list}}) { |
|
0
|
|
|
|
|
0
|
|
23
|
0
|
|
|
|
|
0
|
my($plugin_proper,$args) = split /=/, $plugin, 2; |
24
|
0
|
0
|
|
|
|
0
|
$args = "" unless defined $args; |
25
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst($plugin_proper)){ |
26
|
0
|
|
|
|
|
0
|
my @args = split /,/, $args; |
27
|
0
|
|
0
|
|
|
0
|
$instance{$plugin} ||= $plugin_proper->new(@args); |
28
|
0
|
0
|
|
|
|
0
|
if ($instance{$plugin}->can($hookname)) { |
29
|
0
|
|
|
|
|
0
|
$instance{$plugin}->$hookname($self); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
} else { |
32
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("Plugin '$plugin_proper' not found"); |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
}; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Accessors |
40
|
|
|
|
|
|
|
sub cpan_comment { |
41
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
42
|
0
|
0
|
|
|
|
0
|
my $ro = $self->ro or return; |
43
|
|
|
|
|
|
|
$ro->{CPAN_COMMENT} |
44
|
0
|
|
|
|
|
0
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
#-> CPAN::Distribution::undelay |
47
|
|
|
|
|
|
|
sub undelay { |
48
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
49
|
0
|
|
|
|
|
0
|
for my $delayer ( |
50
|
|
|
|
|
|
|
"configure_requires_later", |
51
|
|
|
|
|
|
|
"configure_requires_later_for", |
52
|
|
|
|
|
|
|
"later", |
53
|
|
|
|
|
|
|
"later_for", |
54
|
|
|
|
|
|
|
) { |
55
|
0
|
|
|
|
|
0
|
delete $self->{$delayer}; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
#-> CPAN::Distribution::is_dot_dist |
60
|
|
|
|
|
|
|
sub is_dot_dist { |
61
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
62
|
0
|
|
|
|
|
0
|
return substr($self->id,-1,1) eq "."; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# add the A/AN/ stuff |
66
|
|
|
|
|
|
|
#-> CPAN::Distribution::normalize |
67
|
|
|
|
|
|
|
sub normalize { |
68
|
1
|
|
|
1
|
0
|
2
|
my($self,$s) = @_; |
69
|
1
|
50
|
|
|
|
3
|
$s = $self->id unless defined $s; |
70
|
1
|
50
|
33
|
|
|
33
|
if (substr($s,-1,1) eq ".") { |
|
|
50
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# using a global because we are sometimes called as static method |
72
|
0
|
0
|
0
|
|
|
0
|
if (!$CPAN::META->{LOCK} |
73
|
|
|
|
|
|
|
&& !$CPAN::Have_warned->{"$s is unlocked"}++ |
74
|
|
|
|
|
|
|
) { |
75
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("You are visiting the local directory |
76
|
|
|
|
|
|
|
'$s' |
77
|
|
|
|
|
|
|
without lock, take care that concurrent processes do not do likewise.\n"); |
78
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(1); |
79
|
|
|
|
|
|
|
} |
80
|
0
|
0
|
|
|
|
0
|
if ($s eq ".") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
81
|
0
|
|
|
|
|
0
|
$s = "$CPAN::iCwd/."; |
82
|
|
|
|
|
|
|
} elsif (File::Spec->file_name_is_absolute($s)) { |
83
|
|
|
|
|
|
|
} elsif (File::Spec->can("rel2abs")) { |
84
|
0
|
|
|
|
|
0
|
$s = File::Spec->rel2abs($s); |
85
|
|
|
|
|
|
|
} else { |
86
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("Your File::Spec is too old, please upgrade File::Spec"); |
87
|
|
|
|
|
|
|
} |
88
|
0
|
0
|
|
|
|
0
|
CPAN->debug("s[$s]") if $CPAN::DEBUG; |
89
|
0
|
0
|
|
|
|
0
|
unless ($CPAN::META->exists("CPAN::Distribution", $s)) { |
90
|
0
|
|
|
|
|
0
|
for ($CPAN::META->instance("CPAN::Distribution", $s)) { |
91
|
0
|
|
|
|
|
0
|
$_->{build_dir} = $s; |
92
|
0
|
|
|
|
|
0
|
$_->{archived} = "local_directory"; |
93
|
0
|
|
|
|
|
0
|
$_->{unwrapped} = CPAN::Distrostatus->new("YES -- local_directory"); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
} elsif ( |
97
|
|
|
|
|
|
|
$s =~ tr|/|| == 1 |
98
|
|
|
|
|
|
|
or |
99
|
|
|
|
|
|
|
$s !~ m|[A-Z]/[A-Z-0-9]{2}/[A-Z-0-9]{2,}/| |
100
|
|
|
|
|
|
|
) { |
101
|
0
|
0
|
|
|
|
0
|
return $s if $s =~ m:^N/A|^Contact Author: ; |
102
|
0
|
|
|
|
|
0
|
$s =~ s|^(.)(.)([^/]*/)(.+)$|$1/$1$2/$1$2$3$4|; |
103
|
0
|
0
|
|
|
|
0
|
CPAN->debug("s[$s]") if $CPAN::DEBUG; |
104
|
|
|
|
|
|
|
} |
105
|
1
|
|
|
|
|
3
|
$s; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::author ; |
109
|
|
|
|
|
|
|
sub author { |
110
|
1
|
|
|
1
|
0
|
1
|
my($self) = @_; |
111
|
1
|
|
|
|
|
1
|
my($authorid); |
112
|
1
|
50
|
|
|
|
5
|
if (substr($self->id,-1,1) eq ".") { |
113
|
0
|
|
|
|
|
0
|
$authorid = "LOCAL"; |
114
|
|
|
|
|
|
|
} else { |
115
|
1
|
|
|
|
|
5
|
($authorid) = $self->pretty_id =~ /^([\w\-]+)/; |
116
|
|
|
|
|
|
|
} |
117
|
1
|
|
|
|
|
4
|
CPAN::Shell->expand("Author",$authorid); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# tries to get the yaml from CPAN instead of the distro itself: |
121
|
|
|
|
|
|
|
# EXPERIMENTAL, UNDOCUMENTED AND UNTESTED, for Tels |
122
|
|
|
|
|
|
|
sub fast_yaml { |
123
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
124
|
0
|
|
|
|
|
0
|
my $meta = $self->pretty_id; |
125
|
0
|
|
|
|
|
0
|
$meta =~ s/\.(tar.gz|tgz|zip|tar.bz2)/.meta/; |
126
|
0
|
|
|
|
|
0
|
my(@ls) = CPAN::Shell->globls($meta); |
127
|
0
|
|
|
|
|
0
|
my $norm = $self->normalize($meta); |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
0
|
my($local_file); |
130
|
|
|
|
|
|
|
my($local_wanted) = |
131
|
|
|
|
|
|
|
File::Spec->catfile( |
132
|
|
|
|
|
|
|
$CPAN::Config->{keep_source_where}, |
133
|
0
|
|
|
|
|
0
|
"authors", |
134
|
|
|
|
|
|
|
"id", |
135
|
|
|
|
|
|
|
split(/\//,$norm) |
136
|
|
|
|
|
|
|
); |
137
|
0
|
0
|
|
|
|
0
|
$self->debug("Doing localize") if $CPAN::DEBUG; |
138
|
0
|
0
|
|
|
|
0
|
unless ($local_file = |
139
|
|
|
|
|
|
|
CPAN::FTP->localize("authors/id/$norm", |
140
|
|
|
|
|
|
|
$local_wanted)) { |
141
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("Giving up on downloading yaml file '$local_wanted'\n"); |
142
|
|
|
|
|
|
|
} |
143
|
0
|
|
|
|
|
0
|
my $yaml = CPAN->_yaml_loadfile($local_file)->[0]; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::cpan_userid |
147
|
|
|
|
|
|
|
sub cpan_userid { |
148
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
149
|
0
|
0
|
|
|
|
0
|
if ($self->{ID} =~ m{[A-Z]/[A-Z\-]{2}/([A-Z\-]+)/}) { |
150
|
0
|
|
|
|
|
0
|
return $1; |
151
|
|
|
|
|
|
|
} |
152
|
0
|
|
|
|
|
0
|
return $self->SUPER::cpan_userid; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::pretty_id |
156
|
|
|
|
|
|
|
sub pretty_id { |
157
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
158
|
1
|
|
|
|
|
4
|
my $id = $self->id; |
159
|
1
|
50
|
|
|
|
7
|
return $id unless $id =~ m|^./../|; |
160
|
1
|
|
|
|
|
6
|
substr($id,5); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::base_id |
164
|
|
|
|
|
|
|
sub base_id { |
165
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
166
|
0
|
|
|
|
|
0
|
my $id = $self->pretty_id(); |
167
|
0
|
|
|
|
|
0
|
my $base_id = File::Basename::basename($id); |
168
|
0
|
|
|
|
|
0
|
$base_id =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i; |
169
|
0
|
|
|
|
|
0
|
return $base_id; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::tested_ok_but_not_installed |
173
|
|
|
|
|
|
|
sub tested_ok_but_not_installed { |
174
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
175
|
|
|
|
|
|
|
return ( |
176
|
|
|
|
|
|
|
$self->{make_test} |
177
|
|
|
|
|
|
|
&& $self->{build_dir} |
178
|
|
|
|
|
|
|
&& (UNIVERSAL::can($self->{make_test},"failed") ? |
179
|
|
|
|
|
|
|
! $self->{make_test}->failed : |
180
|
|
|
|
|
|
|
$self->{make_test} =~ /^YES/ |
181
|
|
|
|
|
|
|
) |
182
|
|
|
|
|
|
|
&& ( |
183
|
|
|
|
|
|
|
!$self->{install} |
184
|
|
|
|
|
|
|
|| |
185
|
|
|
|
|
|
|
$self->{install}->failed |
186
|
|
|
|
|
|
|
) |
187
|
0
|
|
0
|
|
|
0
|
); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# mark as dirty/clean for the sake of recursion detection. $color=1 |
192
|
|
|
|
|
|
|
# means "in use", $color=0 means "not in use anymore". $color=2 means |
193
|
|
|
|
|
|
|
# we have determined prereqs now and thus insist on passing this |
194
|
|
|
|
|
|
|
# through (at least) once again. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::color_cmd_tmps ; |
197
|
|
|
|
|
|
|
sub color_cmd_tmps { |
198
|
0
|
|
|
0
|
0
|
0
|
my($self) = shift; |
199
|
0
|
|
0
|
|
|
0
|
my($depth) = shift || 0; |
200
|
0
|
|
0
|
|
|
0
|
my($color) = shift || 0; |
201
|
0
|
|
0
|
|
|
0
|
my($ancestors) = shift || []; |
202
|
|
|
|
|
|
|
# a distribution needs to recurse into its prereq_pms |
203
|
0
|
0
|
|
|
|
0
|
$self->debug("color_cmd_tmps[$depth,$color,@$ancestors]") if $CPAN::DEBUG; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
return if exists $self->{incommandcolor} |
206
|
|
|
|
|
|
|
&& $color==1 |
207
|
0
|
0
|
0
|
|
|
0
|
&& $self->{incommandcolor}==$color; |
|
|
|
0
|
|
|
|
|
208
|
0
|
|
0
|
|
|
0
|
$CPAN::MAX_RECURSION||=0; # silence 'once' warnings |
209
|
0
|
0
|
|
|
|
0
|
if ($depth>=$CPAN::MAX_RECURSION) { |
210
|
0
|
|
|
|
|
0
|
my $e = CPAN::Exception::RecursiveDependency->new($ancestors); |
211
|
0
|
0
|
|
|
|
0
|
if ($e->is_resolvable) { |
212
|
0
|
|
|
|
|
0
|
return $self->{incommandcolor}=2; |
213
|
|
|
|
|
|
|
} else { |
214
|
0
|
|
|
|
|
0
|
die $e; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
# warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; |
218
|
0
|
|
|
|
|
0
|
my $prereq_pm = $self->prereq_pm; |
219
|
0
|
0
|
|
|
|
0
|
if (defined $prereq_pm) { |
220
|
|
|
|
|
|
|
# XXX also optional_req & optional_breq? -- xdg, 2012-04-01 |
221
|
|
|
|
|
|
|
# A: no, optional deps may recurse -- ak, 2014-05-07 |
222
|
0
|
|
|
|
|
0
|
PREREQ: for my $pre (sort( |
223
|
0
|
0
|
|
|
|
0
|
keys %{$prereq_pm->{requires}||{}}, |
224
|
0
|
0
|
|
|
|
0
|
keys %{$prereq_pm->{build_requires}||{}}, |
225
|
|
|
|
|
|
|
)) { |
226
|
0
|
0
|
|
|
|
0
|
next PREREQ if $pre eq "perl"; |
227
|
0
|
|
|
|
|
0
|
my $premo; |
228
|
0
|
0
|
|
|
|
0
|
unless ($premo = CPAN::Shell->expand("Module",$pre)) { |
229
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("prerequisite module[$pre] not known\n"); |
230
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(0.2); |
231
|
0
|
|
|
|
|
0
|
next PREREQ; |
232
|
|
|
|
|
|
|
} |
233
|
0
|
|
|
|
|
0
|
$premo->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
} |
236
|
0
|
0
|
|
|
|
0
|
if ($color==0) { |
237
|
0
|
|
|
|
|
0
|
delete $self->{sponsored_mods}; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# as we are at the end of a command, we'll give up this |
240
|
|
|
|
|
|
|
# reminder of a broken test. Other commands may test this guy |
241
|
|
|
|
|
|
|
# again. Maybe 'badtestcnt' should be renamed to |
242
|
|
|
|
|
|
|
# 'make_test_failed_within_command'? |
243
|
0
|
|
|
|
|
0
|
delete $self->{badtestcnt}; |
244
|
|
|
|
|
|
|
} |
245
|
0
|
|
|
|
|
0
|
$self->{incommandcolor} = $color; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::as_string ; |
249
|
|
|
|
|
|
|
sub as_string { |
250
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
251
|
0
|
|
|
|
|
0
|
$self->containsmods; |
252
|
0
|
|
|
|
|
0
|
$self->upload_date; |
253
|
0
|
|
|
|
|
0
|
$self->SUPER::as_string(@_); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::containsmods ; |
257
|
|
|
|
|
|
|
sub containsmods { |
258
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
259
|
0
|
0
|
|
|
|
0
|
return sort keys %{$self->{CONTAINSMODS}} if exists $self->{CONTAINSMODS}; |
|
0
|
|
|
|
|
0
|
|
260
|
0
|
|
|
|
|
0
|
my $dist_id = $self->{ID}; |
261
|
0
|
|
|
|
|
0
|
for my $mod ($CPAN::META->all_objects("CPAN::Module")) { |
262
|
0
|
0
|
|
|
|
0
|
my $mod_file = $mod->cpan_file or next; |
263
|
0
|
0
|
|
|
|
0
|
my $mod_id = $mod->{ID} or next; |
264
|
|
|
|
|
|
|
# warn "mod_file[$mod_file] dist_id[$dist_id] mod_id[$mod_id]"; |
265
|
|
|
|
|
|
|
# sleep 1; |
266
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Signal) { |
267
|
0
|
|
|
|
|
0
|
delete $self->{CONTAINSMODS}; |
268
|
0
|
|
|
|
|
0
|
return; |
269
|
|
|
|
|
|
|
} |
270
|
0
|
0
|
|
|
|
0
|
$self->{CONTAINSMODS}{$mod_id} = undef if $mod_file eq $dist_id; |
271
|
|
|
|
|
|
|
} |
272
|
0
|
|
0
|
|
|
0
|
sort keys %{$self->{CONTAINSMODS}||={}}; |
|
0
|
|
|
|
|
0
|
|
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::upload_date ; |
276
|
|
|
|
|
|
|
sub upload_date { |
277
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
278
|
0
|
0
|
|
|
|
0
|
return $self->{UPLOAD_DATE} if exists $self->{UPLOAD_DATE}; |
279
|
0
|
|
|
|
|
0
|
my(@local_wanted) = split(/\//,$self->id); |
280
|
0
|
|
|
|
|
0
|
my $filename = pop @local_wanted; |
281
|
0
|
|
|
|
|
0
|
push @local_wanted, "CHECKSUMS"; |
282
|
0
|
|
|
|
|
0
|
my $author = CPAN::Shell->expand("Author",$self->cpan_userid); |
283
|
0
|
0
|
|
|
|
0
|
return unless $author; |
284
|
0
|
|
|
|
|
0
|
my @dl = $author->dir_listing(\@local_wanted,0,$CPAN::Config->{show_upload_date}); |
285
|
0
|
0
|
|
|
|
0
|
return unless @dl; |
286
|
0
|
|
|
|
|
0
|
my($dirent) = grep { $_->[2] eq $filename } @dl; |
|
0
|
|
|
|
|
0
|
|
287
|
|
|
|
|
|
|
# warn sprintf "dirent[%s]id[%s]", $dirent, $self->id; |
288
|
0
|
0
|
|
|
|
0
|
return unless $dirent->[1]; |
289
|
0
|
|
|
|
|
0
|
return $self->{UPLOAD_DATE} = $dirent->[1]; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::uptodate ; |
293
|
|
|
|
|
|
|
sub uptodate { |
294
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
295
|
0
|
|
|
|
|
0
|
my $c; |
296
|
0
|
|
|
|
|
0
|
foreach $c ($self->containsmods) { |
297
|
0
|
|
|
|
|
0
|
my $obj = CPAN::Shell->expandany($c); |
298
|
0
|
0
|
|
|
|
0
|
unless ($obj->uptodate) { |
299
|
0
|
|
|
|
|
0
|
my $id = $self->pretty_id; |
300
|
0
|
0
|
|
|
|
0
|
$self->debug("$id not uptodate due to $c") if $CPAN::DEBUG; |
301
|
0
|
|
|
|
|
0
|
return 0; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
0
|
|
|
|
|
0
|
return 1; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::called_for ; |
308
|
|
|
|
|
|
|
sub called_for { |
309
|
0
|
|
|
0
|
0
|
0
|
my($self,$id) = @_; |
310
|
0
|
0
|
|
|
|
0
|
$self->{CALLED_FOR} = $id if defined $id; |
311
|
0
|
|
|
|
|
0
|
return $self->{CALLED_FOR}; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::shortcut_get ; |
315
|
|
|
|
|
|
|
# return values: undef means don't shortcut; 0 means shortcut as fail; |
316
|
|
|
|
|
|
|
# and 1 means shortcut as success |
317
|
|
|
|
|
|
|
sub shortcut_get { |
318
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
319
|
|
|
|
|
|
|
|
320
|
0
|
0
|
|
|
|
0
|
if (my $why = $self->check_disabled) { |
321
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO $why"); |
322
|
|
|
|
|
|
|
# XXX why is this goodbye() instead of just print/warn? |
323
|
|
|
|
|
|
|
# Alternatively, should other print/warns here be goodbye()? |
324
|
|
|
|
|
|
|
# -- xdg, 2012-04-05 |
325
|
0
|
|
|
|
|
0
|
return $self->goodbye("[disabled] -- NA $why"); |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
0
|
0
|
|
|
|
0
|
$self->debug("checking already unwrapped[$self->{ID}]") if $CPAN::DEBUG; |
329
|
0
|
0
|
0
|
|
|
0
|
if (exists $self->{build_dir} && -d $self->{build_dir}) { |
330
|
|
|
|
|
|
|
# this deserves print, not warn: |
331
|
0
|
|
|
|
|
0
|
return $self->success("Has already been unwrapped into directory ". |
332
|
|
|
|
|
|
|
"$self->{build_dir}" |
333
|
|
|
|
|
|
|
); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# XXX I'm not sure this should be here because it's not really |
337
|
|
|
|
|
|
|
# a test for whether get should continue or return; this is |
338
|
|
|
|
|
|
|
# a side effect -- xdg, 2012-04-05 |
339
|
0
|
0
|
|
|
|
0
|
$self->debug("checking missing build_dir[$self->{ID}]") if $CPAN::DEBUG; |
340
|
0
|
0
|
0
|
|
|
0
|
if (exists $self->{build_dir} && ! -d $self->{build_dir}){ |
341
|
|
|
|
|
|
|
# we have lost it. |
342
|
0
|
|
|
|
|
0
|
$self->fforce(""); # no method to reset all phases but not set force (dodge) |
343
|
0
|
|
|
|
|
0
|
return undef; # no shortcut |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
# although we talk about 'force' we shall not test on |
347
|
|
|
|
|
|
|
# force directly. New model of force tries to refrain from |
348
|
|
|
|
|
|
|
# direct checking of force. |
349
|
0
|
0
|
|
|
|
0
|
$self->debug("checking unwrapping error[$self->{ID}]") if $CPAN::DEBUG; |
350
|
0
|
0
|
0
|
|
|
0
|
if ( exists $self->{unwrapped} and ( |
|
|
0
|
|
|
|
|
|
351
|
|
|
|
|
|
|
UNIVERSAL::can($self->{unwrapped},"failed") ? |
352
|
|
|
|
|
|
|
$self->{unwrapped}->failed : |
353
|
|
|
|
|
|
|
$self->{unwrapped} =~ /^NO/ ) |
354
|
|
|
|
|
|
|
) { |
355
|
0
|
|
|
|
|
0
|
return $self->goodbye("Unwrapping had some problem, won't try again without force"); |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
0
|
|
|
|
|
0
|
return undef; # no shortcut |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::get ; |
362
|
|
|
|
|
|
|
sub get { |
363
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
364
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
0
|
$self->pre_get(); |
366
|
|
|
|
|
|
|
|
367
|
0
|
0
|
|
|
|
0
|
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG; |
368
|
0
|
0
|
|
|
|
0
|
if (my $goto = $self->prefs->{goto}) { |
369
|
0
|
|
|
|
|
0
|
return $self->goto($goto); |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
0
|
0
|
|
|
|
0
|
if ( defined( my $sc = $self->shortcut_get) ) { |
373
|
0
|
|
|
|
|
0
|
return $sc; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) |
377
|
|
|
|
|
|
|
? $ENV{PERL5LIB} |
378
|
0
|
0
|
0
|
|
|
0
|
: ($ENV{PERLLIB} || ""); |
379
|
0
|
0
|
|
|
|
0
|
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; |
380
|
0
|
|
|
|
|
0
|
$CPAN::META->set_perl5lib; |
381
|
0
|
|
|
|
|
0
|
local $ENV{MAKEFLAGS}; # protect us from outer make calls |
382
|
|
|
|
|
|
|
|
383
|
0
|
|
|
|
|
0
|
my $sub_wd = CPAN::anycwd(); # for cleaning up as good as possible |
384
|
|
|
|
|
|
|
|
385
|
0
|
|
|
|
|
0
|
my($local_file); |
386
|
|
|
|
|
|
|
# XXX I don't think this check needs to be here, as it |
387
|
|
|
|
|
|
|
# is already checked in shortcut_get() -- xdg, 2012-04-05 |
388
|
0
|
0
|
0
|
|
|
0
|
unless ($self->{build_dir} && -d $self->{build_dir}) { |
389
|
0
|
|
|
|
|
0
|
$self->get_file_onto_local_disk; |
390
|
0
|
0
|
|
|
|
0
|
return if $CPAN::Signal; |
391
|
0
|
|
|
|
|
0
|
$self->check_integrity; |
392
|
0
|
0
|
|
|
|
0
|
return if $CPAN::Signal; |
393
|
0
|
|
|
|
|
0
|
(my $packagedir,$local_file) = $self->run_preps_on_packagedir; |
394
|
|
|
|
|
|
|
# XXX why is this check here? -- xdg, 2012-04-08 |
395
|
0
|
0
|
0
|
|
|
0
|
if (exists $self->{writemakefile} && ref $self->{writemakefile} |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
396
|
|
|
|
|
|
|
&& $self->{writemakefile}->can("failed") && |
397
|
|
|
|
|
|
|
$self->{writemakefile}->failed) { |
398
|
|
|
|
|
|
|
# |
399
|
0
|
|
|
|
|
0
|
return; |
400
|
|
|
|
|
|
|
} |
401
|
0
|
|
0
|
|
|
0
|
$packagedir ||= $self->{build_dir}; |
402
|
0
|
|
|
|
|
0
|
$self->{build_dir} = $packagedir; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# XXX should this move up to after run_preps_on_packagedir? |
406
|
|
|
|
|
|
|
# Otherwise, failing writemakefile can return without |
407
|
|
|
|
|
|
|
# a $CPAN::Signal check -- xdg, 2012-04-05 |
408
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Signal) { |
409
|
0
|
|
|
|
|
0
|
$self->safe_chdir($sub_wd); |
410
|
0
|
|
|
|
|
0
|
return; |
411
|
|
|
|
|
|
|
} |
412
|
0
|
0
|
|
|
|
0
|
return unless $self->patch; |
413
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
414
|
|
|
|
|
|
|
|
415
|
0
|
|
|
|
|
0
|
$self->post_get(); |
416
|
|
|
|
|
|
|
|
417
|
0
|
|
|
|
|
0
|
return 1; # success |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
#-> CPAN::Distribution::get_file_onto_local_disk |
421
|
|
|
|
|
|
|
sub get_file_onto_local_disk { |
422
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
423
|
|
|
|
|
|
|
|
424
|
0
|
0
|
|
|
|
0
|
return if $self->is_dot_dist; |
425
|
0
|
|
|
|
|
0
|
my($local_file); |
426
|
|
|
|
|
|
|
my($local_wanted) = |
427
|
|
|
|
|
|
|
File::Spec->catfile( |
428
|
|
|
|
|
|
|
$CPAN::Config->{keep_source_where}, |
429
|
0
|
|
|
|
|
0
|
"authors", |
430
|
|
|
|
|
|
|
"id", |
431
|
|
|
|
|
|
|
split(/\//,$self->id) |
432
|
|
|
|
|
|
|
); |
433
|
|
|
|
|
|
|
|
434
|
0
|
0
|
|
|
|
0
|
$self->debug("Doing localize") if $CPAN::DEBUG; |
435
|
0
|
0
|
|
|
|
0
|
unless ($local_file = |
436
|
|
|
|
|
|
|
CPAN::FTP->localize("authors/id/$self->{ID}", |
437
|
|
|
|
|
|
|
$local_wanted)) { |
438
|
0
|
|
|
|
|
0
|
my $note = ""; |
439
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Index::DATE_OF_02) { |
440
|
0
|
|
|
|
|
0
|
$note = "Note: Current database in memory was generated ". |
441
|
|
|
|
|
|
|
"on $CPAN::Index::DATE_OF_02\n"; |
442
|
|
|
|
|
|
|
} |
443
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("Giving up on '$local_wanted'\n$note"); |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
0
|
0
|
|
|
|
0
|
$self->debug("local_wanted[$local_wanted]local_file[$local_file]") if $CPAN::DEBUG; |
447
|
0
|
|
|
|
|
0
|
$self->{localfile} = $local_file; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
#-> CPAN::Distribution::check_integrity |
452
|
|
|
|
|
|
|
sub check_integrity { |
453
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
454
|
|
|
|
|
|
|
|
455
|
0
|
0
|
|
|
|
0
|
return if $self->is_dot_dist; |
456
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst("Digest::SHA")) { |
457
|
0
|
|
|
|
|
0
|
$self->debug("Digest::SHA is installed, verifying"); |
458
|
0
|
|
|
|
|
0
|
$self->verifyCHECKSUM; |
459
|
|
|
|
|
|
|
} else { |
460
|
0
|
|
|
|
|
0
|
$self->debug("Digest::SHA is NOT installed"); |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
#-> CPAN::Distribution::run_preps_on_packagedir |
465
|
|
|
|
|
|
|
sub run_preps_on_packagedir { |
466
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
467
|
0
|
0
|
|
|
|
0
|
return if $self->is_dot_dist; |
468
|
|
|
|
|
|
|
|
469
|
0
|
|
0
|
|
|
0
|
$CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); # unsafe meta access, ok |
470
|
0
|
|
|
|
|
0
|
my $builddir = $CPAN::META->{cachemgr}->dir; # unsafe meta access, ok |
471
|
0
|
|
|
|
|
0
|
$self->safe_chdir($builddir); |
472
|
0
|
0
|
|
|
|
0
|
$self->debug("Removing tmp-$$") if $CPAN::DEBUG; |
473
|
0
|
|
|
|
|
0
|
File::Path::rmtree("tmp-$$"); |
474
|
0
|
0
|
|
|
|
0
|
unless (mkdir "tmp-$$", 0755) { |
475
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->unrecoverable_error(<
|
476
|
|
|
|
|
|
|
Couldn't mkdir '$builddir/tmp-$$': $! |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
Cannot continue: Please find the reason why I cannot make the |
479
|
|
|
|
|
|
|
directory |
480
|
|
|
|
|
|
|
$builddir/tmp-$$ |
481
|
|
|
|
|
|
|
and fix the problem, then retry. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
EOF |
484
|
|
|
|
|
|
|
} |
485
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Signal) { |
486
|
0
|
|
|
|
|
0
|
return; |
487
|
|
|
|
|
|
|
} |
488
|
0
|
|
|
|
|
0
|
$self->safe_chdir("tmp-$$"); |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
# |
491
|
|
|
|
|
|
|
# Unpack the goods |
492
|
|
|
|
|
|
|
# |
493
|
0
|
|
|
|
|
0
|
my $local_file = $self->{localfile}; |
494
|
0
|
|
|
|
|
0
|
my $ct = eval{CPAN::Tarzip->new($local_file)}; |
|
0
|
|
|
|
|
0
|
|
495
|
0
|
0
|
|
|
|
0
|
unless ($ct) { |
496
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO"); |
497
|
0
|
|
|
|
|
0
|
delete $self->{build_dir}; |
498
|
0
|
|
|
|
|
0
|
return; |
499
|
|
|
|
|
|
|
} |
500
|
0
|
0
|
|
|
|
0
|
if ($local_file =~ /(\.tar\.(bz2|gz|Z)|\.tgz)(?!\n)\Z/i) { |
|
|
0
|
|
|
|
|
|
501
|
0
|
0
|
|
|
|
0
|
$self->{was_uncompressed}++ unless eval{$ct->gtest()}; |
|
0
|
|
|
|
|
0
|
|
502
|
0
|
|
|
|
|
0
|
$self->untar_me($ct); |
503
|
|
|
|
|
|
|
} elsif ( $local_file =~ /\.zip(?!\n)\Z/i ) { |
504
|
0
|
|
|
|
|
0
|
$self->unzip_me($ct); |
505
|
|
|
|
|
|
|
} else { |
506
|
0
|
0
|
|
|
|
0
|
$self->{was_uncompressed}++ unless $ct->gtest(); |
507
|
0
|
|
|
|
|
0
|
$local_file = $self->handle_singlefile($local_file); |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# we are still in the tmp directory! |
511
|
|
|
|
|
|
|
# Let's check if the package has its own directory. |
512
|
0
|
0
|
|
|
|
0
|
my $dh = DirHandle->new(File::Spec->curdir) |
513
|
|
|
|
|
|
|
or Carp::croak("Couldn't opendir .: $!"); |
514
|
0
|
|
|
|
|
0
|
my @readdir = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh->read; ### MAC?? |
515
|
0
|
0
|
|
|
|
0
|
if (grep { $_ eq "pax_global_header" } @readdir) { |
|
0
|
|
|
|
|
0
|
|
516
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Your (un)tar seems to have extracted a file named 'pax_global_header' |
517
|
|
|
|
|
|
|
from the tarball '$local_file'. |
518
|
|
|
|
|
|
|
This is almost certainly an error. Please upgrade your tar. |
519
|
|
|
|
|
|
|
I'll ignore this file for now. |
520
|
|
|
|
|
|
|
See also http://rt.cpan.org/Ticket/Display.html?id=38932\n"); |
521
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(5); |
522
|
0
|
|
|
|
|
0
|
@readdir = grep { $_ ne "pax_global_header" } @readdir; |
|
0
|
|
|
|
|
0
|
|
523
|
|
|
|
|
|
|
} |
524
|
0
|
|
|
|
|
0
|
$dh->close; |
525
|
0
|
|
|
|
|
0
|
my $tdir_base; |
526
|
|
|
|
|
|
|
my $from_dir; |
527
|
0
|
|
|
|
|
0
|
my @dirents; |
528
|
0
|
0
|
0
|
|
|
0
|
if (@readdir == 1 && -d $readdir[0]) { |
529
|
0
|
|
|
|
|
0
|
$tdir_base = $readdir[0]; |
530
|
0
|
|
|
|
|
0
|
$from_dir = File::Spec->catdir(File::Spec->curdir,$readdir[0]); |
531
|
0
|
|
|
|
|
0
|
my $dh2; |
532
|
0
|
0
|
|
|
|
0
|
unless ($dh2 = DirHandle->new($from_dir)) { |
533
|
0
|
|
|
|
|
0
|
my($mode) = (stat $from_dir)[2]; |
534
|
0
|
|
|
|
|
0
|
my $why = sprintf |
535
|
|
|
|
|
|
|
( |
536
|
|
|
|
|
|
|
"Couldn't opendir '%s', mode '%o': %s", |
537
|
|
|
|
|
|
|
$from_dir, |
538
|
|
|
|
|
|
|
$mode, |
539
|
|
|
|
|
|
|
$!, |
540
|
|
|
|
|
|
|
); |
541
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("$why\n"); |
542
|
0
|
|
|
|
|
0
|
$self->{writemakefile} = CPAN::Distrostatus->new("NO -- $why"); |
543
|
0
|
|
|
|
|
0
|
return; |
544
|
|
|
|
|
|
|
} |
545
|
0
|
|
|
|
|
0
|
@dirents = grep $_ !~ /^\.\.?(?!\n)\Z/s, $dh2->read; ### MAC?? |
546
|
|
|
|
|
|
|
} else { |
547
|
0
|
|
|
|
|
0
|
my $userid = $self->cpan_userid; |
548
|
0
|
|
|
|
|
0
|
CPAN->debug("userid[$userid]"); |
549
|
0
|
0
|
0
|
|
|
0
|
if (!$userid or $userid eq "N/A") { |
550
|
0
|
|
|
|
|
0
|
$userid = "anon"; |
551
|
|
|
|
|
|
|
} |
552
|
0
|
|
|
|
|
0
|
$tdir_base = $userid; |
553
|
0
|
|
|
|
|
0
|
$from_dir = File::Spec->curdir; |
554
|
0
|
|
|
|
|
0
|
@dirents = @readdir; |
555
|
|
|
|
|
|
|
} |
556
|
0
|
|
|
|
|
0
|
eval { File::Path::mkpath $builddir; }; |
|
0
|
|
|
|
|
0
|
|
557
|
0
|
0
|
|
|
|
0
|
if ($@) { |
558
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("Cannot create directory $builddir: $@"); |
559
|
|
|
|
|
|
|
} |
560
|
0
|
|
|
|
|
0
|
my $packagedir; |
561
|
0
|
0
|
|
|
|
0
|
my $eexist = $CPAN::META->has_usable("Errno") ? &Errno::EEXIST : undef; |
562
|
0
|
|
|
|
|
0
|
for(my $suffix = 0; ; $suffix++) { |
563
|
0
|
|
|
|
|
0
|
$packagedir = File::Spec->catdir($builddir, "$tdir_base-$suffix"); |
564
|
0
|
|
|
|
|
0
|
my $parent = $builddir; |
565
|
0
|
0
|
|
|
|
0
|
mkdir($packagedir, 0777) and last; |
566
|
0
|
0
|
0
|
|
|
0
|
if((defined($eexist) && $! != $eexist) || $suffix == 999) { |
|
|
|
0
|
|
|
|
|
567
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("Cannot create directory $packagedir: $!\n"); |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
} |
570
|
0
|
|
|
|
|
0
|
my $f; |
571
|
0
|
|
|
|
|
0
|
for $f (@dirents) { # is already without "." and ".." |
572
|
0
|
|
|
|
|
0
|
my $from = File::Spec->catfile($from_dir,$f); |
573
|
0
|
|
|
|
|
0
|
my $to = File::Spec->catfile($packagedir,$f); |
574
|
0
|
0
|
|
|
|
0
|
unless (File::Copy::move($from,$to)) { |
575
|
0
|
|
|
|
|
0
|
my $err = $!; |
576
|
0
|
|
|
|
|
0
|
$from = File::Spec->rel2abs($from); |
577
|
0
|
0
|
|
|
|
0
|
$CPAN::Frontend->mydie( |
|
|
0
|
|
|
|
|
|
578
|
|
|
|
|
|
|
"Couldn't move $from to $to: $err; #82295? ". |
579
|
|
|
|
|
|
|
"CPAN::VERSION=$CPAN::VERSION; ". |
580
|
|
|
|
|
|
|
"File::Copy::VERSION=$File::Copy::VERSION; ". |
581
|
|
|
|
|
|
|
"$from " . (-e $from ? "exists; " : "does not exist; "). |
582
|
|
|
|
|
|
|
"$to " . (-e $to ? "exists; " : "does not exist; "). |
583
|
|
|
|
|
|
|
"cwd=" . CPAN::anycwd() . ";" |
584
|
|
|
|
|
|
|
); |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
} |
587
|
0
|
|
|
|
|
0
|
$self->{build_dir} = $packagedir; |
588
|
0
|
|
|
|
|
0
|
$self->safe_chdir($builddir); |
589
|
0
|
|
|
|
|
0
|
File::Path::rmtree("tmp-$$"); |
590
|
|
|
|
|
|
|
|
591
|
0
|
|
|
|
|
0
|
$self->safe_chdir($packagedir); |
592
|
0
|
|
|
|
|
0
|
$self->_signature_business(); |
593
|
0
|
|
|
|
|
0
|
$self->safe_chdir($builddir); |
594
|
|
|
|
|
|
|
|
595
|
0
|
|
|
|
|
0
|
return($packagedir,$local_file); |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::pick_meta_file ; |
599
|
|
|
|
|
|
|
sub pick_meta_file { |
600
|
41
|
|
|
41
|
0
|
4852
|
my($self, $filter) = @_; |
601
|
41
|
50
|
|
|
|
83
|
$filter = '.' unless defined $filter; |
602
|
|
|
|
|
|
|
|
603
|
41
|
|
|
|
|
28
|
my $build_dir; |
604
|
41
|
50
|
|
|
|
90
|
unless ($build_dir = $self->{build_dir}) { |
605
|
|
|
|
|
|
|
# maybe permission on build_dir was missing |
606
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Warning: cannot determine META.yml without a build_dir.\n"); |
607
|
0
|
|
|
|
|
0
|
return; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
41
|
|
|
|
|
110
|
my $has_cm = $CPAN::META->has_usable("CPAN::Meta"); |
611
|
41
|
|
|
|
|
63
|
my $has_pcm = $CPAN::META->has_usable("Parse::CPAN::Meta"); |
612
|
|
|
|
|
|
|
|
613
|
41
|
|
|
|
|
36
|
my @choices; |
614
|
41
|
50
|
|
|
|
84
|
push @choices, 'MYMETA.json' if $has_cm; |
615
|
41
|
50
|
33
|
|
|
109
|
push @choices, 'MYMETA.yml' if $has_cm || $has_pcm; |
616
|
41
|
50
|
|
|
|
61
|
push @choices, 'META.json' if $has_cm; |
617
|
41
|
50
|
33
|
|
|
77
|
push @choices, 'META.yml' if $has_cm || $has_pcm; |
618
|
|
|
|
|
|
|
|
619
|
41
|
|
|
|
|
60
|
for my $file ( grep { /$filter/ } @choices ) { |
|
164
|
|
|
|
|
364
|
|
620
|
101
|
|
|
|
|
607
|
my $path = File::Spec->catfile( $build_dir, $file ); |
621
|
101
|
100
|
|
|
|
986
|
return $path if -f $path |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
|
624
|
3
|
|
|
|
|
15
|
return; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::parse_meta_yml ; |
628
|
|
|
|
|
|
|
sub parse_meta_yml { |
629
|
0
|
|
|
0
|
0
|
0
|
my($self, $yaml) = @_; |
630
|
0
|
0
|
0
|
|
|
0
|
$self->debug(sprintf("parse_meta_yml[%s]",$yaml||'undef')) if $CPAN::DEBUG; |
631
|
0
|
0
|
|
|
|
0
|
my $build_dir = $self->{build_dir} or die "PANIC: cannot parse yaml without a build_dir"; |
632
|
0
|
|
0
|
|
|
0
|
$yaml ||= File::Spec->catfile($build_dir,"META.yml"); |
633
|
0
|
0
|
|
|
|
0
|
$self->debug("meta[$yaml]") if $CPAN::DEBUG; |
634
|
0
|
0
|
|
|
|
0
|
return unless -f $yaml; |
635
|
0
|
|
|
|
|
0
|
my $early_yaml; |
636
|
0
|
|
|
|
|
0
|
eval { |
637
|
0
|
0
|
|
|
|
0
|
$CPAN::META->has_inst("Parse::CPAN::Meta") or die; |
638
|
0
|
0
|
|
|
|
0
|
die "Parse::CPAN::Meta yaml too old" unless $Parse::CPAN::Meta::VERSION >= "1.40"; |
639
|
|
|
|
|
|
|
# P::C::M returns last document in scalar context |
640
|
0
|
|
|
|
|
0
|
$early_yaml = Parse::CPAN::Meta::LoadFile($yaml); |
641
|
|
|
|
|
|
|
}; |
642
|
0
|
0
|
|
|
|
0
|
unless ($early_yaml) { |
643
|
0
|
|
|
|
|
0
|
eval { $early_yaml = CPAN->_yaml_loadfile($yaml)->[0]; }; |
|
0
|
|
|
|
|
0
|
|
644
|
|
|
|
|
|
|
} |
645
|
0
|
0
|
0
|
|
|
0
|
$self->debug(sprintf("yaml[%s]", $early_yaml || 'UNDEF')) if $CPAN::DEBUG; |
646
|
0
|
0
|
0
|
|
|
0
|
$self->debug($early_yaml) if $CPAN::DEBUG && $early_yaml; |
647
|
0
|
0
|
0
|
|
|
0
|
if (!ref $early_yaml or ref $early_yaml ne "HASH"){ |
648
|
|
|
|
|
|
|
# fix rt.cpan.org #95271 |
649
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("The content of '$yaml' is not a HASH reference. Cannot use it.\n"); |
650
|
0
|
|
|
|
|
0
|
return {}; |
651
|
|
|
|
|
|
|
} |
652
|
0
|
|
0
|
|
|
0
|
return $early_yaml || undef; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::satisfy_requires ; |
656
|
|
|
|
|
|
|
# return values: 1 means requirements are satisfied; |
657
|
|
|
|
|
|
|
# and 0 means not satisfied (and maybe queued) |
658
|
|
|
|
|
|
|
sub satisfy_requires { |
659
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
660
|
0
|
0
|
|
|
|
0
|
$self->debug("Entering satisfy_requires") if $CPAN::DEBUG; |
661
|
0
|
0
|
|
|
|
0
|
if (my @prereq = $self->unsat_prereq("later")) { |
662
|
0
|
0
|
|
|
|
0
|
$self->debug("unsatisfied[@prereq]") if $CPAN::DEBUG; |
663
|
0
|
0
|
0
|
|
|
0
|
$self->debug(@prereq) if $CPAN::DEBUG && @prereq; |
664
|
0
|
0
|
|
|
|
0
|
if ($prereq[0][0] eq "perl") { |
665
|
0
|
|
|
|
|
0
|
my $need = "requires perl '$prereq[0][1]'"; |
666
|
0
|
|
|
|
|
0
|
my $id = $self->pretty_id; |
667
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n"); |
668
|
0
|
|
|
|
|
0
|
$self->{make} = CPAN::Distrostatus->new("NO $need"); |
669
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
670
|
0
|
|
|
|
|
0
|
die "[prereq] -- NOT OK\n"; |
671
|
|
|
|
|
|
|
} else { |
672
|
0
|
|
|
|
|
0
|
my $follow = eval { $self->follow_prereqs("later",@prereq); }; |
|
0
|
|
|
|
|
0
|
|
673
|
0
|
0
|
0
|
|
|
0
|
if (0) { |
|
|
0
|
0
|
|
|
|
|
674
|
0
|
|
|
|
|
0
|
} elsif ($follow) { |
675
|
0
|
|
|
|
|
0
|
return; # we need deps |
676
|
|
|
|
|
|
|
} elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) { |
677
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn($@); |
678
|
0
|
|
|
|
|
0
|
die "[depend] -- NOT OK\n"; |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
} |
682
|
0
|
|
|
|
|
0
|
return 1; |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::satisfy_configure_requires ; |
686
|
|
|
|
|
|
|
# return values: 1 means configure_require is satisfied; |
687
|
|
|
|
|
|
|
# and 0 means not satisfied (and maybe queued) |
688
|
|
|
|
|
|
|
sub satisfy_configure_requires { |
689
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
690
|
0
|
0
|
|
|
|
0
|
$self->debug("Entering satisfy_configure_requires") if $CPAN::DEBUG; |
691
|
0
|
|
|
|
|
0
|
my $enable_configure_requires = 1; |
692
|
0
|
0
|
|
|
|
0
|
if (!$enable_configure_requires) { |
693
|
0
|
|
|
|
|
0
|
return 1; |
694
|
|
|
|
|
|
|
# if we return 1 here, everything is as before we introduced |
695
|
|
|
|
|
|
|
# configure_requires that means, things with |
696
|
|
|
|
|
|
|
# configure_requires simply fail, all others succeed |
697
|
|
|
|
|
|
|
} |
698
|
0
|
|
|
|
|
0
|
my @prereq = $self->unsat_prereq("configure_requires_later"); |
699
|
0
|
0
|
|
|
|
0
|
$self->debug(sprintf "configure_requires[%s]", join(",",map {join "/",@$_} @prereq)) if $CPAN::DEBUG; |
|
0
|
|
|
|
|
0
|
|
700
|
0
|
0
|
|
|
|
0
|
return 1 unless @prereq; |
701
|
0
|
0
|
|
|
|
0
|
$self->debug(\@prereq) if $CPAN::DEBUG; |
702
|
0
|
0
|
|
|
|
0
|
if ($self->{configure_requires_later}) { |
703
|
0
|
0
|
|
|
|
0
|
for my $k (sort keys %{$self->{configure_requires_later_for}||{}}) { |
|
0
|
|
|
|
|
0
|
|
704
|
0
|
0
|
|
|
|
0
|
if ($self->{configure_requires_later_for}{$k}>1) { |
705
|
0
|
|
|
|
|
0
|
my $type = ""; |
706
|
0
|
|
|
|
|
0
|
for my $p (@prereq) { |
707
|
0
|
0
|
|
|
|
0
|
if ($p->[0] eq $k) { |
708
|
0
|
|
|
|
|
0
|
$type = $p->[1]; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
} |
711
|
0
|
0
|
|
|
|
0
|
$type = " $type" if $type; |
712
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Warning: unmanageable(?) prerequisite $k$type"); |
713
|
0
|
|
|
|
|
0
|
sleep 1; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
} |
717
|
0
|
0
|
|
|
|
0
|
if ($prereq[0][0] eq "perl") { |
718
|
0
|
|
|
|
|
0
|
my $need = "requires perl '$prereq[0][1]'"; |
719
|
0
|
|
|
|
|
0
|
my $id = $self->pretty_id; |
720
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("$id $need; you have only $]; giving up\n"); |
721
|
0
|
|
|
|
|
0
|
$self->{make} = CPAN::Distrostatus->new("NO $need"); |
722
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
723
|
0
|
|
|
|
|
0
|
return $self->goodbye("[prereq] -- NOT OK"); |
724
|
|
|
|
|
|
|
} else { |
725
|
0
|
|
|
|
|
0
|
my $follow = eval { |
726
|
0
|
|
|
|
|
0
|
$self->follow_prereqs("configure_requires_later", @prereq); |
727
|
|
|
|
|
|
|
}; |
728
|
0
|
0
|
0
|
|
|
0
|
if (0) { |
|
|
0
|
0
|
|
|
|
|
729
|
0
|
|
|
|
|
0
|
} elsif ($follow) { |
730
|
0
|
|
|
|
|
0
|
return; # we need deps |
731
|
|
|
|
|
|
|
} elsif ($@ && ref $@ && $@->isa("CPAN::Exception::RecursiveDependency")) { |
732
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn($@); |
733
|
0
|
|
|
|
|
0
|
return $self->goodbye("[depend] -- NOT OK"); |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
else { |
736
|
0
|
|
|
|
|
0
|
return $self->goodbye("[configure_requires] -- NOT OK"); |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
} |
739
|
0
|
|
|
|
|
0
|
die "never reached"; |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::choose_MM_or_MB ; |
743
|
|
|
|
|
|
|
sub choose_MM_or_MB { |
744
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
745
|
0
|
0
|
|
|
|
0
|
$self->satisfy_configure_requires() or return; |
746
|
0
|
|
|
|
|
0
|
my $local_file = $self->{localfile}; |
747
|
0
|
|
|
|
|
0
|
my($mpl) = File::Spec->catfile($self->{build_dir},"Makefile.PL"); |
748
|
0
|
|
|
|
|
0
|
my($mpl_exists) = -f $mpl; |
749
|
0
|
0
|
|
|
|
0
|
unless ($mpl_exists) { |
750
|
|
|
|
|
|
|
# NFS has been reported to have racing problems after the |
751
|
|
|
|
|
|
|
# renaming of a directory in some environments. |
752
|
|
|
|
|
|
|
# This trick helps. |
753
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(1); |
754
|
|
|
|
|
|
|
my $mpldh = DirHandle->new($self->{build_dir}) |
755
|
0
|
0
|
|
|
|
0
|
or Carp::croak("Couldn't opendir $self->{build_dir}: $!"); |
756
|
0
|
|
|
|
|
0
|
$mpl_exists = grep /^Makefile\.PL$/, $mpldh->read; |
757
|
0
|
|
|
|
|
0
|
$mpldh->close; |
758
|
|
|
|
|
|
|
} |
759
|
0
|
|
|
|
|
0
|
my $prefer_installer = "eumm"; # eumm|mb |
760
|
0
|
0
|
|
|
|
0
|
if (-f File::Spec->catfile($self->{build_dir},"Build.PL")) { |
761
|
0
|
0
|
|
|
|
0
|
if ($mpl_exists) { # they *can* choose |
762
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst("Module::Build")) { |
763
|
0
|
|
|
|
|
0
|
$prefer_installer = CPAN::HandleConfig->prefs_lookup( |
764
|
|
|
|
|
|
|
$self, q{prefer_installer} |
765
|
|
|
|
|
|
|
); |
766
|
|
|
|
|
|
|
# M::B <= 0.35 left a DATA handle open that |
767
|
|
|
|
|
|
|
# causes problems upgrading M::B on Windows |
768
|
0
|
0
|
|
|
|
0
|
close *Module::Build::Version::DATA |
769
|
|
|
|
|
|
|
if fileno *Module::Build::Version::DATA; |
770
|
|
|
|
|
|
|
} |
771
|
|
|
|
|
|
|
} else { |
772
|
0
|
|
|
|
|
0
|
$prefer_installer = "mb"; |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
} |
775
|
0
|
0
|
|
|
|
0
|
if (lc($prefer_installer) eq "rand") { |
776
|
0
|
0
|
|
|
|
0
|
$prefer_installer = rand()<.5 ? "eumm" : "mb"; |
777
|
|
|
|
|
|
|
} |
778
|
0
|
0
|
|
|
|
0
|
if (lc($prefer_installer) eq "mb") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
779
|
0
|
|
|
|
|
0
|
$self->{modulebuild} = 1; |
780
|
|
|
|
|
|
|
} elsif ($self->{archived} eq "patch") { |
781
|
|
|
|
|
|
|
# not an edge case, nothing to install for sure |
782
|
0
|
|
|
|
|
0
|
my $why = "A patch file cannot be installed"; |
783
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Refusing to handle this file: $why\n"); |
784
|
0
|
|
|
|
|
0
|
$self->{writemakefile} = CPAN::Distrostatus->new("NO $why"); |
785
|
|
|
|
|
|
|
} elsif (! $mpl_exists) { |
786
|
0
|
|
|
|
|
0
|
$self->_edge_cases($mpl,$local_file); |
787
|
|
|
|
|
|
|
} |
788
|
0
|
0
|
0
|
|
|
0
|
if ($self->{build_dir} |
789
|
|
|
|
|
|
|
&& |
790
|
|
|
|
|
|
|
$CPAN::Config->{build_dir_reuse} |
791
|
|
|
|
|
|
|
) { |
792
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
793
|
|
|
|
|
|
|
} |
794
|
0
|
|
|
|
|
0
|
return $self; |
795
|
|
|
|
|
|
|
} |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# see also reanimate_build_dir |
798
|
|
|
|
|
|
|
#-> CPAN::Distribution::store_persistent_state |
799
|
|
|
|
|
|
|
sub store_persistent_state { |
800
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
801
|
0
|
|
|
|
|
0
|
my $dir = $self->{build_dir}; |
802
|
0
|
0
|
0
|
|
|
0
|
unless (defined $dir && length $dir) { |
803
|
0
|
|
|
|
|
0
|
my $id = $self->id; |
804
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarnonce("build_dir of $id is not known, ". |
805
|
|
|
|
|
|
|
"will not store persistent state\n"); |
806
|
0
|
|
|
|
|
0
|
return; |
807
|
|
|
|
|
|
|
} |
808
|
|
|
|
|
|
|
# self-build-dir |
809
|
0
|
|
|
|
|
0
|
my $sbd = Cwd::realpath( |
810
|
|
|
|
|
|
|
File::Spec->catdir($dir, File::Spec->updir ()) |
811
|
|
|
|
|
|
|
); |
812
|
|
|
|
|
|
|
# config-build-dir |
813
|
|
|
|
|
|
|
my $cbd = Cwd::realpath( |
814
|
|
|
|
|
|
|
# the catdir is a workaround for bug https://rt.cpan.org/Ticket/Display.html?id=101283 |
815
|
0
|
|
|
|
|
0
|
File::Spec->catdir($CPAN::Config->{build_dir}, File::Spec->curdir()) |
816
|
|
|
|
|
|
|
); |
817
|
0
|
0
|
|
|
|
0
|
unless ($sbd eq $cbd) { |
818
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarnonce("Directory '$dir' not below $CPAN::Config->{build_dir}, ". |
819
|
|
|
|
|
|
|
"will not store persistent state\n"); |
820
|
0
|
|
|
|
|
0
|
return; |
821
|
|
|
|
|
|
|
} |
822
|
0
|
|
|
|
|
0
|
my $file = sprintf "%s.yml", $dir; |
823
|
0
|
|
|
|
|
0
|
my $yaml_module = CPAN::_yaml_module(); |
824
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst($yaml_module)) { |
825
|
0
|
|
|
|
|
0
|
CPAN->_yaml_dumpfile( |
826
|
|
|
|
|
|
|
$file, |
827
|
|
|
|
|
|
|
{ |
828
|
|
|
|
|
|
|
time => time, |
829
|
|
|
|
|
|
|
perl => CPAN::_perl_fingerprint(), |
830
|
|
|
|
|
|
|
distribution => $self, |
831
|
|
|
|
|
|
|
} |
832
|
|
|
|
|
|
|
); |
833
|
|
|
|
|
|
|
} else { |
834
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprintonce("'$yaml_module' not installed, ". |
835
|
|
|
|
|
|
|
"will not store persistent state\n"); |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
#-> CPAN::Distribution::try_download |
840
|
|
|
|
|
|
|
sub try_download { |
841
|
0
|
|
|
0
|
0
|
0
|
my($self,$patch) = @_; |
842
|
0
|
|
|
|
|
0
|
my $norm = $self->normalize($patch); |
843
|
|
|
|
|
|
|
my($local_wanted) = |
844
|
|
|
|
|
|
|
File::Spec->catfile( |
845
|
|
|
|
|
|
|
$CPAN::Config->{keep_source_where}, |
846
|
0
|
|
|
|
|
0
|
"authors", |
847
|
|
|
|
|
|
|
"id", |
848
|
|
|
|
|
|
|
split(/\//,$norm), |
849
|
|
|
|
|
|
|
); |
850
|
0
|
0
|
|
|
|
0
|
$self->debug("Doing localize") if $CPAN::DEBUG; |
851
|
0
|
|
|
|
|
0
|
return CPAN::FTP->localize("authors/id/$norm", |
852
|
|
|
|
|
|
|
$local_wanted); |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
{ |
856
|
|
|
|
|
|
|
my $stdpatchargs = ""; |
857
|
|
|
|
|
|
|
#-> CPAN::Distribution::patch |
858
|
|
|
|
|
|
|
sub patch { |
859
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
860
|
0
|
0
|
|
|
|
0
|
$self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG; |
861
|
0
|
|
|
|
|
0
|
my $patches = $self->prefs->{patches}; |
862
|
0
|
|
0
|
|
|
0
|
$patches ||= ""; |
863
|
0
|
0
|
|
|
|
0
|
$self->debug("patches[$patches]") if $CPAN::DEBUG; |
864
|
0
|
0
|
|
|
|
0
|
if ($patches) { |
865
|
0
|
0
|
|
|
|
0
|
return unless @$patches; |
866
|
0
|
|
|
|
|
0
|
$self->safe_chdir($self->{build_dir}); |
867
|
0
|
0
|
|
|
|
0
|
CPAN->debug("patches[$patches]") if $CPAN::DEBUG; |
868
|
0
|
|
|
|
|
0
|
my $patchbin = $CPAN::Config->{patch}; |
869
|
0
|
0
|
0
|
|
|
0
|
unless ($patchbin && length $patchbin) { |
870
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("No external patch command configured\n\n". |
871
|
|
|
|
|
|
|
"Please run 'o conf init /patch/'\n\n"); |
872
|
|
|
|
|
|
|
} |
873
|
0
|
0
|
|
|
|
0
|
unless (MM->maybe_command($patchbin)) { |
874
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("No external patch command available\n\n". |
875
|
|
|
|
|
|
|
"Please run 'o conf init /patch/'\n\n"); |
876
|
|
|
|
|
|
|
} |
877
|
0
|
|
|
|
|
0
|
$patchbin = CPAN::HandleConfig->safe_quote($patchbin); |
878
|
0
|
|
|
|
|
0
|
local $ENV{PATCH_GET} = 0; # formerly known as -g0 |
879
|
0
|
0
|
|
|
|
0
|
unless ($stdpatchargs) { |
880
|
0
|
|
|
|
|
0
|
my $system = "$patchbin --version |"; |
881
|
0
|
|
|
|
|
0
|
local *FH; |
882
|
0
|
0
|
|
|
|
0
|
open FH, $system or die "Could not fork '$system': $!"; |
883
|
0
|
|
|
|
|
0
|
local $/ = "\n"; |
884
|
0
|
|
|
|
|
0
|
my $pversion; |
885
|
0
|
|
|
|
|
0
|
PARSEVERSION: while () { |
886
|
0
|
0
|
|
|
|
0
|
if (/^patch\s+([\d\.]+)/) { |
887
|
0
|
|
|
|
|
0
|
$pversion = $1; |
888
|
0
|
|
|
|
|
0
|
last PARSEVERSION; |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
} |
891
|
0
|
0
|
|
|
|
0
|
if ($pversion) { |
892
|
0
|
|
|
|
|
0
|
$stdpatchargs = "-N --fuzz=3"; |
893
|
|
|
|
|
|
|
} else { |
894
|
0
|
|
|
|
|
0
|
$stdpatchargs = "-N"; |
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
} |
897
|
0
|
0
|
|
|
|
0
|
my $countedpatches = @$patches == 1 ? "1 patch" : (scalar @$patches . " patches"); |
898
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint("Applying $countedpatches:\n"); |
899
|
0
|
|
|
|
|
0
|
my $patches_dir = $CPAN::Config->{patches_dir}; |
900
|
0
|
|
|
|
|
0
|
for my $patch (@$patches) { |
901
|
0
|
0
|
0
|
|
|
0
|
if ($patches_dir && !File::Spec->file_name_is_absolute($patch)) { |
902
|
0
|
|
|
|
|
0
|
my $f = File::Spec->catfile($patches_dir, $patch); |
903
|
0
|
0
|
|
|
|
0
|
$patch = $f if -f $f; |
904
|
|
|
|
|
|
|
} |
905
|
0
|
0
|
|
|
|
0
|
unless (-f $patch) { |
906
|
0
|
0
|
|
|
|
0
|
CPAN->debug("not on disk: patch[$patch]") if $CPAN::DEBUG; |
907
|
0
|
0
|
|
|
|
0
|
if (my $trydl = $self->try_download($patch)) { |
908
|
0
|
|
|
|
|
0
|
$patch = $trydl; |
909
|
|
|
|
|
|
|
} else { |
910
|
0
|
|
|
|
|
0
|
my $fail = "Could not find patch '$patch'"; |
911
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("$fail; cannot continue\n"); |
912
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail"); |
913
|
0
|
|
|
|
|
0
|
delete $self->{build_dir}; |
914
|
0
|
|
|
|
|
0
|
return; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
} |
917
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(" $patch\n"); |
918
|
0
|
|
|
|
|
0
|
my $readfh = CPAN::Tarzip->TIEHANDLE($patch); |
919
|
|
|
|
|
|
|
|
920
|
0
|
|
|
|
|
0
|
my $pcommand; |
921
|
0
|
|
|
|
|
0
|
my($ppp,$pfiles) = $self->_patch_p_parameter($readfh); |
922
|
0
|
0
|
|
|
|
0
|
if ($ppp eq "applypatch") { |
923
|
0
|
|
|
|
|
0
|
$pcommand = "$CPAN::Config->{applypatch} -verbose"; |
924
|
|
|
|
|
|
|
} else { |
925
|
0
|
|
|
|
|
0
|
my $thispatchargs = join " ", $stdpatchargs, $ppp; |
926
|
0
|
|
|
|
|
0
|
$pcommand = "$patchbin $thispatchargs"; |
927
|
0
|
|
|
|
|
0
|
require Config; # usually loaded from CPAN.pm |
928
|
0
|
0
|
|
|
|
0
|
if ($Config::Config{osname} eq "solaris") { |
929
|
|
|
|
|
|
|
# native solaris patch cannot patch readonly files |
930
|
0
|
0
|
|
|
|
0
|
for my $file (@{$pfiles||[]}) { |
|
0
|
|
|
|
|
0
|
|
931
|
0
|
0
|
|
|
|
0
|
my @stat = stat $file or next; |
932
|
0
|
|
|
|
|
0
|
chmod $stat[2] | 0600, $file; # may fail |
933
|
|
|
|
|
|
|
} |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
|
937
|
0
|
|
|
|
|
0
|
$readfh = CPAN::Tarzip->TIEHANDLE($patch); # open again |
938
|
0
|
|
|
|
|
0
|
my $writefh = FileHandle->new; |
939
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(" $pcommand\n"); |
940
|
0
|
0
|
|
|
|
0
|
unless (open $writefh, "|$pcommand") { |
941
|
0
|
|
|
|
|
0
|
my $fail = "Could not fork '$pcommand'"; |
942
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("$fail; cannot continue\n"); |
943
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail"); |
944
|
0
|
|
|
|
|
0
|
delete $self->{build_dir}; |
945
|
0
|
|
|
|
|
0
|
return; |
946
|
|
|
|
|
|
|
} |
947
|
0
|
|
|
|
|
0
|
binmode($writefh); |
948
|
0
|
|
|
|
|
0
|
while (my $x = $readfh->READLINE) { |
949
|
0
|
|
|
|
|
0
|
print $writefh $x; |
950
|
|
|
|
|
|
|
} |
951
|
0
|
0
|
|
|
|
0
|
unless (close $writefh) { |
952
|
0
|
|
|
|
|
0
|
my $fail = "Could not apply patch '$patch'"; |
953
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("$fail; cannot continue\n"); |
954
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO -- $fail"); |
955
|
0
|
|
|
|
|
0
|
delete $self->{build_dir}; |
956
|
0
|
|
|
|
|
0
|
return; |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
} |
959
|
0
|
|
|
|
|
0
|
$self->{patched}++; |
960
|
|
|
|
|
|
|
} |
961
|
0
|
|
|
|
|
0
|
return 1; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
# may return |
966
|
|
|
|
|
|
|
# - "applypatch" |
967
|
|
|
|
|
|
|
# - ("-p0"|"-p1", $files) |
968
|
|
|
|
|
|
|
sub _patch_p_parameter { |
969
|
0
|
|
|
0
|
|
0
|
my($self,$fh) = @_; |
970
|
0
|
|
|
|
|
0
|
my $cnt_files = 0; |
971
|
0
|
|
|
|
|
0
|
my $cnt_p0files = 0; |
972
|
0
|
|
|
|
|
0
|
my @files; |
973
|
0
|
|
|
|
|
0
|
local($_); |
974
|
0
|
|
|
|
|
0
|
while ($_ = $fh->READLINE) { |
975
|
0
|
0
|
0
|
|
|
0
|
if ( |
976
|
|
|
|
|
|
|
$CPAN::Config->{applypatch} |
977
|
|
|
|
|
|
|
&& |
978
|
|
|
|
|
|
|
/\#\#\#\# ApplyPatch data follows \#\#\#\#/ |
979
|
|
|
|
|
|
|
) { |
980
|
0
|
|
|
|
|
0
|
return "applypatch" |
981
|
|
|
|
|
|
|
} |
982
|
0
|
0
|
|
|
|
0
|
next unless /^[\*\+]{3}\s(\S+)/; |
983
|
0
|
|
|
|
|
0
|
my $file = $1; |
984
|
0
|
|
|
|
|
0
|
push @files, $file; |
985
|
0
|
|
|
|
|
0
|
$cnt_files++; |
986
|
0
|
0
|
|
|
|
0
|
$cnt_p0files++ if -f $file; |
987
|
0
|
0
|
|
|
|
0
|
CPAN->debug("file[$file]cnt_files[$cnt_files]cnt_p0files[$cnt_p0files]") |
988
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
989
|
|
|
|
|
|
|
} |
990
|
0
|
0
|
|
|
|
0
|
return "-p1" unless $cnt_files; |
991
|
0
|
0
|
|
|
|
0
|
my $opt_p = $cnt_files==$cnt_p0files ? "-p0" : "-p1"; |
992
|
0
|
|
|
|
|
0
|
return ($opt_p, \@files); |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::_edge_cases |
996
|
|
|
|
|
|
|
# with "configure" or "Makefile" or single file scripts |
997
|
|
|
|
|
|
|
sub _edge_cases { |
998
|
0
|
|
|
0
|
|
0
|
my($self,$mpl,$local_file) = @_; |
999
|
0
|
0
|
|
|
|
0
|
$self->debug(sprintf("makefilepl[%s]anycwd[%s]", |
1000
|
|
|
|
|
|
|
$mpl, |
1001
|
|
|
|
|
|
|
CPAN::anycwd(), |
1002
|
|
|
|
|
|
|
)) if $CPAN::DEBUG; |
1003
|
0
|
|
|
|
|
0
|
my $build_dir = $self->{build_dir}; |
1004
|
0
|
|
|
|
|
0
|
my($configure) = File::Spec->catfile($build_dir,"Configure"); |
1005
|
0
|
0
|
|
|
|
0
|
if (-f $configure) { |
|
|
0
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
# do we have anything to do? |
1007
|
0
|
|
|
|
|
0
|
$self->{configure} = $configure; |
1008
|
|
|
|
|
|
|
} elsif (-f File::Spec->catfile($build_dir,"Makefile")) { |
1009
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(qq{ |
1010
|
|
|
|
|
|
|
Package comes with a Makefile and without a Makefile.PL. |
1011
|
|
|
|
|
|
|
We\'ll try to build it with that Makefile then. |
1012
|
|
|
|
|
|
|
}); |
1013
|
0
|
|
|
|
|
0
|
$self->{writemakefile} = CPAN::Distrostatus->new("YES"); |
1014
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(2); |
1015
|
|
|
|
|
|
|
} else { |
1016
|
0
|
|
0
|
|
|
0
|
my $cf = $self->called_for || "unknown"; |
1017
|
0
|
0
|
|
|
|
0
|
if ($cf =~ m|/|) { |
1018
|
0
|
|
|
|
|
0
|
$cf =~ s|.*/||; |
1019
|
0
|
|
|
|
|
0
|
$cf =~ s|\W.*||; |
1020
|
|
|
|
|
|
|
} |
1021
|
0
|
|
|
|
|
0
|
$cf =~ s|[/\\:]||g; # risk of filesystem damage |
1022
|
0
|
0
|
|
|
|
0
|
$cf = "unknown" unless length($cf); |
1023
|
0
|
0
|
|
|
|
0
|
if (my $crud = $self->_contains_crud($build_dir)) { |
1024
|
0
|
|
|
|
|
0
|
my $why = qq{Package contains $crud; not recognized as a perl package, giving up}; |
1025
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("$why\n"); |
1026
|
0
|
|
|
|
|
0
|
$self->{writemakefile} = CPAN::Distrostatus->new(qq{NO -- $why}); |
1027
|
0
|
|
|
|
|
0
|
return; |
1028
|
|
|
|
|
|
|
} |
1029
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(qq{Package seems to come without Makefile.PL. |
1030
|
|
|
|
|
|
|
(The test -f "$mpl" returned false.) |
1031
|
|
|
|
|
|
|
Writing one on our own (setting NAME to $cf)\a\n}); |
1032
|
0
|
|
|
|
|
0
|
$self->{had_no_makefile_pl}++; |
1033
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(3); |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
# Writing our own Makefile.PL |
1036
|
|
|
|
|
|
|
|
1037
|
0
|
|
|
|
|
0
|
my $exefile_stanza = ""; |
1038
|
0
|
0
|
|
|
|
0
|
if ($self->{archived} eq "maybe_pl") { |
1039
|
0
|
|
|
|
|
0
|
$exefile_stanza = $self->_exefile_stanza($build_dir,$local_file); |
1040
|
|
|
|
|
|
|
} |
1041
|
|
|
|
|
|
|
|
1042
|
0
|
|
|
|
|
0
|
my $fh = FileHandle->new; |
1043
|
0
|
0
|
|
|
|
0
|
$fh->open(">$mpl") |
1044
|
|
|
|
|
|
|
or Carp::croak("Could not open >$mpl: $!"); |
1045
|
0
|
|
|
|
|
0
|
$fh->print( |
1046
|
|
|
|
|
|
|
qq{# This Makefile.PL has been autogenerated by the module CPAN.pm |
1047
|
|
|
|
|
|
|
# because there was no Makefile.PL supplied. |
1048
|
|
|
|
|
|
|
# Autogenerated on: }.scalar localtime().qq{ |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
use ExtUtils::MakeMaker; |
1051
|
|
|
|
|
|
|
WriteMakefile( |
1052
|
|
|
|
|
|
|
NAME => q[$cf],$exefile_stanza |
1053
|
|
|
|
|
|
|
); |
1054
|
|
|
|
|
|
|
}); |
1055
|
0
|
|
|
|
|
0
|
$fh->close; |
1056
|
|
|
|
|
|
|
} |
1057
|
|
|
|
|
|
|
} |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
#-> CPAN;:Distribution::_contains_crud |
1060
|
|
|
|
|
|
|
sub _contains_crud { |
1061
|
0
|
|
|
0
|
|
0
|
my($self,$dir) = @_; |
1062
|
0
|
|
|
|
|
0
|
my(@dirs, $dh, @files); |
1063
|
0
|
0
|
|
|
|
0
|
opendir $dh, $dir or return; |
1064
|
0
|
|
|
|
|
0
|
my $dirent; |
1065
|
0
|
|
|
|
|
0
|
for $dirent (readdir $dh) { |
1066
|
0
|
0
|
|
|
|
0
|
next if $dirent =~ /^\.\.?$/; |
1067
|
0
|
|
|
|
|
0
|
my $path = File::Spec->catdir($dir,$dirent); |
1068
|
0
|
0
|
|
|
|
0
|
if (-d $path) { |
|
|
0
|
|
|
|
|
|
1069
|
0
|
|
|
|
|
0
|
push @dirs, $dirent; |
1070
|
|
|
|
|
|
|
} elsif (-f $path) { |
1071
|
0
|
|
|
|
|
0
|
push @files, $dirent; |
1072
|
|
|
|
|
|
|
} |
1073
|
|
|
|
|
|
|
} |
1074
|
0
|
0
|
0
|
|
|
0
|
if (@dirs && @files) { |
|
|
0
|
|
|
|
|
|
1075
|
0
|
|
|
|
|
0
|
return "both files[@files] and directories[@dirs]"; |
1076
|
|
|
|
|
|
|
} elsif (@files > 2) { |
1077
|
0
|
|
|
|
|
0
|
return "several files[@files] but no Makefile.PL or Build.PL"; |
1078
|
|
|
|
|
|
|
} |
1079
|
0
|
|
|
|
|
0
|
return; |
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
#-> CPAN;:Distribution::_exefile_stanza |
1083
|
|
|
|
|
|
|
sub _exefile_stanza { |
1084
|
0
|
|
|
0
|
|
0
|
my($self,$build_dir,$local_file) = @_; |
1085
|
|
|
|
|
|
|
|
1086
|
0
|
|
|
|
|
0
|
my $fh = FileHandle->new; |
1087
|
0
|
|
|
|
|
0
|
my $script_file = File::Spec->catfile($build_dir,$local_file); |
1088
|
0
|
0
|
|
|
|
0
|
$fh->open($script_file) |
1089
|
|
|
|
|
|
|
or Carp::croak("Could not open script '$script_file': $!"); |
1090
|
0
|
|
|
|
|
0
|
local $/ = "\n"; |
1091
|
|
|
|
|
|
|
# parse name and prereq |
1092
|
0
|
|
|
|
|
0
|
my($state) = "poddir"; |
1093
|
0
|
|
|
|
|
0
|
my($name, $prereq) = ("", ""); |
1094
|
0
|
|
|
|
|
0
|
while (<$fh>) { |
1095
|
0
|
0
|
0
|
|
|
0
|
if ($state eq "poddir" && /^=head\d\s+(\S+)/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1096
|
0
|
0
|
|
|
|
0
|
if ($1 eq 'NAME') { |
|
|
0
|
|
|
|
|
|
1097
|
0
|
|
|
|
|
0
|
$state = "name"; |
1098
|
|
|
|
|
|
|
} elsif ($1 eq 'PREREQUISITES') { |
1099
|
0
|
|
|
|
|
0
|
$state = "prereq"; |
1100
|
|
|
|
|
|
|
} |
1101
|
|
|
|
|
|
|
} elsif ($state =~ m{^(name|prereq)$}) { |
1102
|
0
|
0
|
|
|
|
0
|
if (/^=/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1103
|
0
|
|
|
|
|
0
|
$state = "poddir"; |
1104
|
|
|
|
|
|
|
} elsif (/^\s*$/) { |
1105
|
|
|
|
|
|
|
# nop |
1106
|
|
|
|
|
|
|
} elsif ($state eq "name") { |
1107
|
0
|
0
|
|
|
|
0
|
if ($name eq "") { |
1108
|
0
|
|
|
|
|
0
|
($name) = /^(\S+)/; |
1109
|
0
|
|
|
|
|
0
|
$state = "poddir"; |
1110
|
|
|
|
|
|
|
} |
1111
|
|
|
|
|
|
|
} elsif ($state eq "prereq") { |
1112
|
0
|
|
|
|
|
0
|
$prereq .= $_; |
1113
|
|
|
|
|
|
|
} |
1114
|
|
|
|
|
|
|
} elsif (/^=cut\b/) { |
1115
|
0
|
|
|
|
|
0
|
last; |
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
} |
1118
|
0
|
|
|
|
|
0
|
$fh->close; |
1119
|
|
|
|
|
|
|
|
1120
|
0
|
|
|
|
|
0
|
for ($name) { |
1121
|
0
|
|
|
|
|
0
|
s{.*<}{}; # strip X<...> |
1122
|
0
|
|
|
|
|
0
|
s{>.*}{}; |
1123
|
|
|
|
|
|
|
} |
1124
|
0
|
|
|
|
|
0
|
chomp $prereq; |
1125
|
0
|
|
|
|
|
0
|
$prereq = join " ", split /\s+/, $prereq; |
1126
|
|
|
|
|
|
|
my($PREREQ_PM) = join("\n", map { |
1127
|
0
|
|
|
|
|
0
|
s{.*<}{}; # strip X<...> |
|
0
|
|
|
|
|
0
|
|
1128
|
0
|
|
|
|
|
0
|
s{>.*}{}; |
1129
|
0
|
0
|
|
|
|
0
|
if (/[\s\'\"]/) { # prose? |
1130
|
|
|
|
|
|
|
} else { |
1131
|
0
|
|
|
|
|
0
|
s/[^\w:]$//; # period? |
1132
|
0
|
|
|
|
|
0
|
" "x28 . "'$_' => 0,"; |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
} split /\s*,\s*/, $prereq); |
1135
|
|
|
|
|
|
|
|
1136
|
0
|
0
|
|
|
|
0
|
if ($name) { |
1137
|
0
|
|
|
|
|
0
|
my $to_file = File::Spec->catfile($build_dir, $name); |
1138
|
0
|
0
|
|
|
|
0
|
rename $script_file, $to_file |
1139
|
|
|
|
|
|
|
or die "Can't rename $script_file to $to_file: $!"; |
1140
|
|
|
|
|
|
|
} |
1141
|
|
|
|
|
|
|
|
1142
|
0
|
|
|
|
|
0
|
return " |
1143
|
|
|
|
|
|
|
EXE_FILES => ['$name'], |
1144
|
|
|
|
|
|
|
PREREQ_PM => { |
1145
|
|
|
|
|
|
|
$PREREQ_PM |
1146
|
|
|
|
|
|
|
}, |
1147
|
|
|
|
|
|
|
"; |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
#-> CPAN::Distribution::_signature_business |
1151
|
|
|
|
|
|
|
sub _signature_business { |
1152
|
0
|
|
|
0
|
|
0
|
my($self) = @_; |
1153
|
0
|
|
|
|
|
0
|
my $check_sigs = CPAN::HandleConfig->prefs_lookup($self, |
1154
|
|
|
|
|
|
|
q{check_sigs}); |
1155
|
0
|
0
|
|
|
|
0
|
if ($check_sigs) { |
1156
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst("Module::Signature")) { |
1157
|
0
|
0
|
|
|
|
0
|
if (-f "SIGNATURE") { |
1158
|
0
|
0
|
|
|
|
0
|
$self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG; |
1159
|
0
|
|
|
|
|
0
|
my $rv = Module::Signature::verify(); |
1160
|
0
|
0
|
0
|
|
|
0
|
if ($rv != Module::Signature::SIGNATURE_OK() and |
1161
|
|
|
|
|
|
|
$rv != Module::Signature::SIGNATURE_MISSING()) { |
1162
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn( |
1163
|
|
|
|
|
|
|
qq{\nSignature invalid for }. |
1164
|
|
|
|
|
|
|
qq{distribution file. }. |
1165
|
|
|
|
|
|
|
qq{Please investigate.\n\n} |
1166
|
|
|
|
|
|
|
); |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
my $wrap = |
1169
|
|
|
|
|
|
|
sprintf(qq{I'd recommend removing %s. Some error occurred }. |
1170
|
|
|
|
|
|
|
qq{while checking its signature, so it could }. |
1171
|
|
|
|
|
|
|
qq{be invalid. Maybe you have configured }. |
1172
|
|
|
|
|
|
|
qq{your 'urllist' with a bad URL. Please check this }. |
1173
|
|
|
|
|
|
|
qq{array with 'o conf urllist' and retry. Or }. |
1174
|
|
|
|
|
|
|
qq{examine the distribution in a subshell. Try |
1175
|
|
|
|
|
|
|
look %s |
1176
|
|
|
|
|
|
|
and run |
1177
|
|
|
|
|
|
|
cpansign -v |
1178
|
|
|
|
|
|
|
}, |
1179
|
|
|
|
|
|
|
$self->{localfile}, |
1180
|
0
|
|
|
|
|
0
|
$self->pretty_id, |
1181
|
|
|
|
|
|
|
); |
1182
|
0
|
|
|
|
|
0
|
$self->{signature_verify} = CPAN::Distrostatus->new("NO"); |
1183
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(Text::Wrap::wrap("","",$wrap)); |
1184
|
0
|
0
|
|
|
|
0
|
$CPAN::Frontend->mysleep(5) if $CPAN::Frontend->can("mysleep"); |
1185
|
|
|
|
|
|
|
} else { |
1186
|
0
|
|
|
|
|
0
|
$self->{signature_verify} = CPAN::Distrostatus->new("YES"); |
1187
|
0
|
0
|
|
|
|
0
|
$self->debug("Module::Signature has verified") if $CPAN::DEBUG; |
1188
|
|
|
|
|
|
|
} |
1189
|
|
|
|
|
|
|
} else { |
1190
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(qq{Package came without SIGNATURE\n\n}); |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
} else { |
1193
|
0
|
0
|
|
|
|
0
|
$self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG; |
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
} |
1196
|
|
|
|
|
|
|
} |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
#-> CPAN::Distribution::untar_me ; |
1199
|
|
|
|
|
|
|
sub untar_me { |
1200
|
0
|
|
|
0
|
0
|
0
|
my($self,$ct) = @_; |
1201
|
0
|
|
|
|
|
0
|
$self->{archived} = "tar"; |
1202
|
0
|
|
|
|
|
0
|
my $result = eval { $ct->untar() }; |
|
0
|
|
|
|
|
0
|
|
1203
|
0
|
0
|
|
|
|
0
|
if ($result) { |
1204
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("YES"); |
1205
|
|
|
|
|
|
|
} else { |
1206
|
|
|
|
|
|
|
# unfortunately we have no $@ here, Tarzip is using mydie which dies with "\n" |
1207
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO -- untar failed"); |
1208
|
|
|
|
|
|
|
} |
1209
|
|
|
|
|
|
|
} |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
# CPAN::Distribution::unzip_me ; |
1212
|
|
|
|
|
|
|
sub unzip_me { |
1213
|
0
|
|
|
0
|
0
|
0
|
my($self,$ct) = @_; |
1214
|
0
|
|
|
|
|
0
|
$self->{archived} = "zip"; |
1215
|
0
|
0
|
|
|
|
0
|
if ($ct->unzip()) { |
1216
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("YES"); |
1217
|
|
|
|
|
|
|
} else { |
1218
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO -- unzip failed"); |
1219
|
|
|
|
|
|
|
} |
1220
|
0
|
|
|
|
|
0
|
return; |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
sub handle_singlefile { |
1224
|
0
|
|
|
0
|
0
|
0
|
my($self,$local_file) = @_; |
1225
|
|
|
|
|
|
|
|
1226
|
0
|
0
|
|
|
|
0
|
if ( $local_file =~ /\.pm(\.(gz|Z))?(?!\n)\Z/ ) { |
|
|
0
|
|
|
|
|
|
1227
|
0
|
|
|
|
|
0
|
$self->{archived} = "pm"; |
1228
|
|
|
|
|
|
|
} elsif ( $local_file =~ /\.patch(\.(gz|bz2))?(?!\n)\Z/ ) { |
1229
|
0
|
|
|
|
|
0
|
$self->{archived} = "patch"; |
1230
|
|
|
|
|
|
|
} else { |
1231
|
0
|
|
|
|
|
0
|
$self->{archived} = "maybe_pl"; |
1232
|
|
|
|
|
|
|
} |
1233
|
|
|
|
|
|
|
|
1234
|
0
|
|
|
|
|
0
|
my $to = File::Basename::basename($local_file); |
1235
|
0
|
0
|
|
|
|
0
|
if ($to =~ s/\.(gz|Z)(?!\n)\Z//) { |
1236
|
0
|
0
|
|
|
|
0
|
if (eval{CPAN::Tarzip->new($local_file)->gunzip($to)}) { |
|
0
|
|
|
|
|
0
|
|
1237
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("YES"); |
1238
|
|
|
|
|
|
|
} else { |
1239
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO -- uncompressing failed"); |
1240
|
|
|
|
|
|
|
} |
1241
|
|
|
|
|
|
|
} else { |
1242
|
0
|
0
|
|
|
|
0
|
if (File::Copy::cp($local_file,".")) { |
1243
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("YES"); |
1244
|
|
|
|
|
|
|
} else { |
1245
|
0
|
|
|
|
|
0
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO -- copying failed"); |
1246
|
|
|
|
|
|
|
} |
1247
|
|
|
|
|
|
|
} |
1248
|
0
|
|
|
|
|
0
|
return $to; |
1249
|
|
|
|
|
|
|
} |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::new ; |
1252
|
|
|
|
|
|
|
sub new { |
1253
|
29
|
|
|
29
|
0
|
4001
|
my($class,%att) = @_; |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
# $CPAN::META->{cachemgr} ||= CPAN::CacheMgr->new(); |
1256
|
|
|
|
|
|
|
|
1257
|
29
|
|
|
|
|
67
|
my $this = { %att }; |
1258
|
29
|
|
|
|
|
110
|
return bless $this, $class; |
1259
|
|
|
|
|
|
|
} |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::look ; |
1262
|
|
|
|
|
|
|
sub look { |
1263
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
1264
|
|
|
|
|
|
|
|
1265
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MacOS') { |
1266
|
0
|
|
|
|
|
0
|
$self->Mac::BuildTools::look; |
1267
|
0
|
|
|
|
|
0
|
return; |
1268
|
|
|
|
|
|
|
} |
1269
|
|
|
|
|
|
|
|
1270
|
0
|
0
|
|
|
|
0
|
if ( $CPAN::Config->{'shell'} ) { |
1271
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(qq{ |
1272
|
|
|
|
|
|
|
Trying to open a subshell in the build directory... |
1273
|
|
|
|
|
|
|
}); |
1274
|
|
|
|
|
|
|
} else { |
1275
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(qq{ |
1276
|
|
|
|
|
|
|
Your configuration does not define a value for subshells. |
1277
|
|
|
|
|
|
|
Please define it with "o conf shell " |
1278
|
|
|
|
|
|
|
}); |
1279
|
0
|
|
|
|
|
0
|
return; |
1280
|
|
|
|
|
|
|
} |
1281
|
0
|
|
|
|
|
0
|
my $dist = $self->id; |
1282
|
0
|
|
|
|
|
0
|
my $dir; |
1283
|
0
|
0
|
|
|
|
0
|
unless ($dir = $self->dir) { |
1284
|
0
|
|
|
|
|
0
|
$self->get; |
1285
|
|
|
|
|
|
|
} |
1286
|
0
|
0
|
0
|
|
|
0
|
unless ($dir ||= $self->dir) { |
1287
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(qq{ |
1288
|
|
|
|
|
|
|
Could not determine which directory to use for looking at $dist. |
1289
|
|
|
|
|
|
|
}); |
1290
|
0
|
|
|
|
|
0
|
return; |
1291
|
|
|
|
|
|
|
} |
1292
|
0
|
|
|
|
|
0
|
my $pwd = CPAN::anycwd(); |
1293
|
0
|
|
|
|
|
0
|
$self->safe_chdir($dir); |
1294
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(qq{Working directory is $dir\n}); |
1295
|
|
|
|
|
|
|
{ |
1296
|
0
|
|
0
|
|
|
0
|
local $ENV{CPAN_SHELL_LEVEL} = $ENV{CPAN_SHELL_LEVEL}||0; |
|
0
|
|
|
|
|
0
|
|
1297
|
0
|
|
|
|
|
0
|
$ENV{CPAN_SHELL_LEVEL} += 1; |
1298
|
0
|
|
|
|
|
0
|
my $shell = CPAN::HandleConfig->safe_quote($CPAN::Config->{'shell'}); |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) |
1301
|
|
|
|
|
|
|
? $ENV{PERL5LIB} |
1302
|
0
|
0
|
0
|
|
|
0
|
: ($ENV{PERLLIB} || ""); |
1303
|
|
|
|
|
|
|
|
1304
|
0
|
0
|
|
|
|
0
|
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; |
1305
|
0
|
|
|
|
|
0
|
$CPAN::META->set_perl5lib; |
1306
|
0
|
|
|
|
|
0
|
local $ENV{MAKEFLAGS}; # protect us from outer make calls |
1307
|
|
|
|
|
|
|
|
1308
|
0
|
0
|
|
|
|
0
|
unless (system($shell) == 0) { |
1309
|
0
|
|
|
|
|
0
|
my $code = $? >> 8; |
1310
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Subprocess shell exit code $code\n"); |
1311
|
|
|
|
|
|
|
} |
1312
|
|
|
|
|
|
|
} |
1313
|
0
|
|
|
|
|
0
|
$self->safe_chdir($pwd); |
1314
|
|
|
|
|
|
|
} |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
# CPAN::Distribution::cvs_import ; |
1317
|
|
|
|
|
|
|
sub cvs_import { |
1318
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
1319
|
0
|
|
|
|
|
0
|
$self->get; |
1320
|
0
|
|
|
|
|
0
|
my $dir = $self->dir; |
1321
|
|
|
|
|
|
|
|
1322
|
0
|
|
|
|
|
0
|
my $package = $self->called_for; |
1323
|
0
|
|
|
|
|
0
|
my $module = $CPAN::META->instance('CPAN::Module', $package); |
1324
|
0
|
|
|
|
|
0
|
my $version = $module->cpan_version; |
1325
|
|
|
|
|
|
|
|
1326
|
0
|
|
|
|
|
0
|
my $userid = $self->cpan_userid; |
1327
|
|
|
|
|
|
|
|
1328
|
0
|
|
|
|
|
0
|
my $cvs_dir = (split /\//, $dir)[-1]; |
1329
|
0
|
|
|
|
|
0
|
$cvs_dir =~ s/-\d+[^-]+(?!\n)\Z//; |
1330
|
|
|
|
|
|
|
my $cvs_root = |
1331
|
0
|
|
0
|
|
|
0
|
$CPAN::Config->{cvsroot} || $ENV{CVSROOT}; |
1332
|
|
|
|
|
|
|
my $cvs_site_perl = |
1333
|
0
|
|
0
|
|
|
0
|
$CPAN::Config->{cvs_site_perl} || $ENV{CVS_SITE_PERL}; |
1334
|
0
|
0
|
|
|
|
0
|
if ($cvs_site_perl) { |
1335
|
0
|
|
|
|
|
0
|
$cvs_dir = "$cvs_site_perl/$cvs_dir"; |
1336
|
|
|
|
|
|
|
} |
1337
|
0
|
|
|
|
|
0
|
my $cvs_log = qq{"imported $package $version sources"}; |
1338
|
0
|
|
|
|
|
0
|
$version =~ s/\./_/g; |
1339
|
|
|
|
|
|
|
# XXX cvs: undocumented and unclear how it was meant to work |
1340
|
0
|
|
|
|
|
0
|
my @cmd = ('cvs', '-d', $cvs_root, 'import', '-m', $cvs_log, |
1341
|
|
|
|
|
|
|
"$cvs_dir", $userid, "v$version"); |
1342
|
|
|
|
|
|
|
|
1343
|
0
|
|
|
|
|
0
|
my $pwd = CPAN::anycwd(); |
1344
|
0
|
0
|
|
|
|
0
|
chdir($dir) or $CPAN::Frontend->mydie(qq{Could not chdir to "$dir": $!}); |
1345
|
|
|
|
|
|
|
|
1346
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(qq{Working directory is $dir\n}); |
1347
|
|
|
|
|
|
|
|
1348
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(qq{@cmd\n}); |
1349
|
0
|
0
|
|
|
|
0
|
system(@cmd) == 0 or |
1350
|
|
|
|
|
|
|
# XXX cvs |
1351
|
|
|
|
|
|
|
$CPAN::Frontend->mydie("cvs import failed"); |
1352
|
0
|
0
|
|
|
|
0
|
chdir($pwd) or $CPAN::Frontend->mydie(qq{Could not chdir to "$pwd": $!}); |
1353
|
|
|
|
|
|
|
} |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::readme ; |
1356
|
|
|
|
|
|
|
sub readme { |
1357
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
1358
|
0
|
|
|
|
|
0
|
my($dist) = $self->id; |
1359
|
0
|
|
|
|
|
0
|
my($sans,$suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/; |
1360
|
0
|
0
|
|
|
|
0
|
$self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG; |
1361
|
0
|
|
|
|
|
0
|
my($local_file); |
1362
|
|
|
|
|
|
|
my($local_wanted) = |
1363
|
|
|
|
|
|
|
File::Spec->catfile( |
1364
|
|
|
|
|
|
|
$CPAN::Config->{keep_source_where}, |
1365
|
0
|
|
|
|
|
0
|
"authors", |
1366
|
|
|
|
|
|
|
"id", |
1367
|
|
|
|
|
|
|
split(/\//,"$sans.readme"), |
1368
|
|
|
|
|
|
|
); |
1369
|
0
|
|
|
|
|
0
|
my $readme = "authors/id/$sans.readme"; |
1370
|
0
|
0
|
|
|
|
0
|
$self->debug("Doing localize for '$readme'") if $CPAN::DEBUG; |
1371
|
0
|
0
|
|
|
|
0
|
$local_file = CPAN::FTP->localize($readme, |
1372
|
|
|
|
|
|
|
$local_wanted) |
1373
|
|
|
|
|
|
|
or $CPAN::Frontend->mydie(qq{No $sans.readme found}); |
1374
|
|
|
|
|
|
|
|
1375
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MacOS') { |
1376
|
0
|
|
|
|
|
0
|
Mac::BuildTools::launch_file($local_file); |
1377
|
0
|
|
|
|
|
0
|
return; |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
|
1380
|
0
|
|
|
|
|
0
|
my $fh_pager = FileHandle->new; |
1381
|
0
|
|
|
|
|
0
|
local($SIG{PIPE}) = "IGNORE"; |
1382
|
0
|
|
0
|
|
|
0
|
my $pager = $CPAN::Config->{'pager'} || "cat"; |
1383
|
0
|
0
|
|
|
|
0
|
$fh_pager->open("|$pager") |
1384
|
|
|
|
|
|
|
or die "Could not open pager $pager\: $!"; |
1385
|
0
|
|
|
|
|
0
|
my $fh_readme = FileHandle->new; |
1386
|
0
|
0
|
|
|
|
0
|
$fh_readme->open($local_file) |
1387
|
|
|
|
|
|
|
or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!}); |
1388
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(qq{ |
1389
|
|
|
|
|
|
|
Displaying file |
1390
|
|
|
|
|
|
|
$local_file |
1391
|
|
|
|
|
|
|
with pager "$pager" |
1392
|
|
|
|
|
|
|
}); |
1393
|
0
|
|
|
|
|
0
|
$fh_pager->print(<$fh_readme>); |
1394
|
0
|
|
|
|
|
0
|
$fh_pager->close; |
1395
|
|
|
|
|
|
|
} |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::verifyCHECKSUM ; |
1398
|
|
|
|
|
|
|
sub verifyCHECKSUM { |
1399
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
1400
|
|
|
|
|
|
|
EXCUSE: { |
1401
|
0
|
|
|
|
|
0
|
my @e; |
|
0
|
|
|
|
|
0
|
|
1402
|
0
|
|
0
|
|
|
0
|
$self->{CHECKSUM_STATUS} ||= ""; |
1403
|
0
|
0
|
|
|
|
0
|
$self->{CHECKSUM_STATUS} eq "OK" and push @e, "Checksum was ok"; |
1404
|
0
|
0
|
0
|
|
|
0
|
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; |
|
0
|
|
|
|
|
0
|
|
1405
|
|
|
|
|
|
|
} |
1406
|
0
|
|
|
|
|
0
|
my($lc_want,$lc_file,@local,$basename); |
1407
|
0
|
|
|
|
|
0
|
@local = split(/\//,$self->id); |
1408
|
0
|
|
|
|
|
0
|
pop @local; |
1409
|
0
|
|
|
|
|
0
|
push @local, "CHECKSUMS"; |
1410
|
|
|
|
|
|
|
$lc_want = |
1411
|
|
|
|
|
|
|
File::Spec->catfile($CPAN::Config->{keep_source_where}, |
1412
|
0
|
|
|
|
|
0
|
"authors", "id", @local); |
1413
|
0
|
|
|
|
|
0
|
local($") = "/"; |
1414
|
0
|
0
|
|
|
|
0
|
if (my $size = -s $lc_want) { |
1415
|
0
|
0
|
|
|
|
0
|
$self->debug("lc_want[$lc_want]size[$size]") if $CPAN::DEBUG; |
1416
|
0
|
0
|
|
|
|
0
|
if ($self->CHECKSUM_check_file($lc_want,1)) { |
1417
|
0
|
|
|
|
|
0
|
return $self->{CHECKSUM_STATUS} = "OK"; |
1418
|
|
|
|
|
|
|
} |
1419
|
|
|
|
|
|
|
} |
1420
|
0
|
|
|
|
|
0
|
$lc_file = CPAN::FTP->localize("authors/id/@local", |
1421
|
|
|
|
|
|
|
$lc_want,1); |
1422
|
0
|
0
|
|
|
|
0
|
unless ($lc_file) { |
1423
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint("Trying $lc_want.gz\n"); |
1424
|
0
|
|
|
|
|
0
|
$local[-1] .= ".gz"; |
1425
|
0
|
|
|
|
|
0
|
$lc_file = CPAN::FTP->localize("authors/id/@local", |
1426
|
|
|
|
|
|
|
"$lc_want.gz",1); |
1427
|
0
|
0
|
|
|
|
0
|
if ($lc_file) { |
1428
|
0
|
|
|
|
|
0
|
$lc_file =~ s/\.gz(?!\n)\Z//; |
1429
|
0
|
|
|
|
|
0
|
eval{CPAN::Tarzip->new("$lc_file.gz")->gunzip($lc_file)}; |
|
0
|
|
|
|
|
0
|
|
1430
|
|
|
|
|
|
|
} else { |
1431
|
0
|
|
|
|
|
0
|
return; |
1432
|
|
|
|
|
|
|
} |
1433
|
|
|
|
|
|
|
} |
1434
|
0
|
0
|
|
|
|
0
|
if ($self->CHECKSUM_check_file($lc_file)) { |
1435
|
0
|
|
|
|
|
0
|
return $self->{CHECKSUM_STATUS} = "OK"; |
1436
|
|
|
|
|
|
|
} |
1437
|
|
|
|
|
|
|
} |
1438
|
|
|
|
|
|
|
|
1439
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::SIG_check_file ; |
1440
|
|
|
|
|
|
|
sub SIG_check_file { |
1441
|
0
|
|
|
0
|
0
|
0
|
my($self,$chk_file) = @_; |
1442
|
0
|
|
|
|
|
0
|
my $rv = eval { Module::Signature::_verify($chk_file) }; |
|
0
|
|
|
|
|
0
|
|
1443
|
|
|
|
|
|
|
|
1444
|
0
|
0
|
|
|
|
0
|
if ($rv == Module::Signature::SIGNATURE_OK()) { |
1445
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint("Signature for $chk_file ok\n"); |
1446
|
0
|
|
|
|
|
0
|
return $self->{SIG_STATUS} = "OK"; |
1447
|
|
|
|
|
|
|
} else { |
1448
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(qq{\nSignature invalid for }. |
1449
|
|
|
|
|
|
|
qq{distribution file. }. |
1450
|
|
|
|
|
|
|
qq{Please investigate.\n\n}. |
1451
|
|
|
|
|
|
|
$self->as_string, |
1452
|
|
|
|
|
|
|
$CPAN::META->instance( |
1453
|
|
|
|
|
|
|
'CPAN::Author', |
1454
|
|
|
|
|
|
|
$self->cpan_userid |
1455
|
|
|
|
|
|
|
)->as_string); |
1456
|
|
|
|
|
|
|
|
1457
|
0
|
|
|
|
|
0
|
my $wrap = qq{I\'d recommend removing $chk_file. Its signature |
1458
|
|
|
|
|
|
|
is invalid. Maybe you have configured your 'urllist' with |
1459
|
|
|
|
|
|
|
a bad URL. Please check this array with 'o conf urllist', and |
1460
|
|
|
|
|
|
|
retry.}; |
1461
|
|
|
|
|
|
|
|
1462
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap)); |
1463
|
|
|
|
|
|
|
} |
1464
|
|
|
|
|
|
|
} |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::CHECKSUM_check_file ; |
1467
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
# sloppy is 1 when we have an old checksums file that maybe is good |
1469
|
|
|
|
|
|
|
# enough |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
sub CHECKSUM_check_file { |
1472
|
0
|
|
|
0
|
0
|
0
|
my($self,$chk_file,$sloppy) = @_; |
1473
|
0
|
|
|
|
|
0
|
my($cksum,$file,$basename); |
1474
|
|
|
|
|
|
|
|
1475
|
0
|
|
0
|
|
|
0
|
$sloppy ||= 0; |
1476
|
0
|
0
|
|
|
|
0
|
$self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG; |
1477
|
0
|
|
|
|
|
0
|
my $check_sigs = CPAN::HandleConfig->prefs_lookup($self, |
1478
|
|
|
|
|
|
|
q{check_sigs}); |
1479
|
0
|
0
|
|
|
|
0
|
if ($check_sigs) { |
1480
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst("Module::Signature")) { |
1481
|
0
|
0
|
|
|
|
0
|
$self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG; |
1482
|
0
|
|
|
|
|
0
|
$self->SIG_check_file($chk_file); |
1483
|
|
|
|
|
|
|
} else { |
1484
|
0
|
0
|
|
|
|
0
|
$self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG; |
1485
|
|
|
|
|
|
|
} |
1486
|
|
|
|
|
|
|
} |
1487
|
|
|
|
|
|
|
|
1488
|
0
|
|
|
|
|
0
|
$file = $self->{localfile}; |
1489
|
0
|
|
|
|
|
0
|
$basename = File::Basename::basename($file); |
1490
|
0
|
|
|
|
|
0
|
my $fh = FileHandle->new; |
1491
|
0
|
0
|
|
|
|
0
|
if (open $fh, $chk_file) { |
1492
|
0
|
|
|
|
|
0
|
local($/); |
1493
|
0
|
|
|
|
|
0
|
my $eval = <$fh>; |
1494
|
0
|
|
|
|
|
0
|
$eval =~ s/\015?\012/\n/g; |
1495
|
0
|
|
|
|
|
0
|
close $fh; |
1496
|
0
|
|
|
|
|
0
|
my($compmt) = Safe->new(); |
1497
|
0
|
|
|
|
|
0
|
$cksum = $compmt->reval($eval); |
1498
|
0
|
0
|
|
|
|
0
|
if ($@) { |
1499
|
0
|
|
|
|
|
0
|
rename $chk_file, "$chk_file.bad"; |
1500
|
0
|
0
|
|
|
|
0
|
Carp::confess($@) if $@; |
1501
|
|
|
|
|
|
|
} |
1502
|
|
|
|
|
|
|
} else { |
1503
|
0
|
|
|
|
|
0
|
Carp::carp "Could not open $chk_file for reading"; |
1504
|
|
|
|
|
|
|
} |
1505
|
|
|
|
|
|
|
|
1506
|
0
|
0
|
0
|
|
|
0
|
if (! ref $cksum or ref $cksum ne "HASH") { |
|
|
0
|
|
|
|
|
|
1507
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(qq{ |
1508
|
|
|
|
|
|
|
Warning: checksum file '$chk_file' broken. |
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
When trying to read that file I expected to get a hash reference |
1511
|
|
|
|
|
|
|
for further processing, but got garbage instead. |
1512
|
|
|
|
|
|
|
}); |
1513
|
0
|
|
|
|
|
0
|
my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed nonetheless?", "no"); |
1514
|
0
|
0
|
|
|
|
0
|
$answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n"); |
1515
|
0
|
|
|
|
|
0
|
$self->{CHECKSUM_STATUS} = "NIL -- CHECKSUMS file broken"; |
1516
|
0
|
|
|
|
|
0
|
return; |
1517
|
|
|
|
|
|
|
} elsif (exists $cksum->{$basename}{sha256}) { |
1518
|
0
|
0
|
|
|
|
0
|
$self->debug("Found checksum for $basename:" . |
1519
|
|
|
|
|
|
|
"$cksum->{$basename}{sha256}\n") if $CPAN::DEBUG; |
1520
|
|
|
|
|
|
|
|
1521
|
0
|
|
|
|
|
0
|
open($fh, $file); |
1522
|
0
|
|
|
|
|
0
|
binmode $fh; |
1523
|
0
|
|
|
|
|
0
|
my $eq = $self->eq_CHECKSUM($fh,$cksum->{$basename}{sha256}); |
1524
|
0
|
|
|
|
|
0
|
$fh->close; |
1525
|
0
|
|
|
|
|
0
|
$fh = CPAN::Tarzip->TIEHANDLE($file); |
1526
|
|
|
|
|
|
|
|
1527
|
0
|
0
|
|
|
|
0
|
unless ($eq) { |
1528
|
0
|
|
|
|
|
0
|
my $dg = Digest::SHA->new(256); |
1529
|
0
|
|
|
|
|
0
|
my($data,$ref); |
1530
|
0
|
|
|
|
|
0
|
$ref = \$data; |
1531
|
0
|
|
|
|
|
0
|
while ($fh->READ($ref, 4096) > 0) { |
1532
|
0
|
|
|
|
|
0
|
$dg->add($data); |
1533
|
|
|
|
|
|
|
} |
1534
|
0
|
|
|
|
|
0
|
my $hexdigest = $dg->hexdigest; |
1535
|
0
|
|
|
|
|
0
|
$eq += $hexdigest eq $cksum->{$basename}{'sha256-ungz'}; |
1536
|
|
|
|
|
|
|
} |
1537
|
|
|
|
|
|
|
|
1538
|
0
|
0
|
|
|
|
0
|
if ($eq) { |
1539
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint("Checksum for $file ok\n"); |
1540
|
0
|
|
|
|
|
0
|
return $self->{CHECKSUM_STATUS} = "OK"; |
1541
|
|
|
|
|
|
|
} else { |
1542
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(qq{\nChecksum mismatch for }. |
1543
|
|
|
|
|
|
|
qq{distribution file. }. |
1544
|
|
|
|
|
|
|
qq{Please investigate.\n\n}. |
1545
|
|
|
|
|
|
|
$self->as_string, |
1546
|
|
|
|
|
|
|
$CPAN::META->instance( |
1547
|
|
|
|
|
|
|
'CPAN::Author', |
1548
|
|
|
|
|
|
|
$self->cpan_userid |
1549
|
|
|
|
|
|
|
)->as_string); |
1550
|
|
|
|
|
|
|
|
1551
|
0
|
|
|
|
|
0
|
my $wrap = qq{I\'d recommend removing $file. Its |
1552
|
|
|
|
|
|
|
checksum is incorrect. Maybe you have configured your 'urllist' with |
1553
|
|
|
|
|
|
|
a bad URL. Please check this array with 'o conf urllist', and |
1554
|
|
|
|
|
|
|
retry.}; |
1555
|
|
|
|
|
|
|
|
1556
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie(Text::Wrap::wrap("","",$wrap)); |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
# former versions just returned here but this seems a |
1559
|
|
|
|
|
|
|
# serious threat that deserves a die |
1560
|
|
|
|
|
|
|
|
1561
|
|
|
|
|
|
|
# $CPAN::Frontend->myprint("\n\n"); |
1562
|
|
|
|
|
|
|
# sleep 3; |
1563
|
|
|
|
|
|
|
# return; |
1564
|
|
|
|
|
|
|
} |
1565
|
|
|
|
|
|
|
# close $fh if fileno($fh); |
1566
|
|
|
|
|
|
|
} else { |
1567
|
0
|
0
|
|
|
|
0
|
return if $sloppy; |
1568
|
0
|
0
|
|
|
|
0
|
unless ($self->{CHECKSUM_STATUS}) { |
1569
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(qq{ |
1570
|
|
|
|
|
|
|
Warning: No checksum for $basename in $chk_file. |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
The cause for this may be that the file is very new and the checksum |
1573
|
|
|
|
|
|
|
has not yet been calculated, but it may also be that something is |
1574
|
|
|
|
|
|
|
going awry right now. |
1575
|
|
|
|
|
|
|
}); |
1576
|
0
|
|
|
|
|
0
|
my $answer = CPAN::Shell::colorable_makemaker_prompt("Proceed?", "yes"); |
1577
|
0
|
0
|
|
|
|
0
|
$answer =~ /^\s*y/i or $CPAN::Frontend->mydie("Aborted.\n"); |
1578
|
|
|
|
|
|
|
} |
1579
|
0
|
|
|
|
|
0
|
$self->{CHECKSUM_STATUS} = "NIL -- distro not in CHECKSUMS file"; |
1580
|
0
|
|
|
|
|
0
|
return; |
1581
|
|
|
|
|
|
|
} |
1582
|
|
|
|
|
|
|
} |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::eq_CHECKSUM ; |
1585
|
|
|
|
|
|
|
sub eq_CHECKSUM { |
1586
|
0
|
|
|
0
|
0
|
0
|
my($self,$fh,$expect) = @_; |
1587
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst("Digest::SHA")) { |
1588
|
0
|
|
|
|
|
0
|
my $dg = Digest::SHA->new(256); |
1589
|
0
|
|
|
|
|
0
|
my($data); |
1590
|
0
|
|
|
|
|
0
|
while (read($fh, $data, 4096)) { |
1591
|
0
|
|
|
|
|
0
|
$dg->add($data); |
1592
|
|
|
|
|
|
|
} |
1593
|
0
|
|
|
|
|
0
|
my $hexdigest = $dg->hexdigest; |
1594
|
|
|
|
|
|
|
# warn "fh[$fh] hex[$hexdigest] aexp[$expectMD5]"; |
1595
|
0
|
|
|
|
|
0
|
return $hexdigest eq $expect; |
1596
|
|
|
|
|
|
|
} |
1597
|
0
|
|
|
|
|
0
|
return 1; |
1598
|
|
|
|
|
|
|
} |
1599
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::force ; |
1601
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
# Both CPAN::Modules and CPAN::Distributions know if "force" is in |
1603
|
|
|
|
|
|
|
# effect by autoinspection, not by inspecting a global variable. One |
1604
|
|
|
|
|
|
|
# of the reason why this was chosen to work that way was the treatment |
1605
|
|
|
|
|
|
|
# of dependencies. They should not automatically inherit the force |
1606
|
|
|
|
|
|
|
# status. But this has the downside that ^C and die() will return to |
1607
|
|
|
|
|
|
|
# the prompt but will not be able to reset the force_update |
1608
|
|
|
|
|
|
|
# attributes. We try to correct for it currently in the read_metadata |
1609
|
|
|
|
|
|
|
# routine, and immediately before we check for a Signal. I hope this |
1610
|
|
|
|
|
|
|
# works out in one of v1.57_53ff |
1611
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
# "Force get forgets previous error conditions" |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::fforce ; |
1615
|
|
|
|
|
|
|
sub fforce { |
1616
|
0
|
|
|
0
|
0
|
0
|
my($self, $method) = @_; |
1617
|
0
|
|
|
|
|
0
|
$self->force($method,1); |
1618
|
|
|
|
|
|
|
} |
1619
|
|
|
|
|
|
|
|
1620
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::force ; |
1621
|
|
|
|
|
|
|
sub force { |
1622
|
0
|
|
|
0
|
0
|
0
|
my($self, $method,$fforce) = @_; |
1623
|
0
|
|
|
|
|
0
|
my %phase_map = ( |
1624
|
|
|
|
|
|
|
get => [ |
1625
|
|
|
|
|
|
|
"unwrapped", |
1626
|
|
|
|
|
|
|
"build_dir", |
1627
|
|
|
|
|
|
|
"archived", |
1628
|
|
|
|
|
|
|
"localfile", |
1629
|
|
|
|
|
|
|
"CHECKSUM_STATUS", |
1630
|
|
|
|
|
|
|
"signature_verify", |
1631
|
|
|
|
|
|
|
"prefs", |
1632
|
|
|
|
|
|
|
"prefs_file", |
1633
|
|
|
|
|
|
|
"prefs_file_doc", |
1634
|
|
|
|
|
|
|
], |
1635
|
|
|
|
|
|
|
make => [ |
1636
|
|
|
|
|
|
|
"writemakefile", |
1637
|
|
|
|
|
|
|
"make", |
1638
|
|
|
|
|
|
|
"modulebuild", |
1639
|
|
|
|
|
|
|
"prereq_pm", |
1640
|
|
|
|
|
|
|
], |
1641
|
|
|
|
|
|
|
test => [ |
1642
|
|
|
|
|
|
|
"badtestcnt", |
1643
|
|
|
|
|
|
|
"make_test", |
1644
|
|
|
|
|
|
|
], |
1645
|
|
|
|
|
|
|
install => [ |
1646
|
|
|
|
|
|
|
"install", |
1647
|
|
|
|
|
|
|
], |
1648
|
|
|
|
|
|
|
unknown => [ |
1649
|
|
|
|
|
|
|
"reqtype", |
1650
|
|
|
|
|
|
|
"yaml_content", |
1651
|
|
|
|
|
|
|
], |
1652
|
|
|
|
|
|
|
); |
1653
|
0
|
|
|
|
|
0
|
my $methodmatch = 0; |
1654
|
0
|
|
|
|
|
0
|
my $ldebug = 0; |
1655
|
0
|
|
|
|
|
0
|
PHASE: for my $phase (qw(unknown get make test install)) { # order matters |
1656
|
0
|
0
|
0
|
|
|
0
|
$methodmatch = 1 if $fforce || $phase eq $method; |
1657
|
0
|
0
|
|
|
|
0
|
next unless $methodmatch; |
1658
|
0
|
|
|
|
|
0
|
ATTRIBUTE: for my $att (@{$phase_map{$phase}}) { |
|
0
|
|
|
|
|
0
|
|
1659
|
0
|
0
|
|
|
|
0
|
if ($phase eq "get") { |
|
|
0
|
|
|
|
|
|
1660
|
0
|
0
|
0
|
|
|
0
|
if (substr($self->id,-1,1) eq "." |
1661
|
|
|
|
|
|
|
&& $att =~ /(unwrapped|build_dir|archived)/ ) { |
1662
|
|
|
|
|
|
|
# cannot be undone for local distros |
1663
|
0
|
|
|
|
|
0
|
next ATTRIBUTE; |
1664
|
|
|
|
|
|
|
} |
1665
|
0
|
0
|
0
|
|
|
0
|
if ($att eq "build_dir" |
|
|
|
0
|
|
|
|
|
1666
|
|
|
|
|
|
|
&& $self->{build_dir} |
1667
|
|
|
|
|
|
|
&& $CPAN::META->{is_tested} |
1668
|
|
|
|
|
|
|
) { |
1669
|
0
|
|
|
|
|
0
|
delete $CPAN::META->{is_tested}{$self->{build_dir}}; |
1670
|
|
|
|
|
|
|
} |
1671
|
|
|
|
|
|
|
} elsif ($phase eq "test") { |
1672
|
0
|
0
|
0
|
|
|
0
|
if ($att eq "make_test" |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1673
|
|
|
|
|
|
|
&& $self->{make_test} |
1674
|
|
|
|
|
|
|
&& $self->{make_test}{COMMANDID} |
1675
|
|
|
|
|
|
|
&& $self->{make_test}{COMMANDID} == $CPAN::CurrentCommandId |
1676
|
|
|
|
|
|
|
) { |
1677
|
|
|
|
|
|
|
# endless loop too likely |
1678
|
0
|
|
|
|
|
0
|
next ATTRIBUTE; |
1679
|
|
|
|
|
|
|
} |
1680
|
|
|
|
|
|
|
} |
1681
|
0
|
|
|
|
|
0
|
delete $self->{$att}; |
1682
|
0
|
0
|
0
|
|
|
0
|
if ($ldebug || $CPAN::DEBUG) { |
1683
|
|
|
|
|
|
|
# local $CPAN::DEBUG = 16; # Distribution |
1684
|
0
|
|
|
|
|
0
|
CPAN->debug(sprintf "id[%s]phase[%s]att[%s]", $self->id, $phase, $att); |
1685
|
|
|
|
|
|
|
} |
1686
|
|
|
|
|
|
|
} |
1687
|
|
|
|
|
|
|
} |
1688
|
0
|
0
|
0
|
|
|
0
|
if ($method && $method =~ /make|test|install/) { |
1689
|
0
|
|
|
|
|
0
|
$self->{force_update} = 1; # name should probably have been force_install |
1690
|
|
|
|
|
|
|
} |
1691
|
|
|
|
|
|
|
} |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::notest ; |
1694
|
|
|
|
|
|
|
sub notest { |
1695
|
0
|
|
|
0
|
0
|
0
|
my($self, $method) = @_; |
1696
|
|
|
|
|
|
|
# $CPAN::Frontend->mywarn("XDEBUG: set notest for $self $method"); |
1697
|
0
|
|
|
|
|
0
|
$self->{"notest"}++; # name should probably have been force_install |
1698
|
|
|
|
|
|
|
} |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::unnotest ; |
1701
|
|
|
|
|
|
|
sub unnotest { |
1702
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
1703
|
|
|
|
|
|
|
# warn "XDEBUG: deleting notest"; |
1704
|
0
|
|
|
|
|
0
|
delete $self->{notest}; |
1705
|
|
|
|
|
|
|
} |
1706
|
|
|
|
|
|
|
|
1707
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::unforce ; |
1708
|
|
|
|
|
|
|
sub unforce { |
1709
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
1710
|
0
|
|
|
|
|
0
|
delete $self->{force_update}; |
1711
|
|
|
|
|
|
|
} |
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::isa_perl ; |
1714
|
|
|
|
|
|
|
sub isa_perl { |
1715
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
1716
|
0
|
|
|
|
|
0
|
my $file = File::Basename::basename($self->id); |
1717
|
0
|
0
|
0
|
|
|
0
|
if ($file =~ m{ ^ perl |
|
|
0
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
-? |
1719
|
|
|
|
|
|
|
(5) |
1720
|
|
|
|
|
|
|
([._-]) |
1721
|
|
|
|
|
|
|
( |
1722
|
|
|
|
|
|
|
\d{3}(_[0-4][0-9])? |
1723
|
|
|
|
|
|
|
| |
1724
|
|
|
|
|
|
|
\d+\.\d+ |
1725
|
|
|
|
|
|
|
) |
1726
|
|
|
|
|
|
|
\.tar[._-](?:gz|bz2) |
1727
|
|
|
|
|
|
|
(?!\n)\Z |
1728
|
|
|
|
|
|
|
}xs) { |
1729
|
0
|
|
|
|
|
0
|
return "$1.$3"; |
1730
|
|
|
|
|
|
|
} elsif ($self->cpan_comment |
1731
|
|
|
|
|
|
|
&& |
1732
|
|
|
|
|
|
|
$self->cpan_comment =~ /isa_perl\(.+?\)/) { |
1733
|
0
|
|
|
|
|
0
|
return $1; |
1734
|
|
|
|
|
|
|
} |
1735
|
|
|
|
|
|
|
} |
1736
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::perl ; |
1739
|
|
|
|
|
|
|
sub perl { |
1740
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
1741
|
0
|
0
|
|
|
|
0
|
if (! $self) { |
1742
|
12
|
|
|
12
|
|
117
|
use Carp qw(carp); |
|
12
|
|
|
|
|
19
|
|
|
12
|
|
|
|
|
148977
|
|
1743
|
0
|
|
|
|
|
0
|
carp __PACKAGE__ . "::perl was called without parameters."; |
1744
|
|
|
|
|
|
|
} |
1745
|
0
|
|
|
|
|
0
|
return CPAN::HandleConfig->safe_quote($CPAN::Perl); |
1746
|
|
|
|
|
|
|
} |
1747
|
|
|
|
|
|
|
|
1748
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::shortcut_prepare ; |
1749
|
|
|
|
|
|
|
# return values: undef means don't shortcut; 0 means shortcut as fail; |
1750
|
|
|
|
|
|
|
# and 1 means shortcut as success |
1751
|
|
|
|
|
|
|
|
1752
|
|
|
|
|
|
|
sub shortcut_prepare { |
1753
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
1754
|
|
|
|
|
|
|
|
1755
|
0
|
0
|
|
|
|
0
|
$self->debug("checking archive type[$self->{ID}]") if $CPAN::DEBUG; |
1756
|
0
|
0
|
0
|
|
|
0
|
if (!$self->{archived} || $self->{archived} eq "NO") { |
1757
|
0
|
|
|
|
|
0
|
return $self->goodbye("Is neither a tar nor a zip archive."); |
1758
|
|
|
|
|
|
|
} |
1759
|
|
|
|
|
|
|
|
1760
|
0
|
0
|
|
|
|
0
|
$self->debug("checking unwrapping[$self->{ID}]") if $CPAN::DEBUG; |
1761
|
0
|
0
|
0
|
|
|
0
|
if (!$self->{unwrapped} |
|
|
0
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
|| ( |
1763
|
|
|
|
|
|
|
UNIVERSAL::can($self->{unwrapped},"failed") ? |
1764
|
|
|
|
|
|
|
$self->{unwrapped}->failed : |
1765
|
|
|
|
|
|
|
$self->{unwrapped} =~ /^NO/ |
1766
|
|
|
|
|
|
|
)) { |
1767
|
0
|
|
|
|
|
0
|
return $self->goodbye("Had problems unarchiving. Please build manually"); |
1768
|
|
|
|
|
|
|
} |
1769
|
|
|
|
|
|
|
|
1770
|
0
|
0
|
|
|
|
0
|
$self->debug("checking signature[$self->{ID}]") if $CPAN::DEBUG; |
1771
|
0
|
0
|
0
|
|
|
0
|
if ( ! $self->{force_update} |
|
|
0
|
0
|
|
|
|
|
1772
|
|
|
|
|
|
|
&& exists $self->{signature_verify} |
1773
|
|
|
|
|
|
|
&& ( |
1774
|
|
|
|
|
|
|
UNIVERSAL::can($self->{signature_verify},"failed") ? |
1775
|
|
|
|
|
|
|
$self->{signature_verify}->failed : |
1776
|
|
|
|
|
|
|
$self->{signature_verify} =~ /^NO/ |
1777
|
|
|
|
|
|
|
) |
1778
|
|
|
|
|
|
|
) { |
1779
|
0
|
|
|
|
|
0
|
return $self->goodbye("Did not pass the signature test."); |
1780
|
|
|
|
|
|
|
} |
1781
|
|
|
|
|
|
|
|
1782
|
0
|
0
|
|
|
|
0
|
$self->debug("checking writemakefile[$self->{ID}]") if $CPAN::DEBUG; |
1783
|
0
|
0
|
|
|
|
0
|
if ($self->{writemakefile}) { |
1784
|
0
|
0
|
|
|
|
0
|
if ( |
|
|
0
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
UNIVERSAL::can($self->{writemakefile},"failed") ? |
1786
|
|
|
|
|
|
|
$self->{writemakefile}->failed : |
1787
|
|
|
|
|
|
|
$self->{writemakefile} =~ /^NO/ |
1788
|
|
|
|
|
|
|
) { |
1789
|
|
|
|
|
|
|
# XXX maybe a retry would be in order? |
1790
|
|
|
|
|
|
|
my $err = UNIVERSAL::can($self->{writemakefile},"text") ? |
1791
|
|
|
|
|
|
|
$self->{writemakefile}->text : |
1792
|
0
|
0
|
|
|
|
0
|
$self->{writemakefile}; |
1793
|
0
|
|
|
|
|
0
|
$err =~ s/^NO\s*(--\s+)?//; |
1794
|
0
|
|
0
|
|
|
0
|
$err ||= "Had some problem writing Makefile"; |
1795
|
0
|
|
|
|
|
0
|
$err .= ", not re-running"; |
1796
|
0
|
|
|
|
|
0
|
return $self->goodbye($err); |
1797
|
|
|
|
|
|
|
} else { |
1798
|
0
|
|
|
|
|
0
|
return $self->success("Has already been prepared"); |
1799
|
|
|
|
|
|
|
} |
1800
|
|
|
|
|
|
|
} |
1801
|
|
|
|
|
|
|
|
1802
|
0
|
0
|
|
|
|
0
|
$self->debug("checking configure_requires_later[$self->{ID}]") if $CPAN::DEBUG; |
1803
|
0
|
0
|
|
|
|
0
|
if( my $later = $self->{configure_requires_later} ) { # see also undelay |
1804
|
0
|
|
|
|
|
0
|
return $self->goodbye($later); |
1805
|
|
|
|
|
|
|
} |
1806
|
|
|
|
|
|
|
|
1807
|
0
|
|
|
|
|
0
|
return undef; # no shortcut |
1808
|
|
|
|
|
|
|
} |
1809
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
sub prepare { |
1811
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
1812
|
|
|
|
|
|
|
|
1813
|
0
|
0
|
|
|
|
0
|
$self->get |
1814
|
|
|
|
|
|
|
or return; |
1815
|
|
|
|
|
|
|
|
1816
|
0
|
0
|
|
|
|
0
|
if ( defined( my $sc = $self->shortcut_prepare) ) { |
1817
|
0
|
|
|
|
|
0
|
return $sc; |
1818
|
|
|
|
|
|
|
} |
1819
|
|
|
|
|
|
|
|
1820
|
|
|
|
|
|
|
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) |
1821
|
|
|
|
|
|
|
? $ENV{PERL5LIB} |
1822
|
0
|
0
|
0
|
|
|
0
|
: ($ENV{PERLLIB} || ""); |
1823
|
0
|
0
|
|
|
|
0
|
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; |
1824
|
0
|
|
|
|
|
0
|
$CPAN::META->set_perl5lib; |
1825
|
0
|
|
|
|
|
0
|
local $ENV{MAKEFLAGS}; # protect us from outer make calls |
1826
|
|
|
|
|
|
|
|
1827
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Signal) { |
1828
|
0
|
|
|
|
|
0
|
delete $self->{force_update}; |
1829
|
0
|
|
|
|
|
0
|
return; |
1830
|
|
|
|
|
|
|
} |
1831
|
|
|
|
|
|
|
|
1832
|
0
|
0
|
|
|
|
0
|
my $builddir = $self->dir or |
1833
|
|
|
|
|
|
|
$CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n"); |
1834
|
|
|
|
|
|
|
|
1835
|
0
|
0
|
|
|
|
0
|
unless (chdir $builddir) { |
1836
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!"); |
1837
|
0
|
|
|
|
|
0
|
return; |
1838
|
|
|
|
|
|
|
} |
1839
|
|
|
|
|
|
|
|
1840
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Signal) { |
1841
|
0
|
|
|
|
|
0
|
delete $self->{force_update}; |
1842
|
0
|
|
|
|
|
0
|
return; |
1843
|
|
|
|
|
|
|
} |
1844
|
|
|
|
|
|
|
|
1845
|
0
|
0
|
|
|
|
0
|
$self->debug("Changed directory to $builddir") if $CPAN::DEBUG; |
1846
|
|
|
|
|
|
|
|
1847
|
0
|
|
0
|
|
|
0
|
local $ENV{PERL_AUTOINSTALL} = $ENV{PERL_AUTOINSTALL} || ''; |
1848
|
0
|
|
0
|
|
|
0
|
local $ENV{PERL_EXTUTILS_AUTOINSTALL} = $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''; |
1849
|
0
|
0
|
|
|
|
0
|
$self->choose_MM_or_MB |
1850
|
|
|
|
|
|
|
or return; |
1851
|
|
|
|
|
|
|
|
1852
|
|
|
|
|
|
|
my $configurator = $self->{configure} ? "Configure" |
1853
|
0
|
0
|
|
|
|
0
|
: $self->{modulebuild} ? "Build.PL" |
|
|
0
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
: "Makefile.PL"; |
1855
|
|
|
|
|
|
|
|
1856
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint("Configuring ".$self->id." with $configurator\n"); |
1857
|
|
|
|
|
|
|
|
1858
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Config->{prerequisites_policy} eq "follow") { |
1859
|
0
|
|
0
|
|
|
0
|
$ENV{PERL_AUTOINSTALL} ||= "--defaultdeps"; |
1860
|
0
|
|
0
|
|
|
0
|
$ENV{PERL_EXTUTILS_AUTOINSTALL} ||= "--defaultdeps"; |
1861
|
|
|
|
|
|
|
} |
1862
|
|
|
|
|
|
|
|
1863
|
0
|
|
|
|
|
0
|
my $system; |
1864
|
|
|
|
|
|
|
my $pl_commandline; |
1865
|
0
|
0
|
|
|
|
0
|
if ($self->prefs->{pl}) { |
1866
|
0
|
|
|
|
|
0
|
$pl_commandline = $self->prefs->{pl}{commandline}; |
1867
|
|
|
|
|
|
|
} |
1868
|
0
|
0
|
|
|
|
0
|
local $ENV{PERL} = defined $ENV{PERL}? $ENV{PERL} : $^X; |
1869
|
0
|
|
0
|
|
|
0
|
local $ENV{PERL5_CPAN_IS_EXECUTING} = $ENV{PERL5_CPAN_IS_EXECUTING} || ''; |
1870
|
0
|
0
|
|
|
|
0
|
local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default}; |
1871
|
0
|
0
|
|
|
|
0
|
local $ENV{NONINTERACTIVE_TESTING} = 1 if $CPAN::Config->{use_prompt_default}; |
1872
|
0
|
0
|
|
|
|
0
|
if ($pl_commandline) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1873
|
0
|
|
|
|
|
0
|
$system = $pl_commandline; |
1874
|
0
|
|
|
|
|
0
|
$ENV{PERL} = $^X; |
1875
|
|
|
|
|
|
|
} elsif ($self->{'configure'}) { |
1876
|
0
|
|
|
|
|
0
|
$system = $self->{'configure'}; |
1877
|
|
|
|
|
|
|
} elsif ($self->{modulebuild}) { |
1878
|
0
|
0
|
|
|
|
0
|
my($perl) = $self->perl or die "Couldn\'t find executable perl\n"; |
1879
|
0
|
|
|
|
|
0
|
my $mbuildpl_arg = $self->_make_phase_arg("pl"); |
1880
|
0
|
0
|
|
|
|
0
|
$system = sprintf("%s Build.PL%s", |
1881
|
|
|
|
|
|
|
$perl, |
1882
|
|
|
|
|
|
|
$mbuildpl_arg ? " $mbuildpl_arg" : "", |
1883
|
|
|
|
|
|
|
); |
1884
|
|
|
|
|
|
|
} else { |
1885
|
0
|
0
|
|
|
|
0
|
my($perl) = $self->perl or die "Couldn\'t find executable perl\n"; |
1886
|
0
|
|
|
|
|
0
|
my $switch = ""; |
1887
|
|
|
|
|
|
|
# This needs a handler that can be turned on or off: |
1888
|
|
|
|
|
|
|
# $switch = "-MExtUtils::MakeMaker ". |
1889
|
|
|
|
|
|
|
# "-Mops=:default,:filesys_read,:filesys_open,require,chdir" |
1890
|
|
|
|
|
|
|
# if $] > 5.00310; |
1891
|
0
|
|
|
|
|
0
|
my $makepl_arg = $self->_make_phase_arg("pl"); |
1892
|
|
|
|
|
|
|
$ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir}, |
1893
|
0
|
|
|
|
|
0
|
"Makefile.PL"); |
1894
|
0
|
0
|
|
|
|
0
|
$system = sprintf("%s%s Makefile.PL%s", |
|
|
0
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
$perl, |
1896
|
|
|
|
|
|
|
$switch ? " $switch" : "", |
1897
|
|
|
|
|
|
|
$makepl_arg ? " $makepl_arg" : "", |
1898
|
|
|
|
|
|
|
); |
1899
|
|
|
|
|
|
|
} |
1900
|
0
|
|
|
|
|
0
|
my $pl_env; |
1901
|
0
|
0
|
|
|
|
0
|
if ($self->prefs->{pl}) { |
1902
|
0
|
|
|
|
|
0
|
$pl_env = $self->prefs->{pl}{env}; |
1903
|
|
|
|
|
|
|
} |
1904
|
0
|
0
|
|
|
|
0
|
local @ENV{keys %$pl_env} = values %$pl_env if $pl_env; |
1905
|
0
|
0
|
|
|
|
0
|
if (exists $self->{writemakefile}) { |
1906
|
|
|
|
|
|
|
} else { |
1907
|
0
|
|
|
0
|
|
0
|
local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" }; |
|
0
|
|
|
|
|
0
|
|
1908
|
0
|
|
|
|
|
0
|
my($ret,$pid,$output); |
1909
|
0
|
|
|
|
|
0
|
$@ = ""; |
1910
|
0
|
|
|
|
|
0
|
my $go_via_alarm; |
1911
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Config->{inactivity_timeout}) { |
1912
|
0
|
|
|
|
|
0
|
require Config; |
1913
|
0
|
0
|
0
|
|
|
0
|
if ($Config::Config{d_alarm} |
1914
|
|
|
|
|
|
|
&& |
1915
|
|
|
|
|
|
|
$Config::Config{d_alarm} eq "define" |
1916
|
|
|
|
|
|
|
) { |
1917
|
0
|
|
|
|
|
0
|
$go_via_alarm++ |
1918
|
|
|
|
|
|
|
} else { |
1919
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Warning: you have configured the config ". |
1920
|
|
|
|
|
|
|
"variable 'inactivity_timeout' to ". |
1921
|
|
|
|
|
|
|
"'$CPAN::Config->{inactivity_timeout}'. But ". |
1922
|
|
|
|
|
|
|
"on this machine the system call 'alarm' ". |
1923
|
|
|
|
|
|
|
"isn't available. This means that we cannot ". |
1924
|
|
|
|
|
|
|
"provide the feature of intercepting long ". |
1925
|
|
|
|
|
|
|
"waiting code and will turn this feature off.\n" |
1926
|
|
|
|
|
|
|
); |
1927
|
0
|
|
|
|
|
0
|
$CPAN::Config->{inactivity_timeout} = 0; |
1928
|
|
|
|
|
|
|
} |
1929
|
|
|
|
|
|
|
} |
1930
|
0
|
0
|
|
|
|
0
|
if ($go_via_alarm) { |
1931
|
0
|
0
|
|
|
|
0
|
if ( $self->_should_report('pl') ) { |
1932
|
|
|
|
|
|
|
($output, $ret) = CPAN::Reporter::record_command( |
1933
|
|
|
|
|
|
|
$system, |
1934
|
|
|
|
|
|
|
$CPAN::Config->{inactivity_timeout}, |
1935
|
0
|
|
|
|
|
0
|
); |
1936
|
0
|
|
|
|
|
0
|
CPAN::Reporter::grade_PL( $self, $system, $output, $ret ); |
1937
|
|
|
|
|
|
|
} |
1938
|
|
|
|
|
|
|
else { |
1939
|
0
|
|
|
|
|
0
|
eval { |
1940
|
0
|
|
|
|
|
0
|
alarm $CPAN::Config->{inactivity_timeout}; |
1941
|
0
|
|
|
|
|
0
|
local $SIG{CHLD}; # = sub { wait }; |
1942
|
0
|
0
|
|
|
|
0
|
if (defined($pid = fork)) { |
1943
|
0
|
0
|
|
|
|
0
|
if ($pid) { #parent |
1944
|
|
|
|
|
|
|
# wait; |
1945
|
0
|
|
|
|
|
0
|
waitpid $pid, 0; |
1946
|
|
|
|
|
|
|
} else { #child |
1947
|
|
|
|
|
|
|
# note, this exec isn't necessary if |
1948
|
|
|
|
|
|
|
# inactivity_timeout is 0. On the Mac I'd |
1949
|
|
|
|
|
|
|
# suggest, we set it always to 0. |
1950
|
0
|
|
|
|
|
0
|
exec $system; |
1951
|
|
|
|
|
|
|
} |
1952
|
|
|
|
|
|
|
} else { |
1953
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint("Cannot fork: $!"); |
1954
|
0
|
|
|
|
|
0
|
return; |
1955
|
|
|
|
|
|
|
} |
1956
|
|
|
|
|
|
|
}; |
1957
|
0
|
|
|
|
|
0
|
alarm 0; |
1958
|
0
|
0
|
|
|
|
0
|
if ($@) { |
1959
|
0
|
|
|
|
|
0
|
kill 9, $pid; |
1960
|
0
|
|
|
|
|
0
|
waitpid $pid, 0; |
1961
|
0
|
|
|
|
|
0
|
my $err = "$@"; |
1962
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint($err); |
1963
|
0
|
|
|
|
|
0
|
$self->{writemakefile} = CPAN::Distrostatus->new("NO $err"); |
1964
|
0
|
|
|
|
|
0
|
$@ = ""; |
1965
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
1966
|
0
|
|
|
|
|
0
|
return $self->goodbye("$system -- TIMED OUT"); |
1967
|
|
|
|
|
|
|
} |
1968
|
|
|
|
|
|
|
} |
1969
|
|
|
|
|
|
|
} else { |
1970
|
0
|
0
|
|
|
|
0
|
if (my $expect_model = $self->_prefs_with_expect("pl")) { |
|
|
0
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
# XXX probably want to check _should_report here and warn |
1972
|
|
|
|
|
|
|
# about not being able to use CPAN::Reporter with expect |
1973
|
0
|
|
|
|
|
0
|
$ret = $self->_run_via_expect($system,'writemakefile',$expect_model); |
1974
|
0
|
0
|
0
|
|
|
0
|
if (! defined $ret |
|
|
|
0
|
|
|
|
|
1975
|
|
|
|
|
|
|
&& $self->{writemakefile} |
1976
|
|
|
|
|
|
|
&& $self->{writemakefile}->failed) { |
1977
|
|
|
|
|
|
|
# timeout |
1978
|
0
|
|
|
|
|
0
|
return; |
1979
|
|
|
|
|
|
|
} |
1980
|
|
|
|
|
|
|
} |
1981
|
|
|
|
|
|
|
elsif ( $self->_should_report('pl') ) { |
1982
|
0
|
|
|
|
|
0
|
($output, $ret) = CPAN::Reporter::record_command($system); |
1983
|
0
|
|
|
|
|
0
|
CPAN::Reporter::grade_PL( $self, $system, $output, $ret ); |
1984
|
|
|
|
|
|
|
} |
1985
|
|
|
|
|
|
|
else { |
1986
|
0
|
|
|
|
|
0
|
$ret = system($system); |
1987
|
|
|
|
|
|
|
} |
1988
|
0
|
0
|
|
|
|
0
|
if ($ret != 0) { |
1989
|
0
|
|
|
|
|
0
|
$self->{writemakefile} = CPAN::Distrostatus |
1990
|
|
|
|
|
|
|
->new("NO '$system' returned status $ret"); |
1991
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Warning: No success on command[$system]\n"); |
1992
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
1993
|
0
|
|
|
|
|
0
|
return $self->goodbye("$system -- NOT OK"); |
1994
|
|
|
|
|
|
|
} |
1995
|
|
|
|
|
|
|
} |
1996
|
0
|
0
|
0
|
|
|
0
|
if (-f "Makefile" || -f "Build" || ($^O eq 'VMS' && (-f 'descrip.mms' || -f 'Build.com'))) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1997
|
0
|
|
|
|
|
0
|
$self->{writemakefile} = CPAN::Distrostatus->new("YES"); |
1998
|
0
|
|
|
|
|
0
|
delete $self->{make_clean}; # if cleaned before, enable next |
1999
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
2000
|
0
|
|
|
|
|
0
|
return $self->success("$system -- OK"); |
2001
|
|
|
|
|
|
|
} else { |
2002
|
0
|
0
|
|
|
|
0
|
my $makefile = $self->{modulebuild} ? "Build" : "Makefile"; |
2003
|
0
|
|
|
|
|
0
|
my $why = "No '$makefile' created"; |
2004
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn($why); |
2005
|
0
|
|
|
|
|
0
|
$self->{writemakefile} = CPAN::Distrostatus |
2006
|
|
|
|
|
|
|
->new(qq{NO -- $why\n}); |
2007
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
2008
|
0
|
|
|
|
|
0
|
return $self->goodbye("$system -- NOT OK"); |
2009
|
|
|
|
|
|
|
} |
2010
|
|
|
|
|
|
|
} |
2011
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
2012
|
0
|
|
|
|
|
0
|
return 1; # success |
2013
|
|
|
|
|
|
|
} |
2014
|
|
|
|
|
|
|
|
2015
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::shortcut_make ; |
2016
|
|
|
|
|
|
|
# return values: undef means don't shortcut; 0 means shortcut as fail; |
2017
|
|
|
|
|
|
|
# and 1 means shortcut as success |
2018
|
|
|
|
|
|
|
sub shortcut_make { |
2019
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
2020
|
|
|
|
|
|
|
|
2021
|
0
|
0
|
|
|
|
0
|
$self->debug("checking make/build results[$self->{ID}]") if $CPAN::DEBUG; |
2022
|
0
|
0
|
|
|
|
0
|
if (defined $self->{make}) { |
2023
|
0
|
0
|
|
|
|
0
|
if (UNIVERSAL::can($self->{make},"failed") ? |
|
|
0
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
$self->{make}->failed : |
2025
|
|
|
|
|
|
|
$self->{make} =~ /^NO/ |
2026
|
|
|
|
|
|
|
) { |
2027
|
0
|
0
|
|
|
|
0
|
if ($self->{force_update}) { |
2028
|
|
|
|
|
|
|
# Trying an already failed 'make' (unless somebody else blocks) |
2029
|
0
|
|
|
|
|
0
|
return undef; # no shortcut |
2030
|
|
|
|
|
|
|
} else { |
2031
|
|
|
|
|
|
|
# introduced for turning recursion detection into a distrostatus |
2032
|
|
|
|
|
|
|
my $error = length $self->{make}>3 |
2033
|
0
|
0
|
|
|
|
0
|
? substr($self->{make},3) : "Unknown error"; |
2034
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
2035
|
0
|
|
|
|
|
0
|
return $self->goodbye("Could not make: $error\n"); |
2036
|
|
|
|
|
|
|
} |
2037
|
|
|
|
|
|
|
} else { |
2038
|
0
|
|
|
|
|
0
|
return $self->success("Has already been made") |
2039
|
|
|
|
|
|
|
} |
2040
|
|
|
|
|
|
|
} |
2041
|
0
|
|
|
|
|
0
|
return undef; # no shortcut |
2042
|
|
|
|
|
|
|
} |
2043
|
|
|
|
|
|
|
|
2044
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::make ; |
2045
|
|
|
|
|
|
|
sub make { |
2046
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
2047
|
|
|
|
|
|
|
|
2048
|
0
|
|
|
|
|
0
|
$self->pre_make(); |
2049
|
|
|
|
|
|
|
|
2050
|
0
|
0
|
|
|
|
0
|
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG; |
2051
|
0
|
0
|
|
|
|
0
|
if (my $goto = $self->prefs->{goto}) { |
2052
|
0
|
|
|
|
|
0
|
return $self->goto($goto); |
2053
|
|
|
|
|
|
|
} |
2054
|
|
|
|
|
|
|
# Emergency brake if they said install Pippi and get newest perl |
2055
|
|
|
|
|
|
|
|
2056
|
|
|
|
|
|
|
# XXX Would this make more sense in shortcut_prepare, since |
2057
|
|
|
|
|
|
|
# that doesn't make sense on a perl dist either? Broader |
2058
|
|
|
|
|
|
|
# question: what is the purpose of suggesting force install |
2059
|
|
|
|
|
|
|
# on a perl distribution? That seems unlikely to result in |
2060
|
|
|
|
|
|
|
# such a dependency being satisfied, even if the perl is |
2061
|
|
|
|
|
|
|
# successfully installed. This situation is tantamount to |
2062
|
|
|
|
|
|
|
# a prereq on a version of perl greater than the current one |
2063
|
|
|
|
|
|
|
# so I think we should just abort. -- xdg, 2012-04-06 |
2064
|
0
|
0
|
|
|
|
0
|
if ($self->isa_perl) { |
2065
|
0
|
0
|
0
|
|
|
0
|
if ( |
2066
|
|
|
|
|
|
|
$self->called_for ne $self->id && |
2067
|
|
|
|
|
|
|
! $self->{force_update} |
2068
|
|
|
|
|
|
|
) { |
2069
|
|
|
|
|
|
|
# if we die here, we break bundles |
2070
|
0
|
|
|
|
|
0
|
$CPAN::Frontend |
2071
|
|
|
|
|
|
|
->mywarn(sprintf( |
2072
|
|
|
|
|
|
|
qq{The most recent version "%s" of the module "%s" |
2073
|
|
|
|
|
|
|
is part of the perl-%s distribution. To install that, you need to run |
2074
|
|
|
|
|
|
|
force install %s --or-- |
2075
|
|
|
|
|
|
|
install %s |
2076
|
|
|
|
|
|
|
}, |
2077
|
|
|
|
|
|
|
$CPAN::META->instance( |
2078
|
|
|
|
|
|
|
'CPAN::Module', |
2079
|
|
|
|
|
|
|
$self->called_for |
2080
|
|
|
|
|
|
|
)->cpan_version, |
2081
|
|
|
|
|
|
|
$self->called_for, |
2082
|
|
|
|
|
|
|
$self->isa_perl, |
2083
|
|
|
|
|
|
|
$self->called_for, |
2084
|
|
|
|
|
|
|
$self->id, |
2085
|
|
|
|
|
|
|
)); |
2086
|
0
|
|
|
|
|
0
|
$self->{make} = CPAN::Distrostatus->new("NO isa perl"); |
2087
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(1); |
2088
|
0
|
|
|
|
|
0
|
return; |
2089
|
|
|
|
|
|
|
} |
2090
|
|
|
|
|
|
|
} |
2091
|
|
|
|
|
|
|
|
2092
|
|
|
|
|
|
|
$self->prepare |
2093
|
0
|
0
|
|
|
|
0
|
or return; |
2094
|
|
|
|
|
|
|
|
2095
|
0
|
0
|
|
|
|
0
|
if ( defined( my $sc = $self->shortcut_make) ) { |
2096
|
0
|
|
|
|
|
0
|
return $sc; |
2097
|
|
|
|
|
|
|
} |
2098
|
|
|
|
|
|
|
|
2099
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Signal) { |
2100
|
0
|
|
|
|
|
0
|
delete $self->{force_update}; |
2101
|
0
|
|
|
|
|
0
|
return; |
2102
|
|
|
|
|
|
|
} |
2103
|
|
|
|
|
|
|
|
2104
|
0
|
0
|
|
|
|
0
|
my $builddir = $self->dir or |
2105
|
|
|
|
|
|
|
$CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n"); |
2106
|
|
|
|
|
|
|
|
2107
|
0
|
0
|
|
|
|
0
|
unless (chdir $builddir) { |
2108
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!"); |
2109
|
0
|
|
|
|
|
0
|
return; |
2110
|
|
|
|
|
|
|
} |
2111
|
|
|
|
|
|
|
|
2112
|
0
|
0
|
|
|
|
0
|
my $make = $self->{modulebuild} ? "Build" : "make"; |
2113
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(sprintf "Running %s for %s\n", $make, $self->id); |
2114
|
|
|
|
|
|
|
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) |
2115
|
|
|
|
|
|
|
? $ENV{PERL5LIB} |
2116
|
0
|
0
|
0
|
|
|
0
|
: ($ENV{PERLLIB} || ""); |
2117
|
0
|
0
|
|
|
|
0
|
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; |
2118
|
0
|
|
|
|
|
0
|
$CPAN::META->set_perl5lib; |
2119
|
0
|
|
|
|
|
0
|
local $ENV{MAKEFLAGS}; # protect us from outer make calls |
2120
|
|
|
|
|
|
|
|
2121
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Signal) { |
2122
|
0
|
|
|
|
|
0
|
delete $self->{force_update}; |
2123
|
0
|
|
|
|
|
0
|
return; |
2124
|
|
|
|
|
|
|
} |
2125
|
|
|
|
|
|
|
|
2126
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MacOS') { |
2127
|
0
|
|
|
|
|
0
|
Mac::BuildTools::make($self); |
2128
|
0
|
|
|
|
|
0
|
return; |
2129
|
|
|
|
|
|
|
} |
2130
|
|
|
|
|
|
|
|
2131
|
0
|
|
|
|
|
0
|
my %env; |
2132
|
0
|
|
|
|
|
0
|
while (my($k,$v) = each %ENV) { |
2133
|
0
|
0
|
|
|
|
0
|
next if defined $v; |
2134
|
0
|
|
|
|
|
0
|
$env{$k} = ''; |
2135
|
|
|
|
|
|
|
} |
2136
|
0
|
|
|
|
|
0
|
local @ENV{keys %env} = values %env; |
2137
|
0
|
|
|
|
|
0
|
my $satisfied = eval { $self->satisfy_requires }; |
|
0
|
|
|
|
|
0
|
|
2138
|
0
|
0
|
|
|
|
0
|
return $self->goodbye($@) if $@; |
2139
|
0
|
0
|
|
|
|
0
|
return unless $satisfied ; |
2140
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Signal) { |
2141
|
0
|
|
|
|
|
0
|
delete $self->{force_update}; |
2142
|
0
|
|
|
|
|
0
|
return; |
2143
|
|
|
|
|
|
|
} |
2144
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
# need to chdir again, because $self->satisfy_requires might change the directory |
2146
|
0
|
0
|
|
|
|
0
|
unless (chdir $builddir) { |
2147
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!"); |
2148
|
0
|
|
|
|
|
0
|
return; |
2149
|
|
|
|
|
|
|
} |
2150
|
|
|
|
|
|
|
|
2151
|
0
|
|
|
|
|
0
|
my $system; |
2152
|
|
|
|
|
|
|
my $make_commandline; |
2153
|
0
|
0
|
|
|
|
0
|
if ($self->prefs->{make}) { |
2154
|
0
|
|
|
|
|
0
|
$make_commandline = $self->prefs->{make}{commandline}; |
2155
|
|
|
|
|
|
|
} |
2156
|
0
|
0
|
|
|
|
0
|
local $ENV{PERL} = defined $ENV{PERL}? $ENV{PERL} : $^X; |
2157
|
0
|
0
|
|
|
|
0
|
local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default}; |
2158
|
0
|
0
|
|
|
|
0
|
local $ENV{NONINTERACTIVE_TESTING} = 1 if $CPAN::Config->{use_prompt_default}; |
2159
|
0
|
0
|
|
|
|
0
|
if ($make_commandline) { |
2160
|
0
|
|
|
|
|
0
|
$system = $make_commandline; |
2161
|
0
|
|
|
|
|
0
|
$ENV{PERL} = CPAN::find_perl(); |
2162
|
|
|
|
|
|
|
} else { |
2163
|
0
|
0
|
|
|
|
0
|
if ($self->{modulebuild}) { |
2164
|
0
|
0
|
0
|
|
|
0
|
unless (-f "Build" || ($^O eq 'VMS' && -f 'Build.com')) { |
|
|
|
0
|
|
|
|
|
2165
|
0
|
|
|
|
|
0
|
my $cwd = CPAN::anycwd(); |
2166
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Alert: no Build file available for 'make $self->{id}'". |
2167
|
|
|
|
|
|
|
" in cwd[$cwd]. Danger, Will Robinson!\n"); |
2168
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(5); |
2169
|
|
|
|
|
|
|
} |
2170
|
0
|
|
|
|
|
0
|
$system = join " ", $self->_build_command(), $CPAN::Config->{mbuild_arg}; |
2171
|
|
|
|
|
|
|
} else { |
2172
|
0
|
|
|
|
|
0
|
$system = join " ", $self->_make_command(), $CPAN::Config->{make_arg}; |
2173
|
|
|
|
|
|
|
} |
2174
|
0
|
|
|
|
|
0
|
$system =~ s/\s+$//; |
2175
|
0
|
|
|
|
|
0
|
my $make_arg = $self->_make_phase_arg("make"); |
2176
|
0
|
0
|
|
|
|
0
|
$system = sprintf("%s%s", |
2177
|
|
|
|
|
|
|
$system, |
2178
|
|
|
|
|
|
|
$make_arg ? " $make_arg" : "", |
2179
|
|
|
|
|
|
|
); |
2180
|
|
|
|
|
|
|
} |
2181
|
0
|
|
|
|
|
0
|
my $make_env; |
2182
|
0
|
0
|
|
|
|
0
|
if ($self->prefs->{make}) { |
2183
|
0
|
|
|
|
|
0
|
$make_env = $self->prefs->{make}{env}; |
2184
|
|
|
|
|
|
|
} |
2185
|
0
|
0
|
|
|
|
0
|
local @ENV{keys %$make_env} = values %$make_env if $make_env; |
2186
|
0
|
|
|
|
|
0
|
my $expect_model = $self->_prefs_with_expect("make"); |
2187
|
0
|
|
|
|
|
0
|
my $want_expect = 0; |
2188
|
0
|
0
|
0
|
|
|
0
|
if ( $expect_model && @{$expect_model->{talk}} ) { |
|
0
|
|
|
|
|
0
|
|
2189
|
0
|
|
|
|
|
0
|
my $can_expect = $CPAN::META->has_inst("Expect"); |
2190
|
0
|
0
|
|
|
|
0
|
if ($can_expect) { |
2191
|
0
|
|
|
|
|
0
|
$want_expect = 1; |
2192
|
|
|
|
|
|
|
} else { |
2193
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Expect not installed, falling back to ". |
2194
|
|
|
|
|
|
|
"system()\n"); |
2195
|
|
|
|
|
|
|
} |
2196
|
|
|
|
|
|
|
} |
2197
|
0
|
|
|
|
|
0
|
my ($system_ok, $system_err); |
2198
|
0
|
0
|
|
|
|
0
|
if ($want_expect) { |
|
|
0
|
|
|
|
|
|
2199
|
|
|
|
|
|
|
# XXX probably want to check _should_report here and |
2200
|
|
|
|
|
|
|
# warn about not being able to use CPAN::Reporter with expect |
2201
|
0
|
|
|
|
|
0
|
$system_ok = $self->_run_via_expect($system,'make',$expect_model) == 0; |
2202
|
|
|
|
|
|
|
} |
2203
|
|
|
|
|
|
|
elsif ( $self->_should_report('make') ) { |
2204
|
0
|
|
|
|
|
0
|
my ($output, $ret) = CPAN::Reporter::record_command($system); |
2205
|
0
|
|
|
|
|
0
|
CPAN::Reporter::grade_make( $self, $system, $output, $ret ); |
2206
|
0
|
|
|
|
|
0
|
$system_ok = ! $ret; |
2207
|
|
|
|
|
|
|
} |
2208
|
|
|
|
|
|
|
else { |
2209
|
0
|
|
|
|
|
0
|
my $rc = system($system); |
2210
|
0
|
|
|
|
|
0
|
$system_ok = $rc == 0; |
2211
|
0
|
0
|
|
|
|
0
|
$system_err = $! if $rc == -1; |
2212
|
|
|
|
|
|
|
} |
2213
|
0
|
|
|
|
|
0
|
$self->introduce_myself; |
2214
|
0
|
0
|
|
|
|
0
|
if ( $system_ok ) { |
2215
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(" $system -- OK\n"); |
2216
|
0
|
|
|
|
|
0
|
$self->{make} = CPAN::Distrostatus->new("YES"); |
2217
|
|
|
|
|
|
|
} else { |
2218
|
0
|
|
0
|
|
|
0
|
$self->{writemakefile} ||= CPAN::Distrostatus->new("YES"); |
2219
|
0
|
|
|
|
|
0
|
$self->{make} = CPAN::Distrostatus->new("NO"); |
2220
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(" $system -- NOT OK\n"); |
2221
|
0
|
0
|
|
|
|
0
|
$CPAN::Frontend->mywarn(" $system_err\n") if defined $system_err; |
2222
|
|
|
|
|
|
|
} |
2223
|
0
|
|
|
|
|
0
|
$self->store_persistent_state; |
2224
|
|
|
|
|
|
|
|
2225
|
0
|
|
|
|
|
0
|
$self->post_make(); |
2226
|
|
|
|
|
|
|
|
2227
|
0
|
|
|
|
|
0
|
return !! $system_ok; |
2228
|
|
|
|
|
|
|
} |
2229
|
|
|
|
|
|
|
|
2230
|
|
|
|
|
|
|
# CPAN::Distribution::goodbye ; |
2231
|
|
|
|
|
|
|
sub goodbye { |
2232
|
0
|
|
|
0
|
0
|
0
|
my($self,$goodbye) = @_; |
2233
|
0
|
|
|
|
|
0
|
my $id = $self->pretty_id; |
2234
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn(" $id\n $goodbye\n"); |
2235
|
0
|
|
|
|
|
0
|
return 0; # must be explicit false, not undef |
2236
|
|
|
|
|
|
|
} |
2237
|
|
|
|
|
|
|
|
2238
|
|
|
|
|
|
|
sub success { |
2239
|
0
|
|
|
0
|
0
|
0
|
my($self,$why) = @_; |
2240
|
0
|
|
|
|
|
0
|
my $id = $self->pretty_id; |
2241
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(" $id\n $why\n"); |
2242
|
0
|
|
|
|
|
0
|
return 1; |
2243
|
|
|
|
|
|
|
} |
2244
|
|
|
|
|
|
|
|
2245
|
|
|
|
|
|
|
# CPAN::Distribution::_run_via_expect ; |
2246
|
|
|
|
|
|
|
sub _run_via_expect { |
2247
|
0
|
|
|
0
|
|
0
|
my($self,$system,$phase,$expect_model) = @_; |
2248
|
0
|
0
|
|
|
|
0
|
CPAN->debug("system[$system]expect_model[$expect_model]") if $CPAN::DEBUG; |
2249
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst("Expect")) { |
2250
|
0
|
|
|
|
|
0
|
my $expo = Expect->new; # expo Expect object; |
2251
|
0
|
|
|
|
|
0
|
$expo->spawn($system); |
2252
|
0
|
|
0
|
|
|
0
|
$expect_model->{mode} ||= "deterministic"; |
2253
|
0
|
0
|
|
|
|
0
|
if ($expect_model->{mode} eq "deterministic") { |
|
|
0
|
|
|
|
|
|
2254
|
0
|
|
|
|
|
0
|
return $self->_run_via_expect_deterministic($expo,$phase,$expect_model); |
2255
|
|
|
|
|
|
|
} elsif ($expect_model->{mode} eq "anyorder") { |
2256
|
0
|
|
|
|
|
0
|
return $self->_run_via_expect_anyorder($expo,$phase,$expect_model); |
2257
|
|
|
|
|
|
|
} else { |
2258
|
0
|
|
|
|
|
0
|
die "Panic: Illegal expect mode: $expect_model->{mode}"; |
2259
|
|
|
|
|
|
|
} |
2260
|
|
|
|
|
|
|
} else { |
2261
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Expect not installed, falling back to system()\n"); |
2262
|
0
|
|
|
|
|
0
|
return system($system); |
2263
|
|
|
|
|
|
|
} |
2264
|
|
|
|
|
|
|
} |
2265
|
|
|
|
|
|
|
|
2266
|
|
|
|
|
|
|
sub _run_via_expect_anyorder { |
2267
|
0
|
|
|
0
|
|
0
|
my($self,$expo,$phase,$expect_model) = @_; |
2268
|
0
|
|
0
|
|
|
0
|
my $timeout = $expect_model->{timeout} || 5; |
2269
|
0
|
|
|
|
|
0
|
my $reuse = $expect_model->{reuse}; |
2270
|
0
|
|
|
|
|
0
|
my @expectacopy = @{$expect_model->{talk}}; # we trash it! |
|
0
|
|
|
|
|
0
|
|
2271
|
0
|
|
|
|
|
0
|
my $but = ""; |
2272
|
0
|
|
|
|
|
0
|
my $timeout_start = time; |
2273
|
0
|
|
|
|
|
0
|
EXPECT: while () { |
2274
|
0
|
|
|
|
|
0
|
my($eof,$ran_into_timeout); |
2275
|
|
|
|
|
|
|
# XXX not up to the full power of expect. one could certainly |
2276
|
|
|
|
|
|
|
# wrap all of the talk pairs into a single expect call and on |
2277
|
|
|
|
|
|
|
# success tweak it and step ahead to the next question. The |
2278
|
|
|
|
|
|
|
# current implementation unnecessarily limits itself to a |
2279
|
|
|
|
|
|
|
# single match. |
2280
|
|
|
|
|
|
|
my @match = $expo->expect(1, |
2281
|
|
|
|
|
|
|
[ eof => sub { |
2282
|
0
|
|
|
0
|
|
0
|
$eof++; |
2283
|
|
|
|
|
|
|
} ], |
2284
|
|
|
|
|
|
|
[ timeout => sub { |
2285
|
0
|
|
|
0
|
|
0
|
$ran_into_timeout++; |
2286
|
0
|
|
|
|
|
0
|
} ], |
2287
|
|
|
|
|
|
|
-re => eval"qr{.}", |
2288
|
|
|
|
|
|
|
); |
2289
|
0
|
0
|
|
|
|
0
|
if ($match[2]) { |
2290
|
0
|
|
|
|
|
0
|
$but .= $match[2]; |
2291
|
|
|
|
|
|
|
} |
2292
|
0
|
|
|
|
|
0
|
$but .= $expo->clear_accum; |
2293
|
0
|
0
|
|
|
|
0
|
if ($eof) { |
|
|
0
|
|
|
|
|
|
2294
|
0
|
|
|
|
|
0
|
$expo->soft_close; |
2295
|
0
|
|
|
|
|
0
|
return $expo->exitstatus(); |
2296
|
|
|
|
|
|
|
} elsif ($ran_into_timeout) { |
2297
|
|
|
|
|
|
|
# warn "DEBUG: they are asking a question, but[$but]"; |
2298
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i <= $#expectacopy; $i+=2) { |
2299
|
0
|
|
|
|
|
0
|
my($next,$send) = @expectacopy[$i,$i+1]; |
2300
|
0
|
|
|
|
|
0
|
my $regex = eval "qr{$next}"; |
2301
|
|
|
|
|
|
|
# warn "DEBUG: will compare with regex[$regex]."; |
2302
|
0
|
0
|
|
|
|
0
|
if ($but =~ /$regex/) { |
2303
|
|
|
|
|
|
|
# warn "DEBUG: will send send[$send]"; |
2304
|
0
|
|
|
|
|
0
|
$expo->send($send); |
2305
|
|
|
|
|
|
|
# never allow reusing an QA pair unless they told us |
2306
|
0
|
0
|
|
|
|
0
|
splice @expectacopy, $i, 2 unless $reuse; |
2307
|
0
|
|
|
|
|
0
|
$but =~ s/(?s:^.*?)$regex//; |
2308
|
0
|
|
|
|
|
0
|
$timeout_start = time; |
2309
|
0
|
|
|
|
|
0
|
next EXPECT; |
2310
|
|
|
|
|
|
|
} |
2311
|
|
|
|
|
|
|
} |
2312
|
0
|
|
|
|
|
0
|
my $have_waited = time - $timeout_start; |
2313
|
0
|
0
|
|
|
|
0
|
if ($have_waited < $timeout) { |
2314
|
|
|
|
|
|
|
# warn "DEBUG: have_waited[$have_waited]timeout[$timeout]"; |
2315
|
0
|
|
|
|
|
0
|
next EXPECT; |
2316
|
|
|
|
|
|
|
} |
2317
|
0
|
|
|
|
|
0
|
my $why = "could not answer a question during the dialog"; |
2318
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Failing: $why\n"); |
2319
|
0
|
|
|
|
|
0
|
$self->{$phase} = |
2320
|
|
|
|
|
|
|
CPAN::Distrostatus->new("NO $why"); |
2321
|
0
|
|
|
|
|
0
|
return 0; |
2322
|
|
|
|
|
|
|
} |
2323
|
|
|
|
|
|
|
} |
2324
|
|
|
|
|
|
|
} |
2325
|
|
|
|
|
|
|
|
2326
|
|
|
|
|
|
|
sub _run_via_expect_deterministic { |
2327
|
0
|
|
|
0
|
|
0
|
my($self,$expo,$phase,$expect_model) = @_; |
2328
|
0
|
|
|
|
|
0
|
my $ran_into_timeout; |
2329
|
|
|
|
|
|
|
my $ran_into_eof; |
2330
|
0
|
|
0
|
|
|
0
|
my $timeout = $expect_model->{timeout} || 15; # currently unsettable |
2331
|
0
|
|
|
|
|
0
|
my $expecta = $expect_model->{talk}; |
2332
|
0
|
|
|
|
|
0
|
EXPECT: for (my $i = 0; $i <= $#$expecta; $i+=2) { |
2333
|
0
|
|
|
|
|
0
|
my($re,$send) = @$expecta[$i,$i+1]; |
2334
|
0
|
0
|
|
|
|
0
|
CPAN->debug("timeout[$timeout]re[$re]") if $CPAN::DEBUG; |
2335
|
0
|
|
|
|
|
0
|
my $regex = eval "qr{$re}"; |
2336
|
|
|
|
|
|
|
$expo->expect($timeout, |
2337
|
|
|
|
|
|
|
[ eof => sub { |
2338
|
0
|
|
|
0
|
|
0
|
my $but = $expo->clear_accum; |
2339
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("EOF (maybe harmless) |
2340
|
|
|
|
|
|
|
expected[$regex]\nbut[$but]\n\n"); |
2341
|
0
|
|
|
|
|
0
|
$ran_into_eof++; |
2342
|
|
|
|
|
|
|
} ], |
2343
|
|
|
|
|
|
|
[ timeout => sub { |
2344
|
0
|
|
|
0
|
|
0
|
my $but = $expo->clear_accum; |
2345
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("TIMEOUT |
2346
|
|
|
|
|
|
|
expected[$regex]\nbut[$but]\n\n"); |
2347
|
0
|
|
|
|
|
0
|
$ran_into_timeout++; |
2348
|
0
|
|
|
|
|
0
|
} ], |
2349
|
|
|
|
|
|
|
-re => $regex); |
2350
|
0
|
0
|
|
|
|
0
|
if ($ran_into_timeout) { |
|
|
0
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
# note that the caller expects 0 for success |
2352
|
0
|
|
|
|
|
0
|
$self->{$phase} = |
2353
|
|
|
|
|
|
|
CPAN::Distrostatus->new("NO timeout during expect dialog"); |
2354
|
0
|
|
|
|
|
0
|
return 0; |
2355
|
|
|
|
|
|
|
} elsif ($ran_into_eof) { |
2356
|
0
|
|
|
|
|
0
|
last EXPECT; |
2357
|
|
|
|
|
|
|
} |
2358
|
0
|
|
|
|
|
0
|
$expo->send($send); |
2359
|
|
|
|
|
|
|
} |
2360
|
0
|
|
|
|
|
0
|
$expo->soft_close; |
2361
|
0
|
|
|
|
|
0
|
return $expo->exitstatus(); |
2362
|
|
|
|
|
|
|
} |
2363
|
|
|
|
|
|
|
|
2364
|
|
|
|
|
|
|
#-> CPAN::Distribution::_validate_distropref |
2365
|
|
|
|
|
|
|
sub _validate_distropref { |
2366
|
0
|
|
|
0
|
|
0
|
my($self,@args) = @_; |
2367
|
0
|
0
|
0
|
|
|
0
|
if ( |
2368
|
|
|
|
|
|
|
$CPAN::META->has_inst("CPAN::Kwalify") |
2369
|
|
|
|
|
|
|
&& |
2370
|
|
|
|
|
|
|
$CPAN::META->has_inst("Kwalify") |
2371
|
|
|
|
|
|
|
) { |
2372
|
0
|
|
|
|
|
0
|
eval {CPAN::Kwalify::_validate("distroprefs",@args);}; |
|
0
|
|
|
|
|
0
|
|
2373
|
0
|
0
|
|
|
|
0
|
if ($@) { |
2374
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn($@); |
2375
|
|
|
|
|
|
|
} |
2376
|
|
|
|
|
|
|
} else { |
2377
|
0
|
0
|
|
|
|
0
|
CPAN->debug("not validating '@args'") if $CPAN::DEBUG; |
2378
|
|
|
|
|
|
|
} |
2379
|
|
|
|
|
|
|
} |
2380
|
|
|
|
|
|
|
|
2381
|
|
|
|
|
|
|
#-> CPAN::Distribution::_find_prefs |
2382
|
|
|
|
|
|
|
sub _find_prefs { |
2383
|
0
|
|
|
0
|
|
0
|
my($self) = @_; |
2384
|
0
|
|
|
|
|
0
|
my $distroid = $self->pretty_id; |
2385
|
|
|
|
|
|
|
#CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG; |
2386
|
0
|
|
|
|
|
0
|
my $prefs_dir = $CPAN::Config->{prefs_dir}; |
2387
|
0
|
0
|
|
|
|
0
|
return if $prefs_dir =~ /^\s*$/; |
2388
|
0
|
|
|
|
|
0
|
eval { File::Path::mkpath($prefs_dir); }; |
|
0
|
|
|
|
|
0
|
|
2389
|
0
|
0
|
|
|
|
0
|
if ($@) { |
2390
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie("Cannot create directory $prefs_dir"); |
2391
|
|
|
|
|
|
|
} |
2392
|
|
|
|
|
|
|
# shortcut if there are no distroprefs files |
2393
|
|
|
|
|
|
|
{ |
2394
|
0
|
0
|
|
|
|
0
|
my $dh = DirHandle->new($prefs_dir) or $CPAN::Frontend->mydie("Couldn't open '$prefs_dir': $!"); |
|
0
|
|
|
|
|
0
|
|
2395
|
0
|
|
|
|
|
0
|
my @files = map { /\.(yml|dd|st)\z/i } $dh->read; |
|
0
|
|
|
|
|
0
|
|
2396
|
0
|
0
|
|
|
|
0
|
return unless @files; |
2397
|
|
|
|
|
|
|
} |
2398
|
0
|
|
|
|
|
0
|
my $yaml_module = CPAN::_yaml_module(); |
2399
|
0
|
|
|
|
|
0
|
my $ext_map = {}; |
2400
|
0
|
|
|
|
|
0
|
my @extensions; |
2401
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst($yaml_module)) { |
2402
|
0
|
|
|
|
|
0
|
$ext_map->{yml} = 'CPAN'; |
2403
|
|
|
|
|
|
|
} else { |
2404
|
0
|
|
|
|
|
0
|
my @fallbacks; |
2405
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst("Data::Dumper")) { |
2406
|
0
|
|
|
|
|
0
|
push @fallbacks, $ext_map->{dd} = 'Data::Dumper'; |
2407
|
|
|
|
|
|
|
} |
2408
|
0
|
0
|
|
|
|
0
|
if ($CPAN::META->has_inst("Storable")) { |
2409
|
0
|
|
|
|
|
0
|
push @fallbacks, $ext_map->{st} = 'Storable'; |
2410
|
|
|
|
|
|
|
} |
2411
|
0
|
0
|
|
|
|
0
|
if (@fallbacks) { |
2412
|
0
|
|
|
|
|
0
|
local $" = " and "; |
2413
|
0
|
0
|
|
|
|
0
|
unless ($self->{have_complained_about_missing_yaml}++) { |
2414
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarnonce("'$yaml_module' not installed, falling back ". |
2415
|
|
|
|
|
|
|
"to @fallbacks to read prefs '$prefs_dir'\n"); |
2416
|
|
|
|
|
|
|
} |
2417
|
|
|
|
|
|
|
} else { |
2418
|
0
|
0
|
|
|
|
0
|
unless ($self->{have_complained_about_missing_yaml}++) { |
2419
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarnonce("'$yaml_module' not installed, cannot ". |
2420
|
|
|
|
|
|
|
"read prefs '$prefs_dir'\n"); |
2421
|
|
|
|
|
|
|
} |
2422
|
|
|
|
|
|
|
} |
2423
|
|
|
|
|
|
|
} |
2424
|
0
|
|
|
|
|
0
|
my $finder = CPAN::Distroprefs->find($prefs_dir, $ext_map); |
2425
|
0
|
|
|
|
|
0
|
DIRENT: while (my $result = $finder->next) { |
2426
|
0
|
0
|
|
|
|
0
|
if ($result->is_warning) { |
|
|
0
|
|
|
|
|
|
2427
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn($result->as_string); |
2428
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(1); |
2429
|
0
|
|
|
|
|
0
|
next DIRENT; |
2430
|
|
|
|
|
|
|
} elsif ($result->is_fatal) { |
2431
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie($result->as_string); |
2432
|
|
|
|
|
|
|
} |
2433
|
|
|
|
|
|
|
|
2434
|
0
|
|
|
|
|
0
|
my @prefs = @{ $result->prefs }; |
|
0
|
|
|
|
|
0
|
|
2435
|
|
|
|
|
|
|
|
2436
|
0
|
|
|
|
|
0
|
ELEMENT: for my $y (0..$#prefs) { |
2437
|
0
|
|
|
|
|
0
|
my $pref = $prefs[$y]; |
2438
|
0
|
|
|
|
|
0
|
$self->_validate_distropref($pref->data, $result->abs, $y); |
2439
|
|
|
|
|
|
|
|
2440
|
|
|
|
|
|
|
# I don't know why we silently skip when there's no match, but |
2441
|
|
|
|
|
|
|
# complain if there's an empty match hashref, and there's no |
2442
|
|
|
|
|
|
|
# comment explaining why -- hdp, 2008-03-18 |
2443
|
0
|
0
|
|
|
|
0
|
unless ($pref->has_any_match) { |
2444
|
0
|
|
|
|
|
0
|
next ELEMENT; |
2445
|
|
|
|
|
|
|
} |
2446
|
|
|
|
|
|
|
|
2447
|
0
|
0
|
|
|
|
0
|
unless ($pref->has_valid_subkeys) { |
2448
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mydie(sprintf |
2449
|
|
|
|
|
|
|
"Nonconforming .%s file '%s': " . |
2450
|
|
|
|
|
|
|
"missing match/* subattribute. " . |
2451
|
|
|
|
|
|
|
"Please remove, cannot continue.", |
2452
|
|
|
|
|
|
|
$result->ext, $result->abs, |
2453
|
|
|
|
|
|
|
); |
2454
|
|
|
|
|
|
|
} |
2455
|
|
|
|
|
|
|
|
2456
|
|
|
|
|
|
|
my $arg = { |
2457
|
|
|
|
|
|
|
env => \%ENV, |
2458
|
|
|
|
|
|
|
distribution => $distroid, |
2459
|
|
|
|
|
|
|
perl => \&CPAN::find_perl, |
2460
|
|
|
|
|
|
|
perlconfig => \%Config::Config, |
2461
|
0
|
|
|
0
|
|
0
|
module => sub { [ $self->containsmods ] }, |
2462
|
0
|
|
|
|
|
0
|
}; |
2463
|
|
|
|
|
|
|
|
2464
|
0
|
0
|
|
|
|
0
|
if ($pref->matches($arg)) { |
2465
|
|
|
|
|
|
|
return { |
2466
|
0
|
|
|
|
|
0
|
prefs => $pref->data, |
2467
|
|
|
|
|
|
|
prefs_file => $result->abs, |
2468
|
|
|
|
|
|
|
prefs_file_doc => $y, |
2469
|
|
|
|
|
|
|
}; |
2470
|
|
|
|
|
|
|
} |
2471
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
} |
2473
|
|
|
|
|
|
|
} |
2474
|
0
|
|
|
|
|
0
|
return; |
2475
|
|
|
|
|
|
|
} |
2476
|
|
|
|
|
|
|
|
2477
|
|
|
|
|
|
|
# CPAN::Distribution::prefs |
2478
|
|
|
|
|
|
|
sub prefs { |
2479
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
2480
|
0
|
0
|
0
|
|
|
0
|
if (exists $self->{negative_prefs_cache} |
2481
|
|
|
|
|
|
|
&& |
2482
|
|
|
|
|
|
|
$self->{negative_prefs_cache} != $CPAN::CurrentCommandId |
2483
|
|
|
|
|
|
|
) { |
2484
|
0
|
|
|
|
|
0
|
delete $self->{negative_prefs_cache}; |
2485
|
0
|
|
|
|
|
0
|
delete $self->{prefs}; |
2486
|
|
|
|
|
|
|
} |
2487
|
0
|
0
|
|
|
|
0
|
if (exists $self->{prefs}) { |
2488
|
0
|
|
|
|
|
0
|
return $self->{prefs}; # XXX comment out during debugging |
2489
|
|
|
|
|
|
|
} |
2490
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Config->{prefs_dir}) { |
2491
|
0
|
0
|
|
|
|
0
|
CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG; |
2492
|
0
|
|
|
|
|
0
|
my $prefs = $self->_find_prefs(); |
2493
|
0
|
|
0
|
|
|
0
|
$prefs ||= ""; # avoid warning next line |
2494
|
0
|
0
|
|
|
|
0
|
CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG; |
2495
|
0
|
0
|
|
|
|
0
|
if ($prefs) { |
2496
|
0
|
|
|
|
|
0
|
for my $x (qw(prefs prefs_file prefs_file_doc)) { |
2497
|
0
|
|
|
|
|
0
|
$self->{$x} = $prefs->{$x}; |
2498
|
|
|
|
|
|
|
} |
2499
|
|
|
|
|
|
|
my $bs = sprintf( |
2500
|
|
|
|
|
|
|
"%s[%s]", |
2501
|
|
|
|
|
|
|
File::Basename::basename($self->{prefs_file}), |
2502
|
|
|
|
|
|
|
$self->{prefs_file_doc}, |
2503
|
0
|
|
|
|
|
0
|
); |
2504
|
0
|
|
|
|
|
0
|
my $filler1 = "_" x 22; |
2505
|
0
|
|
|
|
|
0
|
my $filler2 = int(66 - length($bs))/2; |
2506
|
0
|
0
|
|
|
|
0
|
$filler2 = 0 if $filler2 < 0; |
2507
|
0
|
|
|
|
|
0
|
$filler2 = " " x $filler2; |
2508
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->myprint(" |
2509
|
|
|
|
|
|
|
$filler1 D i s t r o P r e f s $filler1 |
2510
|
|
|
|
|
|
|
$filler2 $bs $filler2 |
2511
|
|
|
|
|
|
|
"); |
2512
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(1); |
2513
|
0
|
|
|
|
|
0
|
return $self->{prefs}; |
2514
|
|
|
|
|
|
|
} |
2515
|
|
|
|
|
|
|
} |
2516
|
0
|
|
|
|
|
0
|
$self->{negative_prefs_cache} = $CPAN::CurrentCommandId; |
2517
|
0
|
|
|
|
|
0
|
return $self->{prefs} = +{}; |
2518
|
|
|
|
|
|
|
} |
2519
|
|
|
|
|
|
|
|
2520
|
|
|
|
|
|
|
# CPAN::Distribution::_make_phase_arg |
2521
|
|
|
|
|
|
|
sub _make_phase_arg { |
2522
|
0
|
|
|
0
|
|
0
|
my($self, $phase) = @_; |
2523
|
0
|
|
|
|
|
0
|
my $_make_phase_arg; |
2524
|
0
|
|
|
|
|
0
|
my $prefs = $self->prefs; |
2525
|
0
|
0
|
0
|
|
|
0
|
if ( |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2526
|
|
|
|
|
|
|
$prefs |
2527
|
|
|
|
|
|
|
&& exists $prefs->{$phase} |
2528
|
|
|
|
|
|
|
&& exists $prefs->{$phase}{args} |
2529
|
|
|
|
|
|
|
&& $prefs->{$phase}{args} |
2530
|
|
|
|
|
|
|
) { |
2531
|
|
|
|
|
|
|
$_make_phase_arg = join(" ", |
2532
|
0
|
|
|
|
|
0
|
map {CPAN::HandleConfig |
2533
|
0
|
|
|
|
|
0
|
->safe_quote($_)} @{$prefs->{$phase}{args}}, |
|
0
|
|
|
|
|
0
|
|
2534
|
|
|
|
|
|
|
); |
2535
|
|
|
|
|
|
|
} |
2536
|
|
|
|
|
|
|
|
2537
|
|
|
|
|
|
|
# cpan[2]> o conf make[TAB] |
2538
|
|
|
|
|
|
|
# make make_install_make_command |
2539
|
|
|
|
|
|
|
# make_arg makepl_arg |
2540
|
|
|
|
|
|
|
# make_install_arg |
2541
|
|
|
|
|
|
|
# cpan[2]> o conf mbuild[TAB] |
2542
|
|
|
|
|
|
|
# mbuild_arg mbuild_install_build_command |
2543
|
|
|
|
|
|
|
# mbuild_install_arg mbuildpl_arg |
2544
|
|
|
|
|
|
|
|
2545
|
0
|
|
|
|
|
0
|
my $mantra; # must switch make/mbuild here |
2546
|
0
|
0
|
|
|
|
0
|
if ($self->{modulebuild}) { |
2547
|
0
|
|
|
|
|
0
|
$mantra = "mbuild"; |
2548
|
|
|
|
|
|
|
} else { |
2549
|
0
|
|
|
|
|
0
|
$mantra = "make"; |
2550
|
|
|
|
|
|
|
} |
2551
|
0
|
|
|
|
|
0
|
my %map = ( |
2552
|
|
|
|
|
|
|
pl => "pl_arg", |
2553
|
|
|
|
|
|
|
make => "_arg", |
2554
|
|
|
|
|
|
|
test => "_test_arg", # does not really exist but maybe |
2555
|
|
|
|
|
|
|
# will some day and now protects |
2556
|
|
|
|
|
|
|
# us from unini warnings |
2557
|
|
|
|
|
|
|
install => "_install_arg", |
2558
|
|
|
|
|
|
|
); |
2559
|
0
|
|
|
|
|
0
|
my $phase_underscore_meshup = $map{$phase}; |
2560
|
0
|
|
|
|
|
0
|
my $what = sprintf "%s%s", $mantra, $phase_underscore_meshup; |
2561
|
|
|
|
|
|
|
|
2562
|
0
|
|
0
|
|
|
0
|
$_make_phase_arg ||= $CPAN::Config->{$what}; |
2563
|
0
|
|
|
|
|
0
|
return $_make_phase_arg; |
2564
|
|
|
|
|
|
|
} |
2565
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
# CPAN::Distribution::_make_command |
2567
|
|
|
|
|
|
|
sub _make_command { |
2568
|
0
|
|
|
0
|
|
0
|
my ($self) = @_; |
2569
|
0
|
0
|
|
|
|
0
|
if ($self) { |
2570
|
|
|
|
|
|
|
return |
2571
|
|
|
|
|
|
|
CPAN::HandleConfig |
2572
|
|
|
|
|
|
|
->safe_quote( |
2573
|
|
|
|
|
|
|
CPAN::HandleConfig->prefs_lookup($self, |
2574
|
|
|
|
|
|
|
q{make}) |
2575
|
|
|
|
|
|
|
|| $Config::Config{make} |
2576
|
0
|
|
0
|
|
|
0
|
|| 'make' |
2577
|
|
|
|
|
|
|
); |
2578
|
|
|
|
|
|
|
} else { |
2579
|
|
|
|
|
|
|
# Old style call, without object. Deprecated |
2580
|
0
|
|
|
|
|
0
|
Carp::confess("CPAN::_make_command() used as function. Don't Do That."); |
2581
|
|
|
|
|
|
|
return |
2582
|
|
|
|
|
|
|
safe_quote(undef, |
2583
|
|
|
|
|
|
|
CPAN::HandleConfig->prefs_lookup($self,q{make}) |
2584
|
|
|
|
|
|
|
|| $CPAN::Config->{make} |
2585
|
|
|
|
|
|
|
|| $Config::Config{make} |
2586
|
0
|
|
0
|
|
|
0
|
|| 'make'); |
2587
|
|
|
|
|
|
|
} |
2588
|
|
|
|
|
|
|
} |
2589
|
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
sub _make_install_make_command { |
2591
|
0
|
|
|
0
|
|
0
|
my ($self) = @_; |
2592
|
0
|
|
|
|
|
0
|
my $mimc = |
2593
|
|
|
|
|
|
|
CPAN::HandleConfig->prefs_lookup($self, q{make_install_make_command}); |
2594
|
0
|
0
|
|
|
|
0
|
return $self->_make_command() unless $mimc; |
2595
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
# Quote the "make install" make command on Windows, where it is commonly |
2597
|
|
|
|
|
|
|
# found in, e.g., C:\Program Files\... and therefore needs quoting. We can't |
2598
|
|
|
|
|
|
|
# do this in general because the command maybe "sudo make..." (i.e. a |
2599
|
|
|
|
|
|
|
# program with arguments), but that is unlikely to be the case on Windows. |
2600
|
0
|
0
|
|
|
|
0
|
$mimc = CPAN::HandleConfig->safe_quote($mimc) if $^O eq 'MSWin32'; |
2601
|
|
|
|
|
|
|
|
2602
|
0
|
|
|
|
|
0
|
return $mimc; |
2603
|
|
|
|
|
|
|
} |
2604
|
|
|
|
|
|
|
|
2605
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::is_locally_optional |
2606
|
|
|
|
|
|
|
sub is_locally_optional { |
2607
|
0
|
|
|
0
|
0
|
0
|
my($self, $prereq_pm, $prereq) = @_; |
2608
|
0
|
|
0
|
|
|
0
|
$prereq_pm ||= $self->{prereq_pm}; |
2609
|
|
|
|
|
|
|
exists $prereq_pm->{opt_requires}{$prereq} |
2610
|
|
|
|
|
|
|
|| |
2611
|
0
|
0
|
|
|
|
0
|
exists $prereq_pm->{opt_build_requires}{$prereq}; |
2612
|
|
|
|
|
|
|
} |
2613
|
|
|
|
|
|
|
|
2614
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::follow_prereqs ; |
2615
|
|
|
|
|
|
|
sub follow_prereqs { |
2616
|
0
|
|
|
0
|
0
|
0
|
my($self) = shift; |
2617
|
0
|
|
|
|
|
0
|
my($slot) = shift; |
2618
|
0
|
|
|
|
|
0
|
my(@prereq_tuples) = grep {$_->[0] ne "perl"} @_; |
|
0
|
|
|
|
|
0
|
|
2619
|
0
|
0
|
|
|
|
0
|
return unless @prereq_tuples; |
2620
|
0
|
|
|
|
|
0
|
my(@good_prereq_tuples); |
2621
|
0
|
|
|
|
|
0
|
for my $p (@prereq_tuples) { |
2622
|
|
|
|
|
|
|
# e.g. $p = ['Devel::PartialDump', 'r', 1] |
2623
|
|
|
|
|
|
|
# promote if possible |
2624
|
0
|
0
|
|
|
|
0
|
if ($p->[1] =~ /^(r|c)$/) { |
|
|
0
|
|
|
|
|
|
2625
|
0
|
|
|
|
|
0
|
push @good_prereq_tuples, $p; |
2626
|
|
|
|
|
|
|
} elsif ($p->[1] =~ /^(b)$/) { |
2627
|
0
|
|
|
|
|
0
|
my $reqtype = CPAN::Queue->reqtype_of($p->[0]); |
2628
|
0
|
0
|
|
|
|
0
|
if ($reqtype =~ /^(r|c)$/) { |
2629
|
0
|
|
|
|
|
0
|
push @good_prereq_tuples, [$p->[0], $reqtype, $p->[2]]; |
2630
|
|
|
|
|
|
|
} else { |
2631
|
0
|
|
|
|
|
0
|
push @good_prereq_tuples, $p; |
2632
|
|
|
|
|
|
|
} |
2633
|
|
|
|
|
|
|
} else { |
2634
|
0
|
|
|
|
|
0
|
die "Panic: in follow_prereqs: reqtype[$p->[1]] seen, should never happen"; |
2635
|
|
|
|
|
|
|
} |
2636
|
|
|
|
|
|
|
} |
2637
|
0
|
|
|
|
|
0
|
my $pretty_id = $self->pretty_id; |
2638
|
0
|
|
|
|
|
0
|
my %map = ( |
2639
|
|
|
|
|
|
|
b => "build_requires", |
2640
|
|
|
|
|
|
|
r => "requires", |
2641
|
|
|
|
|
|
|
c => "commandline", |
2642
|
|
|
|
|
|
|
); |
2643
|
0
|
|
|
|
|
0
|
my($filler1,$filler2,$filler3,$filler4); |
2644
|
0
|
|
|
|
|
0
|
my $unsat = "Unsatisfied dependencies detected during"; |
2645
|
0
|
0
|
|
|
|
0
|
my $w = length($unsat) > length($pretty_id) ? length($unsat) : length($pretty_id); |
2646
|
|
|
|
|
|
|
{ |
2647
|
0
|
|
|
|
|
0
|
my $r = int(($w - length($unsat))/2); |
2648
|
0
|
|
|
|
|
0
|
my $l = $w - length($unsat) - $r; |
2649
|
0
|
|
|
|
|
0
|
$filler1 = "-"x4 . " "x$l; |
2650
|
0
|
|
|
|
|
0
|
$filler2 = " "x$r . "-"x4 . "\n"; |
2651
|
|
|
|
|
|
|
} |
2652
|
|
|
|
|
|
|
{ |
2653
|
0
|
|
|
|
|
0
|
my $r = int(($w - length($pretty_id))/2); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2654
|
0
|
|
|
|
|
0
|
my $l = $w - length($pretty_id) - $r; |
2655
|
0
|
|
|
|
|
0
|
$filler3 = "-"x4 . " "x$l; |
2656
|
0
|
|
|
|
|
0
|
$filler4 = " "x$r . "-"x4 . "\n"; |
2657
|
|
|
|
|
|
|
} |
2658
|
|
|
|
|
|
|
$CPAN::Frontend-> |
2659
|
|
|
|
|
|
|
myprint("$filler1 $unsat $filler2". |
2660
|
|
|
|
|
|
|
"$filler3 $pretty_id $filler4". |
2661
|
0
|
0
|
|
|
|
0
|
join("", map {sprintf " %s \[%s%s]\n", $_->[0], $map{$_->[1]}, $self->is_locally_optional(undef,$_->[0]) ? ",optional" : ""} @good_prereq_tuples), |
|
0
|
|
|
|
|
0
|
|
2662
|
|
|
|
|
|
|
); |
2663
|
0
|
|
|
|
|
0
|
my $follow = 0; |
2664
|
0
|
0
|
|
|
|
0
|
if ($CPAN::Config->{prerequisites_policy} eq "follow") { |
|
|
0
|
|
|
|
|
|
2665
|
0
|
|
|
|
|
0
|
$follow = 1; |
2666
|
|
|
|
|
|
|
} elsif ($CPAN::Config->{prerequisites_policy} eq "ask") { |
2667
|
0
|
|
|
|
|
0
|
my $answer = CPAN::Shell::colorable_makemaker_prompt( |
2668
|
|
|
|
|
|
|
"Shall I follow them and prepend them to the queue |
2669
|
|
|
|
|
|
|
of modules we are processing right now?", "yes"); |
2670
|
0
|
|
|
|
|
0
|
$follow = $answer =~ /^\s*y/i; |
2671
|
|
|
|
|
|
|
} else { |
2672
|
0
|
|
|
|
|
0
|
my @prereq = map { $_->[0] } @good_prereq_tuples; |
|
0
|
|
|
|
|
0
|
|
2673
|
0
|
|
|
|
|
0
|
local($") = ", "; |
2674
|
0
|
|
|
|
|
0
|
$CPAN::Frontend-> |
2675
|
|
|
|
|
|
|
myprint(" Ignoring dependencies on modules @prereq\n"); |
2676
|
|
|
|
|
|
|
} |
2677
|
0
|
0
|
|
|
|
0
|
if ($follow) { |
2678
|
0
|
|
|
|
|
0
|
my $id = $self->id; |
2679
|
0
|
|
|
|
|
0
|
my(@to_queue_mand,@to_queue_opt); |
2680
|
0
|
|
|
|
|
0
|
for my $gp (@good_prereq_tuples) { |
2681
|
0
|
|
|
|
|
0
|
my($prereq,$reqtype,$optional) = @$gp; |
2682
|
0
|
|
|
|
|
0
|
my $qthing = +{qmod=>$prereq,reqtype=>$reqtype,optional=>$optional}; |
2683
|
0
|
0
|
0
|
|
|
0
|
if ($optional && |
2684
|
|
|
|
|
|
|
$self->is_locally_optional(undef,$prereq) |
2685
|
|
|
|
|
|
|
){ |
2686
|
|
|
|
|
|
|
# Since we do not depend on this one, we do not need |
2687
|
|
|
|
|
|
|
# this in a mandatory arrangement: |
2688
|
0
|
|
|
|
|
0
|
push @to_queue_opt, $qthing; |
2689
|
|
|
|
|
|
|
} else { |
2690
|
0
|
|
|
|
|
0
|
my $any = CPAN::Shell->expandany($prereq); |
2691
|
0
|
|
|
|
|
0
|
$self->{$slot . "_for"}{$any->id}++; |
2692
|
0
|
0
|
|
|
|
0
|
if ($any) { |
2693
|
0
|
0
|
|
|
|
0
|
unless ($optional) { |
2694
|
|
|
|
|
|
|
# No recursion check in an optional area of the tree |
2695
|
0
|
|
|
|
|
0
|
$any->color_cmd_tmps(0,2); |
2696
|
|
|
|
|
|
|
} |
2697
|
|
|
|
|
|
|
} else { |
2698
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Warning (maybe a bug): Cannot expand prereq '$prereq'\n"); |
2699
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(2); |
2700
|
|
|
|
|
|
|
} |
2701
|
|
|
|
|
|
|
# order everything that is not locally_optional just |
2702
|
|
|
|
|
|
|
# like mandatory items: this keeps leaves before |
2703
|
|
|
|
|
|
|
# branches |
2704
|
0
|
|
|
|
|
0
|
unshift @to_queue_mand, $qthing; |
2705
|
|
|
|
|
|
|
} |
2706
|
|
|
|
|
|
|
} |
2707
|
0
|
0
|
|
|
|
0
|
if (@to_queue_mand) { |
|
|
0
|
|
|
|
|
|
2708
|
0
|
|
|
|
|
0
|
unshift @to_queue_mand, {qmod => $id, reqtype => $self->{reqtype}, optional=> !$self->{mandatory}}; |
2709
|
0
|
|
|
|
|
0
|
CPAN::Queue->jumpqueue(@to_queue_opt,@to_queue_mand); |
2710
|
0
|
|
|
|
|
0
|
$self->{$slot} = "Delayed until after prerequisites"; |
2711
|
0
|
|
|
|
|
0
|
return 1; # signal we need dependencies |
2712
|
|
|
|
|
|
|
} elsif (@to_queue_opt) { |
2713
|
0
|
|
|
|
|
0
|
CPAN::Queue->jumpqueue(@to_queue_opt); |
2714
|
|
|
|
|
|
|
} |
2715
|
|
|
|
|
|
|
} |
2716
|
0
|
|
|
|
|
0
|
return; |
2717
|
|
|
|
|
|
|
} |
2718
|
|
|
|
|
|
|
|
2719
|
|
|
|
|
|
|
sub _feature_depends { |
2720
|
0
|
|
|
0
|
|
0
|
my($self) = @_; |
2721
|
0
|
|
|
|
|
0
|
my $meta_yml = $self->parse_meta_yml(); |
2722
|
0
|
0
|
|
|
|
0
|
my $optf = $meta_yml->{optional_features} or return; |
2723
|
0
|
0
|
0
|
|
|
0
|
if (!ref $optf or ref $optf ne "HASH"){ |
2724
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("The content of optional_features is not a HASH reference. Cannot use it.\n"); |
2725
|
0
|
|
|
|
|
0
|
$optf = {}; |
2726
|
|
|
|
|
|
|
} |
2727
|
0
|
0
|
|
|
|
0
|
my $wantf = $self->prefs->{features} or return; |
2728
|
0
|
0
|
0
|
|
|
0
|
if (!ref $wantf or ref $wantf ne "ARRAY"){ |
2729
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("The content of 'features' is not an ARRAY reference. Cannot use it.\n"); |
2730
|
0
|
|
|
|
|
0
|
$wantf = []; |
2731
|
|
|
|
|
|
|
} |
2732
|
0
|
|
|
|
|
0
|
my $dep = +{}; |
2733
|
0
|
|
|
|
|
0
|
for my $wf (@$wantf) { |
2734
|
0
|
0
|
|
|
|
0
|
if (my $f = $optf->{$wf}) { |
2735
|
|
|
|
|
|
|
$CPAN::Frontend->myprint("Found the demanded feature '$wf' that ". |
2736
|
|
|
|
|
|
|
"is accompanied by this description:\n". |
2737
|
|
|
|
|
|
|
$f->{description}. |
2738
|
0
|
|
|
|
|
0
|
"\n\n" |
2739
|
|
|
|
|
|
|
); |
2740
|
|
|
|
|
|
|
# configure_requires currently not in the spec, unlikely to be useful anyway |
2741
|
0
|
|
|
|
|
0
|
for my $reqtype (qw(configure_requires build_requires requires)) { |
2742
|
0
|
0
|
|
|
|
0
|
my $reqhash = $f->{$reqtype} or next; |
2743
|
0
|
|
|
|
|
0
|
while (my($k,$v) = each %$reqhash) { |
2744
|
0
|
|
|
|
|
0
|
$dep->{$reqtype}{$k} = $v; |
2745
|
|
|
|
|
|
|
} |
2746
|
|
|
|
|
|
|
} |
2747
|
|
|
|
|
|
|
} else { |
2748
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("The demanded feature '$wf' was not ". |
2749
|
|
|
|
|
|
|
"found in the META.yml file". |
2750
|
|
|
|
|
|
|
"\n\n" |
2751
|
|
|
|
|
|
|
); |
2752
|
|
|
|
|
|
|
} |
2753
|
|
|
|
|
|
|
} |
2754
|
0
|
|
|
|
|
0
|
$dep; |
2755
|
|
|
|
|
|
|
} |
2756
|
|
|
|
|
|
|
|
2757
|
|
|
|
|
|
|
sub prereqs_for_slot { |
2758
|
0
|
|
|
0
|
0
|
0
|
my($self,$slot) = @_; |
2759
|
0
|
|
|
|
|
0
|
my($prereq_pm); |
2760
|
0
|
0
|
|
|
|
0
|
$CPAN::META->has_usable("CPAN::Meta::Requirements") |
2761
|
|
|
|
|
|
|
or die "CPAN::Meta::Requirements not available"; |
2762
|
0
|
|
|
|
|
0
|
my $merged = CPAN::Meta::Requirements->new; |
2763
|
0
|
|
0
|
|
|
0
|
my $prefs_depends = $self->prefs->{depends}||{}; |
2764
|
0
|
|
|
|
|
0
|
my $feature_depends = $self->_feature_depends(); |
2765
|
0
|
0
|
|
|
|
0
|
if ($slot eq "configure_requires_later") { |
|
|
0
|
|
|
|
|
|
2766
|
0
|
|
|
|
|
0
|
for my $hash ( $self->configure_requires, |
2767
|
|
|
|
|
|
|
$prefs_depends->{configure_requires}, |
2768
|
|
|
|
|
|
|
$feature_depends->{configure_requires}, |
2769
|
|
|
|
|
|
|
) { |
2770
|
0
|
|
|
|
|
0
|
$merged->add_requirements( |
2771
|
|
|
|
|
|
|
CPAN::Meta::Requirements->from_string_hash($hash) |
2772
|
|
|
|
|
|
|
); |
2773
|
|
|
|
|
|
|
} |
2774
|
0
|
0
|
0
|
|
|
0
|
if (-f "Build.PL" |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2775
|
|
|
|
|
|
|
&& ! -f File::Spec->catfile($self->{build_dir},"Makefile.PL") |
2776
|
|
|
|
|
|
|
&& ! $merged->requirements_for_module("Module::Build") |
2777
|
|
|
|
|
|
|
&& ! $CPAN::META->has_inst("Module::Build") |
2778
|
|
|
|
|
|
|
) { |
2779
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn( |
2780
|
|
|
|
|
|
|
" Warning: CPAN.pm discovered Module::Build as undeclared prerequisite.\n". |
2781
|
|
|
|
|
|
|
" Adding it now as such.\n" |
2782
|
|
|
|
|
|
|
); |
2783
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(5); |
2784
|
0
|
|
|
|
|
0
|
$merged->add_minimum( "Module::Build" => 0 ); |
2785
|
0
|
|
|
|
|
0
|
delete $self->{writemakefile}; |
2786
|
|
|
|
|
|
|
} |
2787
|
0
|
|
|
|
|
0
|
$prereq_pm = {}; # configure_requires defined as "b" |
2788
|
|
|
|
|
|
|
} elsif ($slot eq "later") { |
2789
|
0
|
|
0
|
|
|
0
|
my $prereq_pm_0 = $self->prereq_pm || {}; |
2790
|
0
|
|
|
|
|
0
|
for my $reqtype (qw(requires build_requires opt_requires opt_build_requires)) { |
2791
|
0
|
0
|
|
|
|
0
|
$prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it |
|
0
|
|
|
|
|
0
|
|
2792
|
0
|
|
|
|
|
0
|
for my $dep ($prefs_depends,$feature_depends) { |
2793
|
0
|
0
|
|
|
|
0
|
for my $k (keys %{$dep->{$reqtype}||{}}) { |
|
0
|
|
|
|
|
0
|
|
2794
|
0
|
|
|
|
|
0
|
$prereq_pm->{$reqtype}{$k} = $dep->{$reqtype}{$k}; |
2795
|
|
|
|
|
|
|
} |
2796
|
|
|
|
|
|
|
} |
2797
|
|
|
|
|
|
|
} |
2798
|
|
|
|
|
|
|
# XXX what about optional_req|breq? -- xdg, 2012-04-01 |
2799
|
0
|
|
|
|
|
0
|
for my $hash ( |
2800
|
|
|
|
|
|
|
$prereq_pm->{requires}, |
2801
|
|
|
|
|
|
|
$prereq_pm->{build_requires}, |
2802
|
|
|
|
|
|
|
$prereq_pm->{opt_requires}, |
2803
|
|
|
|
|
|
|
$prereq_pm->{opt_build_requires}, |
2804
|
|
|
|
|
|
|
|
2805
|
|
|
|
|
|
|
) { |
2806
|
0
|
|
|
|
|
0
|
$merged->add_requirements( |
2807
|
|
|
|
|
|
|
CPAN::Meta::Requirements->from_string_hash($hash) |
2808
|
|
|
|
|
|
|
); |
2809
|
|
|
|
|
|
|
} |
2810
|
|
|
|
|
|
|
} else { |
2811
|
0
|
|
|
|
|
0
|
die "Panic: illegal slot '$slot'"; |
2812
|
|
|
|
|
|
|
} |
2813
|
0
|
|
|
|
|
0
|
return ($merged->as_string_hash, $prereq_pm); |
2814
|
|
|
|
|
|
|
} |
2815
|
|
|
|
|
|
|
|
2816
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::unsat_prereq ; |
2817
|
|
|
|
|
|
|
# return ([Foo,"r"],[Bar,"b"]) for normal modules |
2818
|
|
|
|
|
|
|
# return ([perl=>5.008]) if we need a newer perl than we are running under |
2819
|
|
|
|
|
|
|
# (sorry for the inconsistency, it was an accident) |
2820
|
|
|
|
|
|
|
sub unsat_prereq { |
2821
|
0
|
|
|
0
|
0
|
0
|
my($self,$slot) = @_; |
2822
|
0
|
|
|
|
|
0
|
my($merged_hash,$prereq_pm) = $self->prereqs_for_slot($slot); |
2823
|
0
|
|
|
|
|
0
|
my(@need); |
2824
|
0
|
0
|
|
|
|
0
|
$CPAN::META->has_usable("CPAN::Meta::Requirements") |
2825
|
|
|
|
|
|
|
or die "CPAN::Meta::Requirements not available"; |
2826
|
0
|
|
|
|
|
0
|
my $merged = CPAN::Meta::Requirements->from_string_hash($merged_hash); |
2827
|
0
|
|
|
|
|
0
|
my @merged = sort $merged->required_modules; |
2828
|
0
|
0
|
|
|
|
0
|
CPAN->debug("all merged_prereqs[@merged]") if $CPAN::DEBUG; |
2829
|
0
|
|
|
|
|
0
|
NEED: for my $need_module ( @merged ) { |
2830
|
0
|
|
|
|
|
0
|
my $need_version = $merged->requirements_for_module($need_module); |
2831
|
0
|
|
|
|
|
0
|
my($available_version,$inst_file,$available_file,$nmo); |
2832
|
0
|
0
|
|
|
|
0
|
if ($need_module eq "perl") { |
2833
|
0
|
|
|
|
|
0
|
$available_version = $]; |
2834
|
0
|
|
|
|
|
0
|
$available_file = CPAN::find_perl(); |
2835
|
|
|
|
|
|
|
} else { |
2836
|
0
|
0
|
|
|
|
0
|
if (CPAN::_sqlite_running()) { |
2837
|
0
|
|
|
|
|
0
|
CPAN::Index->reload; |
2838
|
0
|
|
|
|
|
0
|
$CPAN::SQLite->search("CPAN::Module",$need_module); |
2839
|
|
|
|
|
|
|
} |
2840
|
0
|
|
|
|
|
0
|
$nmo = $CPAN::META->instance("CPAN::Module",$need_module); |
2841
|
0
|
|
0
|
|
|
0
|
$inst_file = $nmo->inst_file || ''; |
2842
|
0
|
|
0
|
|
|
0
|
$available_file = $nmo->available_file || ''; |
2843
|
0
|
|
|
|
|
0
|
$available_version = $nmo->available_version; |
2844
|
0
|
0
|
|
|
|
0
|
if ($nmo->uptodate) { |
2845
|
0
|
|
|
|
|
0
|
my $accepts = eval { |
2846
|
0
|
|
|
|
|
0
|
$merged->accepts_module($need_module, $available_version); |
2847
|
|
|
|
|
|
|
}; |
2848
|
0
|
0
|
|
|
|
0
|
unless ($accepts) { |
2849
|
0
|
|
|
|
|
0
|
my $rq = $merged->requirements_for_module( $need_module ); |
2850
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn( |
2851
|
|
|
|
|
|
|
"Warning: Version '$available_version' of ". |
2852
|
|
|
|
|
|
|
"'$need_module' is up to date but does not ". |
2853
|
|
|
|
|
|
|
"fulfill requirements ($rq). I will continue, ". |
2854
|
|
|
|
|
|
|
"but chances to succeed are low.\n"); |
2855
|
|
|
|
|
|
|
} |
2856
|
0
|
|
|
|
|
0
|
next NEED; |
2857
|
|
|
|
|
|
|
} |
2858
|
|
|
|
|
|
|
|
2859
|
|
|
|
|
|
|
# if they have not specified a version, we accept any installed one |
2860
|
0
|
0
|
0
|
|
|
0
|
if ( $available_file |
|
|
|
0
|
|
|
|
|
2861
|
|
|
|
|
|
|
and ( # a few quick short circuits |
2862
|
|
|
|
|
|
|
not defined $need_version |
2863
|
|
|
|
|
|
|
or $need_version eq '0' # "==" would trigger warning when not numeric |
2864
|
|
|
|
|
|
|
or $need_version eq "undef" |
2865
|
|
|
|
|
|
|
)) { |
2866
|
0
|
0
|
|
|
|
0
|
unless ($nmo->inst_deprecated) { |
2867
|
0
|
|
|
|
|
0
|
next NEED; |
2868
|
|
|
|
|
|
|
} |
2869
|
|
|
|
|
|
|
} |
2870
|
|
|
|
|
|
|
} |
2871
|
|
|
|
|
|
|
|
2872
|
|
|
|
|
|
|
# We only want to install prereqs if either they're not installed |
2873
|
|
|
|
|
|
|
# or if the installed version is too old. We cannot omit this |
2874
|
|
|
|
|
|
|
# check, because if 'force' is in effect, nobody else will check. |
2875
|
|
|
|
|
|
|
# But we don't want to accept a deprecated module installed as part |
2876
|
|
|
|
|
|
|
# of the Perl core, so we continue if the available file is the installed |
2877
|
|
|
|
|
|
|
# one and is deprecated |
2878
|
|
|
|
|
|
|
|
2879
|
0
|
0
|
|
|
|
0
|
if ( $available_file ) { |
2880
|
0
|
|
|
|
|
0
|
my $fulfills_all_version_rqs = $self->_fulfills_all_version_rqs |
2881
|
|
|
|
|
|
|
( |
2882
|
|
|
|
|
|
|
$need_module, |
2883
|
|
|
|
|
|
|
$available_file, |
2884
|
|
|
|
|
|
|
$available_version, |
2885
|
|
|
|
|
|
|
$need_version, |
2886
|
|
|
|
|
|
|
); |
2887
|
0
|
0
|
0
|
|
|
0
|
if ( $inst_file |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2888
|
|
|
|
|
|
|
&& $available_file eq $inst_file |
2889
|
|
|
|
|
|
|
&& $nmo->inst_deprecated |
2890
|
|
|
|
|
|
|
) { |
2891
|
|
|
|
|
|
|
# continue installing as a prereq. we really want that |
2892
|
|
|
|
|
|
|
# because the deprecated module may spit out warnings |
2893
|
|
|
|
|
|
|
# and third party did not know until today. Only one |
2894
|
|
|
|
|
|
|
# exception is OK, because CPANPLUS is special after |
2895
|
|
|
|
|
|
|
# all: |
2896
|
0
|
0
|
0
|
|
|
0
|
if ( $fulfills_all_version_rqs and |
2897
|
|
|
|
|
|
|
$nmo->id =~ /^CPANPLUS(?:::Dist::Build)$/ |
2898
|
|
|
|
|
|
|
) { |
2899
|
|
|
|
|
|
|
# here we have an available version that is good |
2900
|
|
|
|
|
|
|
# enough although deprecated (preventing circular |
2901
|
|
|
|
|
|
|
# loop CPANPLUS => CPANPLUS::Dist::Build RT#83042) |
2902
|
0
|
|
|
|
|
0
|
next NEED; |
2903
|
|
|
|
|
|
|
} |
2904
|
|
|
|
|
|
|
} elsif ( |
2905
|
|
|
|
|
|
|
$self->{reqtype} =~ /^(r|c)$/ |
2906
|
|
|
|
|
|
|
&& (exists $prereq_pm->{requires}{$need_module} || exists $prereq_pm->{opt_requires} ) |
2907
|
|
|
|
|
|
|
&& $nmo |
2908
|
|
|
|
|
|
|
&& !$inst_file |
2909
|
|
|
|
|
|
|
) { |
2910
|
|
|
|
|
|
|
# continue installing as a prereq; this may be a |
2911
|
|
|
|
|
|
|
# distro we already used when it was a build_requires |
2912
|
|
|
|
|
|
|
# so we did not install it. But suddenly somebody |
2913
|
|
|
|
|
|
|
# wants it as a requires |
2914
|
0
|
|
|
|
|
0
|
my $need_distro = $nmo->distribution; |
2915
|
0
|
0
|
0
|
|
|
0
|
if ($need_distro->{install} && $need_distro->{install}->failed && $need_distro->{install}->text =~ /is only/) { |
|
|
|
0
|
|
|
|
|
2916
|
0
|
0
|
|
|
|
0
|
CPAN->debug("promotion from build_requires to requires") if $CPAN::DEBUG; |
2917
|
0
|
|
|
|
|
0
|
delete $need_distro->{install}; # promote to another installation attempt |
2918
|
0
|
|
|
|
|
0
|
$need_distro->{reqtype} = "r"; |
2919
|
0
|
|
|
|
|
0
|
$need_distro->install; |
2920
|
0
|
|
|
|
|
0
|
next NEED; |
2921
|
|
|
|
|
|
|
} |
2922
|
|
|
|
|
|
|
} |
2923
|
|
|
|
|
|
|
else { |
2924
|
0
|
0
|
|
|
|
0
|
next NEED if $fulfills_all_version_rqs; |
2925
|
|
|
|
|
|
|
} |
2926
|
|
|
|
|
|
|
} |
2927
|
|
|
|
|
|
|
|
2928
|
0
|
0
|
|
|
|
0
|
if ($need_module eq "perl") { |
2929
|
0
|
|
|
|
|
0
|
return ["perl", $need_version]; |
2930
|
|
|
|
|
|
|
} |
2931
|
0
|
|
0
|
|
|
0
|
$self->{sponsored_mods}{$need_module} ||= 0; |
2932
|
0
|
0
|
|
|
|
0
|
CPAN->debug("need_module[$need_module]s/s/n[$self->{sponsored_mods}{$need_module}]") if $CPAN::DEBUG; |
2933
|
0
|
0
|
|
|
|
0
|
if (my $sponsoring = $self->{sponsored_mods}{$need_module}++) { |
2934
|
|
|
|
|
|
|
# We have already sponsored it and for some reason it's still |
2935
|
|
|
|
|
|
|
# not available. So we do ... what?? |
2936
|
|
|
|
|
|
|
|
2937
|
|
|
|
|
|
|
# if we push it again, we have a potential infinite loop |
2938
|
|
|
|
|
|
|
|
2939
|
|
|
|
|
|
|
# The following "next" was a very problematic construct. |
2940
|
|
|
|
|
|
|
# It helped a lot but broke some day and had to be |
2941
|
|
|
|
|
|
|
# replaced. |
2942
|
|
|
|
|
|
|
|
2943
|
|
|
|
|
|
|
# We must be able to deal with modules that come again and |
2944
|
|
|
|
|
|
|
# again as a prereq and have themselves prereqs and the |
2945
|
|
|
|
|
|
|
# queue becomes long but finally we would find the correct |
2946
|
|
|
|
|
|
|
# order. The RecursiveDependency check should trigger a |
2947
|
|
|
|
|
|
|
# die when it's becoming too weird. Unfortunately removing |
2948
|
|
|
|
|
|
|
# this next breaks many other things. |
2949
|
|
|
|
|
|
|
|
2950
|
|
|
|
|
|
|
# The bug that brought this up is described in Todo under |
2951
|
|
|
|
|
|
|
# "5.8.9 cannot install Compress::Zlib" |
2952
|
|
|
|
|
|
|
|
2953
|
|
|
|
|
|
|
# next; # this is the next that had to go away |
2954
|
|
|
|
|
|
|
|
2955
|
|
|
|
|
|
|
# The following "next NEED" are fine and the error message |
2956
|
|
|
|
|
|
|
# explains well what is going on. For example when the DBI |
2957
|
|
|
|
|
|
|
# fails and consequently DBD::SQLite fails and now we are |
2958
|
|
|
|
|
|
|
# processing CPAN::SQLite. Then we must have a "next" for |
2959
|
|
|
|
|
|
|
# DBD::SQLite. How can we get it and how can we identify |
2960
|
|
|
|
|
|
|
# all other cases we must identify? |
2961
|
|
|
|
|
|
|
|
2962
|
0
|
|
|
|
|
0
|
my $do = $nmo->distribution; |
2963
|
0
|
0
|
|
|
|
0
|
next NEED unless $do; # not on CPAN |
2964
|
0
|
0
|
|
|
|
0
|
if (CPAN::Version->vcmp($need_version, $nmo->ro->{CPAN_VERSION}) > 0){ |
2965
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Warning: Prerequisite ". |
2966
|
|
|
|
|
|
|
"'$need_module => $need_version' ". |
2967
|
|
|
|
|
|
|
"for '$self->{ID}' seems ". |
2968
|
|
|
|
|
|
|
"not available according to the indices\n" |
2969
|
|
|
|
|
|
|
); |
2970
|
0
|
|
|
|
|
0
|
next NEED; |
2971
|
|
|
|
|
|
|
} |
2972
|
0
|
|
|
|
|
0
|
NOSAYER: for my $nosayer ( |
2973
|
|
|
|
|
|
|
"unwrapped", |
2974
|
|
|
|
|
|
|
"writemakefile", |
2975
|
|
|
|
|
|
|
"signature_verify", |
2976
|
|
|
|
|
|
|
"make", |
2977
|
|
|
|
|
|
|
"make_test", |
2978
|
|
|
|
|
|
|
"install", |
2979
|
|
|
|
|
|
|
"make_clean", |
2980
|
|
|
|
|
|
|
) { |
2981
|
0
|
0
|
|
|
|
0
|
if ($do->{$nosayer}) { |
2982
|
0
|
|
|
|
|
0
|
my $selfid = $self->pretty_id; |
2983
|
0
|
|
|
|
|
0
|
my $did = $do->pretty_id; |
2984
|
0
|
0
|
|
|
|
0
|
if (UNIVERSAL::can($do->{$nosayer},"failed") ? |
|
|
0
|
|
|
|
|
|
2985
|
|
|
|
|
|
|
$do->{$nosayer}->failed : |
2986
|
|
|
|
|
|
|
$do->{$nosayer} =~ /^NO/) { |
2987
|
0
|
0
|
0
|
|
|
0
|
if ($nosayer eq "make_test" |
2988
|
|
|
|
|
|
|
&& |
2989
|
|
|
|
|
|
|
$do->{make_test}{COMMANDID} != $CPAN::CurrentCommandId |
2990
|
|
|
|
|
|
|
) { |
2991
|
0
|
|
|
|
|
0
|
next NOSAYER; |
2992
|
|
|
|
|
|
|
} |
2993
|
|
|
|
|
|
|
### XXX don't complain about missing optional deps -- xdg, 2012-04-01 |
2994
|
0
|
0
|
|
|
|
0
|
if ($self->is_locally_optional($prereq_pm, $need_module)) { |
2995
|
|
|
|
|
|
|
# don't complain about failing optional prereqs |
2996
|
|
|
|
|
|
|
} |
2997
|
|
|
|
|
|
|
else { |
2998
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Warning: Prerequisite ". |
2999
|
|
|
|
|
|
|
"'$need_module => $need_version' ". |
3000
|
|
|
|
|
|
|
"for '$selfid' failed when ". |
3001
|
|
|
|
|
|
|
"processing '$did' with ". |
3002
|
|
|
|
|
|
|
"'$nosayer => $do->{$nosayer}'. Continuing, ". |
3003
|
|
|
|
|
|
|
"but chances to succeed are limited.\n" |
3004
|
|
|
|
|
|
|
); |
3005
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep($sponsoring/10); |
3006
|
|
|
|
|
|
|
} |
3007
|
0
|
|
|
|
|
0
|
next NEED; |
3008
|
|
|
|
|
|
|
} else { # the other guy succeeded |
3009
|
0
|
0
|
|
|
|
0
|
if ($nosayer =~ /^(install|make_test)$/) { |
3010
|
|
|
|
|
|
|
# we had this with |
3011
|
|
|
|
|
|
|
# DMAKI/DateTime-Calendar-Chinese-0.05.tar.gz |
3012
|
|
|
|
|
|
|
# in 2007-03 for 'make install' |
3013
|
|
|
|
|
|
|
# and 2008-04: #30464 (for 'make test') |
3014
|
|
|
|
|
|
|
# $CPAN::Frontend->mywarn("Warning: Prerequisite ". |
3015
|
|
|
|
|
|
|
# "'$need_module => $need_version' ". |
3016
|
|
|
|
|
|
|
# "for '$selfid' already built ". |
3017
|
|
|
|
|
|
|
# "but the result looks suspicious. ". |
3018
|
|
|
|
|
|
|
# "Skipping another build attempt, ". |
3019
|
|
|
|
|
|
|
# "to prevent looping endlessly.\n" |
3020
|
|
|
|
|
|
|
# ); |
3021
|
0
|
|
|
|
|
0
|
next NEED; |
3022
|
|
|
|
|
|
|
} |
3023
|
|
|
|
|
|
|
} |
3024
|
|
|
|
|
|
|
} |
3025
|
|
|
|
|
|
|
} |
3026
|
|
|
|
|
|
|
} |
3027
|
0
|
|
|
|
|
0
|
my $needed_as; |
3028
|
0
|
0
|
|
|
|
0
|
if (0) { |
|
|
0
|
|
|
|
|
|
3029
|
0
|
0
|
|
|
|
0
|
} elsif (exists $prereq_pm->{requires}{$need_module} |
3030
|
|
|
|
|
|
|
|| exists $prereq_pm->{opt_requires}{$need_module} |
3031
|
|
|
|
|
|
|
) { |
3032
|
0
|
|
|
|
|
0
|
$needed_as = "r"; |
3033
|
|
|
|
|
|
|
} elsif ($slot eq "configure_requires_later") { |
3034
|
|
|
|
|
|
|
# in ae872487d5 we said: C< we have not yet run the |
3035
|
|
|
|
|
|
|
# {Build,Makefile}.PL, we must presume "r" >; but the |
3036
|
|
|
|
|
|
|
# meta.yml standard says C< These dependencies are not |
3037
|
|
|
|
|
|
|
# required after the distribution is installed. >; so now |
3038
|
|
|
|
|
|
|
# we change it back to "b" and care for the proper |
3039
|
|
|
|
|
|
|
# promotion later. |
3040
|
0
|
|
|
|
|
0
|
$needed_as = "b"; |
3041
|
|
|
|
|
|
|
} else { |
3042
|
0
|
|
|
|
|
0
|
$needed_as = "b"; |
3043
|
|
|
|
|
|
|
} |
3044
|
|
|
|
|
|
|
# here need to flag as optional for recommends/suggests |
3045
|
|
|
|
|
|
|
# -- xdg, 2012-04-01 |
3046
|
|
|
|
|
|
|
my $optional = !$self->{mandatory} |
3047
|
0
|
|
0
|
|
|
0
|
|| $self->is_locally_optional($prereq_pm, $need_module); |
3048
|
0
|
|
|
|
|
0
|
push @need, [$need_module,$needed_as,$optional]; |
3049
|
|
|
|
|
|
|
} |
3050
|
0
|
|
|
|
|
0
|
my @unfolded = map { "[".join(",",@$_)."]" } @need; |
|
0
|
|
|
|
|
0
|
|
3051
|
0
|
0
|
|
|
|
0
|
CPAN->debug("returning from unsat_prereq[@unfolded]") if $CPAN::DEBUG; |
3052
|
0
|
|
|
|
|
0
|
@need; |
3053
|
|
|
|
|
|
|
} |
3054
|
|
|
|
|
|
|
|
3055
|
|
|
|
|
|
|
sub _fulfills_all_version_rqs { |
3056
|
0
|
|
|
0
|
|
0
|
my($self,$need_module,$available_file,$available_version,$need_version) = @_; |
3057
|
0
|
|
|
|
|
0
|
my(@all_requirements) = split /\s*,\s*/, $need_version; |
3058
|
0
|
|
|
|
|
0
|
local($^W) = 0; |
3059
|
0
|
|
|
|
|
0
|
my $ok = 0; |
3060
|
0
|
|
|
|
|
0
|
RQ: for my $rq (@all_requirements) { |
3061
|
0
|
0
|
|
|
|
0
|
if ($rq =~ s|>=\s*||) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3062
|
|
|
|
|
|
|
} elsif ($rq =~ s|>\s*||) { |
3063
|
|
|
|
|
|
|
# 2005-12: one user |
3064
|
0
|
0
|
|
|
|
0
|
if (CPAN::Version->vgt($available_version,$rq)) { |
3065
|
0
|
|
|
|
|
0
|
$ok++; |
3066
|
|
|
|
|
|
|
} |
3067
|
0
|
|
|
|
|
0
|
next RQ; |
3068
|
|
|
|
|
|
|
} elsif ($rq =~ s|!=\s*||) { |
3069
|
|
|
|
|
|
|
# 2005-12: no user |
3070
|
0
|
0
|
|
|
|
0
|
if (CPAN::Version->vcmp($available_version,$rq)) { |
3071
|
0
|
|
|
|
|
0
|
$ok++; |
3072
|
0
|
|
|
|
|
0
|
next RQ; |
3073
|
|
|
|
|
|
|
} else { |
3074
|
0
|
|
|
|
|
0
|
$ok=0; |
3075
|
0
|
|
|
|
|
0
|
last RQ; |
3076
|
|
|
|
|
|
|
} |
3077
|
|
|
|
|
|
|
} elsif ($rq =~ m|<=?\s*|) { |
3078
|
|
|
|
|
|
|
# 2005-12: no user |
3079
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Downgrading not supported (rq[$rq])\n"); |
3080
|
0
|
|
|
|
|
0
|
$ok++; |
3081
|
0
|
|
|
|
|
0
|
next RQ; |
3082
|
|
|
|
|
|
|
} elsif ($rq =~ s|==\s*||) { |
3083
|
|
|
|
|
|
|
# 2009-07: ELLIOTJS/Perl-Critic-1.099_002.tar.gz |
3084
|
0
|
0
|
|
|
|
0
|
if (CPAN::Version->vcmp($available_version,$rq)) { |
3085
|
0
|
|
|
|
|
0
|
$ok=0; |
3086
|
0
|
|
|
|
|
0
|
last RQ; |
3087
|
|
|
|
|
|
|
} else { |
3088
|
0
|
|
|
|
|
0
|
$ok++; |
3089
|
0
|
|
|
|
|
0
|
next RQ; |
3090
|
|
|
|
|
|
|
} |
3091
|
|
|
|
|
|
|
} |
3092
|
0
|
0
|
|
|
|
0
|
if (! CPAN::Version->vgt($rq, $available_version)) { |
3093
|
0
|
|
|
|
|
0
|
$ok++; |
3094
|
|
|
|
|
|
|
} |
3095
|
0
|
0
|
|
|
|
0
|
CPAN->debug(sprintf("need_module[%s]available_file[%s]". |
3096
|
|
|
|
|
|
|
"available_version[%s]rq[%s]ok[%d]", |
3097
|
|
|
|
|
|
|
$need_module, |
3098
|
|
|
|
|
|
|
$available_file, |
3099
|
|
|
|
|
|
|
$available_version, |
3100
|
|
|
|
|
|
|
CPAN::Version->readable($rq), |
3101
|
|
|
|
|
|
|
$ok, |
3102
|
|
|
|
|
|
|
)) if $CPAN::DEBUG; |
3103
|
|
|
|
|
|
|
} |
3104
|
0
|
|
|
|
|
0
|
my $ret = $ok == @all_requirements; |
3105
|
0
|
0
|
|
|
|
0
|
CPAN->debug(sprintf("need_module[%s]ok[%s]all_requirements[%d]",$need_module, $ok, scalar @all_requirements)) if $CPAN::DEBUG; |
3106
|
0
|
|
|
|
|
0
|
return $ret; |
3107
|
|
|
|
|
|
|
} |
3108
|
|
|
|
|
|
|
|
3109
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::read_meta |
3110
|
|
|
|
|
|
|
# read any sort of meta files, return CPAN::Meta object if no errors |
3111
|
|
|
|
|
|
|
sub read_meta { |
3112
|
30
|
|
|
30
|
0
|
108
|
my($self) = @_; |
3113
|
30
|
100
|
|
|
|
61
|
my $meta_file = $self->pick_meta_file |
3114
|
|
|
|
|
|
|
or return; |
3115
|
|
|
|
|
|
|
|
3116
|
28
|
50
|
|
|
|
56
|
return unless $CPAN::META->has_usable("CPAN::Meta"); |
3117
|
28
|
50
|
|
|
|
32
|
my $meta = eval { CPAN::Meta->load_file($meta_file)} |
|
28
|
|
|
|
|
99
|
|
3118
|
|
|
|
|
|
|
or return; |
3119
|
|
|
|
|
|
|
|
3120
|
|
|
|
|
|
|
# Very old EU::MM could have wrong META |
3121
|
28
|
50
|
33
|
|
|
190480
|
if ($meta_file eq 'META.yml' |
3122
|
|
|
|
|
|
|
&& $meta->generated_by =~ /ExtUtils::MakeMaker version ([\d\._]+)/ |
3123
|
|
|
|
|
|
|
) { |
3124
|
0
|
|
|
|
|
0
|
my $eummv = do { local $^W = 0; $1+0; }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
3125
|
0
|
0
|
|
|
|
0
|
return if $eummv < 6.2501; |
3126
|
|
|
|
|
|
|
} |
3127
|
|
|
|
|
|
|
|
3128
|
28
|
|
|
|
|
83
|
return $meta; |
3129
|
|
|
|
|
|
|
} |
3130
|
|
|
|
|
|
|
|
3131
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::read_yaml ; |
3132
|
|
|
|
|
|
|
# XXX This should be DEPRECATED -- dagolden, 2011-02-05 |
3133
|
|
|
|
|
|
|
sub read_yaml { |
3134
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
3135
|
0
|
|
|
|
|
0
|
my $meta_file = $self->pick_meta_file('\.yml$'); |
3136
|
0
|
0
|
|
|
|
0
|
$self->debug("meta_file[$meta_file]") if $CPAN::DEBUG; |
3137
|
0
|
0
|
|
|
|
0
|
return unless $meta_file; |
3138
|
0
|
|
|
|
|
0
|
my $yaml; |
3139
|
0
|
|
|
|
|
0
|
eval { $yaml = $self->parse_meta_yml($meta_file) }; |
|
0
|
|
|
|
|
0
|
|
3140
|
0
|
0
|
0
|
|
|
0
|
if ($@ or ! $yaml) { |
3141
|
0
|
|
|
|
|
0
|
return undef; # if we die, then we cannot read YAML's own META.yml |
3142
|
|
|
|
|
|
|
} |
3143
|
|
|
|
|
|
|
# not "authoritative" |
3144
|
0
|
0
|
0
|
|
|
0
|
if (defined $yaml && (! ref $yaml || ref $yaml ne "HASH")) { |
|
|
|
0
|
|
|
|
|
3145
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("META.yml does not seem to be conforming, cannot use it.\n"); |
3146
|
0
|
|
|
|
|
0
|
$yaml = undef; |
3147
|
|
|
|
|
|
|
} |
3148
|
0
|
0
|
0
|
|
|
0
|
$self->debug(sprintf "yaml[%s]", $yaml || "UNDEF") |
3149
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
3150
|
0
|
0
|
0
|
|
|
0
|
$self->debug($yaml) if $CPAN::DEBUG && $yaml; |
3151
|
|
|
|
|
|
|
# MYMETA.yml is static and authoritative by definition |
3152
|
0
|
0
|
|
|
|
0
|
if ( $meta_file =~ /MYMETA\.yml/ ) { |
3153
|
0
|
|
|
|
|
0
|
return $yaml; |
3154
|
|
|
|
|
|
|
} |
3155
|
|
|
|
|
|
|
# META.yml is authoritative only if dynamic_config is defined and false |
3156
|
0
|
0
|
0
|
|
|
0
|
if ( defined $yaml->{dynamic_config} && ! $yaml->{dynamic_config} ) { |
3157
|
0
|
|
|
|
|
0
|
return $yaml; |
3158
|
|
|
|
|
|
|
} |
3159
|
|
|
|
|
|
|
# otherwise, we can't use what we found |
3160
|
0
|
|
|
|
|
0
|
return undef; |
3161
|
|
|
|
|
|
|
} |
3162
|
|
|
|
|
|
|
|
3163
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::configure_requires ; |
3164
|
|
|
|
|
|
|
sub configure_requires { |
3165
|
0
|
|
|
0
|
0
|
0
|
my($self) = @_; |
3166
|
0
|
0
|
|
|
|
0
|
return unless my $meta_file = $self->pick_meta_file('^META'); |
3167
|
0
|
0
|
|
|
|
0
|
if (my $meta_obj = $self->read_meta) { |
3168
|
0
|
|
|
|
|
0
|
my $prereqs = $meta_obj->effective_prereqs; |
3169
|
0
|
|
|
|
|
0
|
my $cr = $prereqs->requirements_for(qw/configure requires/); |
3170
|
0
|
0
|
|
|
|
0
|
return $cr ? $cr->as_string_hash : undef; |
3171
|
|
|
|
|
|
|
} |
3172
|
|
|
|
|
|
|
else { |
3173
|
0
|
|
|
|
|
0
|
my $yaml = eval { $self->parse_meta_yml($meta_file) }; |
|
0
|
|
|
|
|
0
|
|
3174
|
0
|
|
|
|
|
0
|
return $yaml->{configure_requires}; |
3175
|
|
|
|
|
|
|
} |
3176
|
|
|
|
|
|
|
} |
3177
|
|
|
|
|
|
|
|
3178
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::prereq_pm ; |
3179
|
|
|
|
|
|
|
sub prereq_pm { |
3180
|
8
|
|
|
8
|
0
|
76
|
my($self) = @_; |
3181
|
|
|
|
|
|
|
return unless $self->{writemakefile} # no need to have succeeded |
3182
|
|
|
|
|
|
|
# but we must have run it |
3183
|
8
|
0
|
33
|
|
|
25
|
|| $self->{modulebuild}; |
3184
|
8
|
50
|
|
|
|
24
|
unless ($self->{build_dir}) { |
3185
|
0
|
|
|
|
|
0
|
return; |
3186
|
|
|
|
|
|
|
} |
3187
|
|
|
|
|
|
|
# no Makefile/Build means configuration aborted, so don't look for prereqs |
3188
|
8
|
50
|
|
|
|
164
|
my $makefile = File::Spec->catfile($self->{build_dir}, $^O eq 'VMS' ? 'descrip.mms' : 'Makefile'); |
3189
|
8
|
50
|
|
|
|
57
|
my $buildfile = File::Spec->catfile($self->{build_dir}, $^O eq 'VMS' ? 'Build.com' : 'Build'); |
3190
|
8
|
50
|
33
|
|
|
189
|
return unless -f $makefile || -f $buildfile; |
3191
|
|
|
|
|
|
|
CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]", |
3192
|
|
|
|
|
|
|
$self->{writemakefile}||"", |
3193
|
8
|
50
|
0
|
|
|
17
|
$self->{modulebuild}||"", |
|
|
|
0
|
|
|
|
|
3194
|
|
|
|
|
|
|
) if $CPAN::DEBUG; |
3195
|
8
|
|
|
|
|
8
|
my($req,$breq, $opt_req, $opt_breq); |
3196
|
8
|
|
|
|
|
28
|
my $meta_obj = $self->read_meta; |
3197
|
|
|
|
|
|
|
# META/MYMETA is only authoritative if dynamic_config is false |
3198
|
8
|
50
|
33
|
|
|
46
|
if ($meta_obj && ! $meta_obj->dynamic_config) { |
|
|
0
|
|
|
|
|
|
3199
|
8
|
|
|
|
|
60
|
my $prereqs = $meta_obj->effective_prereqs; |
3200
|
8
|
|
|
|
|
12489
|
my $requires = $prereqs->requirements_for(qw/runtime requires/); |
3201
|
8
|
|
|
|
|
221
|
my $build_requires = $prereqs->requirements_for(qw/build requires/); |
3202
|
8
|
|
|
|
|
161
|
my $test_requires = $prereqs->requirements_for(qw/test requires/); |
3203
|
|
|
|
|
|
|
# XXX we don't yet distinguish build vs test, so merge them for now |
3204
|
8
|
|
|
|
|
151
|
$build_requires->add_requirements($test_requires); |
3205
|
8
|
|
|
|
|
308
|
$req = $requires->as_string_hash; |
3206
|
8
|
|
|
|
|
174
|
$breq = $build_requires->as_string_hash; |
3207
|
|
|
|
|
|
|
|
3208
|
|
|
|
|
|
|
# XXX assemble optional_req && optional_breq from recommends/suggests |
3209
|
|
|
|
|
|
|
# depending on corresponding policies -- xdg, 2012-04-01 |
3210
|
8
|
|
|
|
|
116
|
CPAN->use_inst("CPAN::Meta::Requirements"); |
3211
|
8
|
|
|
|
|
19
|
my $opt_runtime = CPAN::Meta::Requirements->new; |
3212
|
8
|
|
|
|
|
71
|
my $opt_build = CPAN::Meta::Requirements->new; |
3213
|
8
|
50
|
|
|
|
60
|
if ( $CPAN::Config->{recommends_policy} ) { |
3214
|
0
|
|
|
|
|
0
|
$opt_runtime->add_requirements( $prereqs->requirements_for(qw/runtime recommends/)); |
3215
|
0
|
|
|
|
|
0
|
$opt_build->add_requirements( $prereqs->requirements_for(qw/build recommends/)); |
3216
|
0
|
|
|
|
|
0
|
$opt_build->add_requirements( $prereqs->requirements_for(qw/test recommends/)); |
3217
|
|
|
|
|
|
|
|
3218
|
|
|
|
|
|
|
} |
3219
|
8
|
50
|
|
|
|
18
|
if ( $CPAN::Config->{suggests_policy} ) { |
3220
|
0
|
|
|
|
|
0
|
$opt_runtime->add_requirements( $prereqs->requirements_for(qw/runtime suggests/)); |
3221
|
0
|
|
|
|
|
0
|
$opt_build->add_requirements( $prereqs->requirements_for(qw/build suggests/)); |
3222
|
0
|
|
|
|
|
0
|
$opt_build->add_requirements( $prereqs->requirements_for(qw/test suggests/)); |
3223
|
|
|
|
|
|
|
} |
3224
|
8
|
|
|
|
|
19
|
$opt_req = $opt_runtime->as_string_hash; |
3225
|
8
|
|
|
|
|
47
|
$opt_breq = $opt_build->as_string_hash; |
3226
|
|
|
|
|
|
|
} |
3227
|
|
|
|
|
|
|
elsif (my $yaml = $self->read_yaml) { # often dynamic_config prevents a result here |
3228
|
0
|
|
0
|
|
|
0
|
$req = $yaml->{requires} || {}; |
3229
|
0
|
|
0
|
|
|
0
|
$breq = $yaml->{build_requires} || {}; |
3230
|
0
|
0
|
|
|
|
0
|
if ( $CPAN::Config->{recommends_policy} ) { |
3231
|
0
|
|
0
|
|
|
0
|
$opt_req = $yaml->{recommends} || {}; |
3232
|
|
|
|
|
|
|
} |
3233
|
0
|
0
|
0
|
|
|
0
|
undef $req unless ref $req eq "HASH" && %$req; |
3234
|
0
|
0
|
|
|
|
0
|
if ($req) { |
3235
|
0
|
0
|
0
|
|
|
0
|
if ($yaml->{generated_by} && |
3236
|
|
|
|
|
|
|
$yaml->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) { |
3237
|
0
|
|
|
|
|
0
|
my $eummv = do { local $^W = 0; $1+0; }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
3238
|
0
|
0
|
|
|
|
0
|
if ($eummv < 6.2501) { |
3239
|
|
|
|
|
|
|
# thanks to Slaven for digging that out: MM before |
3240
|
|
|
|
|
|
|
# that could be wrong because it could reflect a |
3241
|
|
|
|
|
|
|
# previous release |
3242
|
0
|
|
|
|
|
0
|
undef $req; |
3243
|
|
|
|
|
|
|
} |
3244
|
|
|
|
|
|
|
} |
3245
|
0
|
|
|
|
|
0
|
my $areq; |
3246
|
|
|
|
|
|
|
my $do_replace; |
3247
|
0
|
0
|
|
|
|
0
|
foreach my $k (sort keys %{$req||{}}) { |
|
0
|
|
|
|
|
0
|
|
3248
|
0
|
|
|
|
|
0
|
my $v = $req->{$k}; |
3249
|
0
|
0
|
|
|
|
0
|
next unless defined $v; |
3250
|
0
|
0
|
0
|
|
|
0
|
if ($v =~ /\d/) { |
|
|
0
|
0
|
|
|
|
|
3251
|
0
|
|
|
|
|
0
|
$areq->{$k} = $v; |
3252
|
|
|
|
|
|
|
} elsif ($k =~ /[A-Za-z]/ && |
3253
|
|
|
|
|
|
|
$v =~ /[A-Za-z]/ && |
3254
|
|
|
|
|
|
|
$CPAN::META->exists("CPAN::Module",$v) |
3255
|
|
|
|
|
|
|
) { |
3256
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarn("Suspicious key-value pair in META.yml's ". |
3257
|
|
|
|
|
|
|
"requires hash: $k => $v; I'll take both ". |
3258
|
|
|
|
|
|
|
"key and value as a module name\n"); |
3259
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mysleep(1); |
3260
|
0
|
|
|
|
|
0
|
$areq->{$k} = 0; |
3261
|
0
|
|
|
|
|
0
|
$areq->{$v} = 0; |
3262
|
0
|
|
|
|
|
0
|
$do_replace++; |
3263
|
|
|
|
|
|
|
} |
3264
|
|
|
|
|
|
|
} |
3265
|
0
|
0
|
|
|
|
0
|
$req = $areq if $do_replace; |
3266
|
|
|
|
|
|
|
} |
3267
|
|
|
|
|
|
|
} |
3268
|
|
|
|
|
|
|
else { |
3269
|
0
|
|
|
|
|
0
|
$CPAN::Frontend->mywarnonce("Could not read metadata file. Falling back to other ". |
3270
|
|
|
|
|
|
|
"methods to determine prerequisites\n"); |
3271
|
|
|
|
|
|
|
} |
3272
|
|
|
|
|
|
|
|
3273
|
8
|
50
|
33
|
|
|
144
|
unless ($req || $breq) { |
3274
|
0
|
|
|
|
|
0
|
my $build_dir; |
3275
|
0
|
0
|
|
|
|
0
|
unless ( $build_dir = $self->{build_dir} ) { |
3276
|
0
|
|
|
|
|
0
|
return; |
3277
|
|
|
|
|
|
|
} |
3278
|
0
|
|
|
|
|
0
|
my $makefile = File::Spec->catfile($build_dir,"Makefile"); |
3279
|
0
|
|
|
|
|
0
|
my $fh; |
3280
|
0
|
0
|
0
|
|
|
0
|
if (-f $makefile |
3281
|
|
|
|
|
|
|
and |
3282
|
|
|
|
|
|
|
$fh = FileHandle->new("<$makefile\0")) { |
3283
|
0
|
0
|
|
|
|
0
|
CPAN->debug("Getting prereq from Makefile") if $CPAN::DEBUG; |
3284
|
0
|
|
|
|
|
0
|
local($/) = "\n"; |
3285
|
0
|
|
|
|
|
0
|
while (<$fh>) { |
3286
|
0
|
0
|
|
|
|
0
|
last if /MakeMaker post_initialize section/; |
3287
|
0
|
|
|
|
|
0
|
my($p) = m{^[\#] |
3288
|
|
|
|
|
|
|
\s+PREREQ_PM\s+=>\s+(.+) |
3289
|
|
|
|
|
|
|
}x; |
3290
|
0
|
0
|
|
|
|
0
|
next unless $p; |
3291
|
|
|
|
|
|
|
# warn "Found prereq expr[$p]"; |
3292
|
|
|
|
|
|
|
|
3293
|
|
|
|
|
|
|
# Regexp modified by A.Speer to remember actual version of file |
3294
|
|
|
|
|
|
|
# PREREQ_PM hash key wants, then add to |
3295
|
0
|
|
|
|
|
0
|
while ( $p =~ m/(?:\s)([\w\:]+)=>(q\[.*?\]|undef),?/g ) { |
3296
|
0
|
|
|
|
|
0
|
my($m,$n) = ($1,$2); |
3297
|
|
|
|
|
|
|
# When a prereq is mentioned twice: let the bigger |
3298
|
|
|
|
|
|
|
# win; usual culprit is that they declared |
3299
|
|
|
|
|
|
|
# build_requires separately from requires; see |
3300
|
|
|
|
|
|
|
# rt.cpan.org #47774 |
3301
|
0
|
|
|
|
|
0
|
my($prevn); |
3302
|
0
|
0
|
|
|
|
0
|
if ( defined $req->{$m} ) { |
3303
|
0
|
|
|
|
|
0
|
$prevn = $req->{$m}; |
3304
|
|
|
|
|
|
|
} |
3305
|
0
|
0
|
|
|
|
0
|
if ($n =~ /^q\[(.*?)\]$/) { |
3306
|
0
|
|
|
|
|
0
|
$n = $1; |
3307
|
|
|
|
|
|
|
} |
3308
|
0
|
0
|
0
|
|
|
0
|
if (!$prevn || CPAN::Version->vlt($prevn, $n)){ |
3309
|
0
|
|
|
|
|
0
|
$req->{$m} = $n; |
3310
|
|
|
|
|
|
|
} |
3311
|
|
|
|
|
|
|
} |
3312
|
0
|
|
|
|
|
0
|
last; |
3313
|
|
|
|
|
|
|
} |
3314
|
|
|
|
|
|
|
} |
3315
|
|
|
|
|
|
|
} |
3316
|
8
|
50
|
33
|
|
|
21
|
unless ($req || $breq) { |
3317
|
0
|
0
|
|
|
|
0
|
my $build_dir = $self->{build_dir} or die "Panic: no build_dir?"; |
3318
|
0
|
|
|
|
|
0
|
my $buildfile = File::Spec->catfile($build_dir,"Build"); |
3319
|
0
|
0
|
|
|
|
0
|
if (-f $buildfile) { |
3320
|
0
|
0
|
|
|
|
0
|
CPAN->debug("Found '$buildfile'") if $CPAN::DEBUG; |
3321
|
0
|
|
|
|
|
0
|
my $build_prereqs = File::Spec->catfile($build_dir,"_build","prereqs"); |
3322
|
0
|
0
|
|
|
|
0
|
if (-f $build_prereqs) { |
3323
|
0
|
0
|
|
|
|
0
|
CPAN->debug("Getting prerequisites from '$build_prereqs'") if $CPAN::DEBUG; |
3324
|
0
|
|
|
|
|
0
|
my $content = do { local *FH; |
|
0
|
|
|
|
|
0
|
|
3325
|
0
|
0
|
|
|
|
0
|
open FH, $build_prereqs |
3326
|
|
|
|
|
|
|
or $CPAN::Frontend->mydie("Could not open ". |
3327
|
|
|
|
|
|
|
"'$build_prereqs': $!"); |
3328
|
0
|
|
|
|
|
0
|
local $/; |
3329
|
0
|
|
|
|
|
0
|
; |
3330
|
|
|
|
|
|
|
}; |
3331
|
0
|
|
|
|
|
0
|
my $bphash = eval $content; |
3332
|
0
|
0
|
|
|
|
0
|
if ($@) { |
3333
|
|
|
|
|
|
|
} else { |
3334
|
0
|
|
0
|
|
|
0
|
$req = $bphash->{requires} || +{}; |
3335
|
0
|
|
0
|
|
|
0
|
$breq = $bphash->{build_requires} || +{}; |
3336
|
|
|
|
|
|
|
} |
3337
|
|
|
|
|
|
|
} |
3338
|
|
|
|
|
|
|
} |
3339
|
|
|
|
|
|
|
} |
3340
|
|
|
|
|
|
|
# XXX needs to be adapted for optional_req & optional_breq -- xdg, 2012-04-01 |
3341
|
8
|
50
|
33
|
|
|
47
|
if ($req || $breq || $opt_req || $opt_breq ) { |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
3342
|
|
|
|
|
|
|
return $self->{prereq_pm} = { |
3343
|
8
|
|
|
|
|
116
|
requires => $req, |
3344
|
|
|
|
|
|
|
build_requires => $breq, |
3345
|
|
|
|
|
|
|
opt_requires => $opt_req, |
3346
|
|
|
|
|
|
|
opt_build_requires => $opt_breq, |
3347
|
|
|
|
|
|
|
}; |
3348
|
|
|
|
|
|
|
} |
3349
|
|
|
|
|
|
|
} |
3350
|
|
|
|
|
|
|
|
3351
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::shortcut_test ; |
3352
|
|
|
|
|
|
|
# return values: undef means don't shortcut; 0 means shortcut as fail; |
3353
|
|
|
|
|
|
|
# and 1 means shortcut as success |
3354
|
|
|
|
|
|
|
sub shortcut_test { |
3355
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
3356
|
|
|
|
|
|
|
|
3357
|
0
|
0
|
|
|
|
|
$self->debug("checking badtestcnt[$self->{ID}]") if $CPAN::DEBUG; |
3358
|
0
|
|
0
|
|
|
|
$self->{badtestcnt} ||= 0; |
3359
|
0
|
0
|
|
|
|
|
if ($self->{badtestcnt} > 0) { |
3360
|
0
|
|
|
|
|
|
require Data::Dumper; |
3361
|
0
|
0
|
|
|
|
|
CPAN->debug(sprintf "NOREPEAT[%s]", Data::Dumper::Dumper($self)) if $CPAN::DEBUG; |
3362
|
0
|
|
|
|
|
|
return $self->goodbye("Won't repeat unsuccessful test during this command"); |
3363
|
|
|
|
|
|
|
} |
3364
|
|
|
|
|
|
|
|
3365
|
0
|
|
|
|
|
|
for my $slot ( qw/later configure_requires_later/ ) { |
3366
|
0
|
0
|
|
|
|
|
$self->debug("checking $slot slot[$self->{ID}]") if $CPAN::DEBUG; |
3367
|
|
|
|
|
|
|
return $self->success($self->{$slot}) |
3368
|
0
|
0
|
|
|
|
|
if $self->{$slot}; |
3369
|
|
|
|
|
|
|
} |
3370
|
|
|
|
|
|
|
|
3371
|
0
|
0
|
|
|
|
|
$self->debug("checking if tests passed[$self->{ID}]") if $CPAN::DEBUG; |
3372
|
0
|
0
|
|
|
|
|
if ( $self->{make_test} ) { |
3373
|
0
|
0
|
|
|
|
|
if ( |
|
|
0
|
|
|
|
|
|
3374
|
|
|
|
|
|
|
UNIVERSAL::can($self->{make_test},"failed") ? |
3375
|
|
|
|
|
|
|
$self->{make_test}->failed : |
3376
|
|
|
|
|
|
|
$self->{make_test} =~ /^NO/ |
3377
|
|
|
|
|
|
|
) { |
3378
|
0
|
0
|
0
|
|
|
|
if ( |
3379
|
|
|
|
|
|
|
UNIVERSAL::can($self->{make_test},"commandid") |
3380
|
|
|
|
|
|
|
&& |
3381
|
|
|
|
|
|
|
$self->{make_test}->commandid == $CPAN::CurrentCommandId |
3382
|
|
|
|
|
|
|
) { |
3383
|
0
|
|
|
|
|
|
return $self->goodbye("Has already been tested within this command"); |
3384
|
|
|
|
|
|
|
} |
3385
|
|
|
|
|
|
|
} else { |
3386
|
|
|
|
|
|
|
# if global "is_tested" has been cleared, we need to mark this to |
3387
|
|
|
|
|
|
|
# be added to PERL5LIB if not already installed |
3388
|
0
|
0
|
|
|
|
|
if ($self->tested_ok_but_not_installed) { |
3389
|
0
|
|
|
|
|
|
$CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME}); |
3390
|
|
|
|
|
|
|
} |
3391
|
0
|
|
|
|
|
|
return $self->success("Has already been tested successfully"); |
3392
|
|
|
|
|
|
|
} |
3393
|
|
|
|
|
|
|
} |
3394
|
|
|
|
|
|
|
|
3395
|
0
|
0
|
|
|
|
|
if ($self->{notest}) { |
3396
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new("YES"); |
3397
|
0
|
|
|
|
|
|
return $self->success("Skipping test because of notest pragma"); |
3398
|
|
|
|
|
|
|
} |
3399
|
|
|
|
|
|
|
|
3400
|
0
|
|
|
|
|
|
return undef; # no shortcut |
3401
|
|
|
|
|
|
|
} |
3402
|
|
|
|
|
|
|
|
3403
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::_exe_files ; |
3404
|
|
|
|
|
|
|
sub _exe_files { |
3405
|
0
|
|
|
0
|
|
|
my($self) = @_; |
3406
|
|
|
|
|
|
|
return unless $self->{writemakefile} # no need to have succeeded |
3407
|
|
|
|
|
|
|
# but we must have run it |
3408
|
0
|
0
|
0
|
|
|
|
|| $self->{modulebuild}; |
3409
|
0
|
0
|
|
|
|
|
unless ($self->{build_dir}) { |
3410
|
0
|
|
|
|
|
|
return; |
3411
|
|
|
|
|
|
|
} |
3412
|
|
|
|
|
|
|
CPAN->debug(sprintf "writemakefile[%s]modulebuild[%s]", |
3413
|
|
|
|
|
|
|
$self->{writemakefile}||"", |
3414
|
0
|
0
|
0
|
|
|
|
$self->{modulebuild}||"", |
|
|
|
0
|
|
|
|
|
3415
|
|
|
|
|
|
|
) if $CPAN::DEBUG; |
3416
|
0
|
|
|
|
|
|
my $build_dir; |
3417
|
0
|
0
|
|
|
|
|
unless ( $build_dir = $self->{build_dir} ) { |
3418
|
0
|
|
|
|
|
|
return; |
3419
|
|
|
|
|
|
|
} |
3420
|
0
|
|
|
|
|
|
my $makefile = File::Spec->catfile($build_dir,"Makefile"); |
3421
|
0
|
|
|
|
|
|
my $fh; |
3422
|
|
|
|
|
|
|
my @exe_files; |
3423
|
0
|
0
|
0
|
|
|
|
if (-f $makefile |
3424
|
|
|
|
|
|
|
and |
3425
|
|
|
|
|
|
|
$fh = FileHandle->new("<$makefile\0")) { |
3426
|
0
|
0
|
|
|
|
|
CPAN->debug("Getting exefiles from Makefile") if $CPAN::DEBUG; |
3427
|
0
|
|
|
|
|
|
local($/) = "\n"; |
3428
|
0
|
|
|
|
|
|
while (<$fh>) { |
3429
|
0
|
0
|
|
|
|
|
last if /MakeMaker post_initialize section/; |
3430
|
0
|
|
|
|
|
|
my($p) = m{^[\#] |
3431
|
|
|
|
|
|
|
\s+EXE_FILES\s+=>\s+\[(.+)\] |
3432
|
|
|
|
|
|
|
}x; |
3433
|
0
|
0
|
|
|
|
|
next unless $p; |
3434
|
|
|
|
|
|
|
# warn "Found exefiles expr[$p]"; |
3435
|
0
|
|
|
|
|
|
my @p = split /,\s*/, $p; |
3436
|
0
|
|
|
|
|
|
for my $p2 (@p) { |
3437
|
0
|
0
|
|
|
|
|
if ($p2 =~ /^q\[(.+)\]/) { |
3438
|
0
|
|
|
|
|
|
push @exe_files, $1; |
3439
|
|
|
|
|
|
|
} |
3440
|
|
|
|
|
|
|
} |
3441
|
|
|
|
|
|
|
} |
3442
|
|
|
|
|
|
|
} |
3443
|
0
|
0
|
|
|
|
|
return \@exe_files if @exe_files; |
3444
|
0
|
|
|
|
|
|
my $buildparams = File::Spec->catfile($build_dir,"_build","build_params"); |
3445
|
0
|
0
|
|
|
|
|
if (-f $buildparams) { |
3446
|
0
|
0
|
|
|
|
|
CPAN->debug("Found '$buildparams'") if $CPAN::DEBUG; |
3447
|
0
|
|
|
|
|
|
my $x = do $buildparams; |
3448
|
0
|
0
|
|
|
|
|
for my $sf (@{$x->[2]{script_files} || []}) { |
|
0
|
|
|
|
|
|
|
3449
|
0
|
|
|
|
|
|
push @exe_files, $sf; |
3450
|
|
|
|
|
|
|
} |
3451
|
|
|
|
|
|
|
} |
3452
|
0
|
|
|
|
|
|
return \@exe_files; |
3453
|
|
|
|
|
|
|
} |
3454
|
|
|
|
|
|
|
|
3455
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::test ; |
3456
|
|
|
|
|
|
|
sub test { |
3457
|
0
|
|
|
0
|
0
|
|
my($self) = @_; |
3458
|
|
|
|
|
|
|
|
3459
|
0
|
|
|
|
|
|
$self->pre_test(); |
3460
|
|
|
|
|
|
|
|
3461
|
0
|
0
|
|
|
|
|
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG; |
3462
|
0
|
0
|
|
|
|
|
if (my $goto = $self->prefs->{goto}) { |
3463
|
0
|
|
|
|
|
|
return $self->goto($goto); |
3464
|
|
|
|
|
|
|
} |
3465
|
|
|
|
|
|
|
|
3466
|
|
|
|
|
|
|
$self->make |
3467
|
0
|
0
|
|
|
|
|
or return; |
3468
|
|
|
|
|
|
|
|
3469
|
0
|
0
|
|
|
|
|
if ( defined( my $sc = $self->shortcut_test ) ) { |
3470
|
0
|
|
|
|
|
|
return $sc; |
3471
|
|
|
|
|
|
|
} |
3472
|
|
|
|
|
|
|
|
3473
|
0
|
0
|
|
|
|
|
if ($CPAN::Signal) { |
3474
|
0
|
|
|
|
|
|
delete $self->{force_update}; |
3475
|
0
|
|
|
|
|
|
return; |
3476
|
|
|
|
|
|
|
} |
3477
|
|
|
|
|
|
|
# warn "XDEBUG: checking for notest: $self->{notest} $self"; |
3478
|
0
|
0
|
|
|
|
|
my $make = $self->{modulebuild} ? "Build" : "make"; |
3479
|
|
|
|
|
|
|
|
3480
|
|
|
|
|
|
|
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) |
3481
|
|
|
|
|
|
|
? $ENV{PERL5LIB} |
3482
|
0
|
0
|
0
|
|
|
|
: ($ENV{PERLLIB} || ""); |
3483
|
|
|
|
|
|
|
|
3484
|
0
|
0
|
|
|
|
|
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; |
3485
|
0
|
|
|
|
|
|
$CPAN::META->set_perl5lib; |
3486
|
0
|
|
|
|
|
|
local $ENV{MAKEFLAGS}; # protect us from outer make calls |
3487
|
0
|
0
|
|
|
|
|
local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default}; |
3488
|
0
|
0
|
|
|
|
|
local $ENV{NONINTERACTIVE_TESTING} = 1 if $CPAN::Config->{use_prompt_default}; |
3489
|
|
|
|
|
|
|
|
3490
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("Running $make test\n"); |
3491
|
|
|
|
|
|
|
|
3492
|
0
|
0
|
|
|
|
|
my $builddir = $self->dir or |
3493
|
|
|
|
|
|
|
$CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n"); |
3494
|
|
|
|
|
|
|
|
3495
|
0
|
0
|
|
|
|
|
unless (chdir $builddir) { |
3496
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!"); |
3497
|
0
|
|
|
|
|
|
return; |
3498
|
|
|
|
|
|
|
} |
3499
|
|
|
|
|
|
|
|
3500
|
0
|
0
|
|
|
|
|
$self->debug("Changed directory to $self->{build_dir}") |
3501
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
3502
|
|
|
|
|
|
|
|
3503
|
0
|
0
|
|
|
|
|
if ($^O eq 'MacOS') { |
3504
|
0
|
|
|
|
|
|
Mac::BuildTools::make_test($self); |
3505
|
0
|
|
|
|
|
|
return; |
3506
|
|
|
|
|
|
|
} |
3507
|
|
|
|
|
|
|
|
3508
|
0
|
0
|
|
|
|
|
if ($self->{modulebuild}) { |
3509
|
0
|
|
|
|
|
|
my $thm = CPAN::Shell->expand("Module","Test::Harness"); |
3510
|
0
|
|
|
|
|
|
my $v = $thm->inst_version; |
3511
|
0
|
0
|
|
|
|
|
if (CPAN::Version->vlt($v,2.62)) { |
3512
|
|
|
|
|
|
|
# XXX Eric Wilhelm reported this as a bug: klapperl: |
3513
|
|
|
|
|
|
|
# Test::Harness 3.0 self-tests, so that should be 'unless |
3514
|
|
|
|
|
|
|
# installing Test::Harness' |
3515
|
0
|
0
|
|
|
|
|
unless ($self->id eq $thm->distribution->id) { |
3516
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn(qq{The version of your Test::Harness is only |
3517
|
|
|
|
|
|
|
'$v', you need at least '2.62'. Please upgrade your Test::Harness.\n}); |
3518
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new("NO Test::Harness too old"); |
3519
|
0
|
|
|
|
|
|
return; |
3520
|
|
|
|
|
|
|
} |
3521
|
|
|
|
|
|
|
} |
3522
|
|
|
|
|
|
|
} |
3523
|
|
|
|
|
|
|
|
3524
|
0
|
0
|
|
|
|
|
if ( ! $self->{force_update} ) { |
3525
|
|
|
|
|
|
|
# bypass actual tests if "trust_test_report_history" and have a report |
3526
|
0
|
|
|
|
|
|
my $have_tested_fcn; |
3527
|
0
|
0
|
0
|
|
|
|
if ( $CPAN::Config->{trust_test_report_history} |
|
|
|
0
|
|
|
|
|
3528
|
|
|
|
|
|
|
&& $CPAN::META->has_inst("CPAN::Reporter::History") |
3529
|
|
|
|
|
|
|
&& ( $have_tested_fcn = CPAN::Reporter::History->can("have_tested" ))) { |
3530
|
0
|
0
|
|
|
|
|
if ( my @reports = $have_tested_fcn->( dist => $self->base_id ) ) { |
3531
|
|
|
|
|
|
|
# Do nothing if grade was DISCARD |
3532
|
0
|
0
|
|
|
|
|
if ( $reports[-1]->{grade} =~ /^(?:PASS|UNKNOWN)$/ ) { |
|
|
0
|
|
|
|
|
|
3533
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new("YES"); |
3534
|
|
|
|
|
|
|
# if global "is_tested" has been cleared, we need to mark this to |
3535
|
|
|
|
|
|
|
# be added to PERL5LIB if not already installed |
3536
|
0
|
0
|
|
|
|
|
if ($self->tested_ok_but_not_installed) { |
3537
|
0
|
|
|
|
|
|
$CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME}); |
3538
|
|
|
|
|
|
|
} |
3539
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("Found prior test report -- OK\n"); |
3540
|
0
|
|
|
|
|
|
return; |
3541
|
|
|
|
|
|
|
} |
3542
|
|
|
|
|
|
|
elsif ( $reports[-1]->{grade} =~ /^(?:FAIL|NA)$/ ) { |
3543
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new("NO"); |
3544
|
0
|
|
|
|
|
|
$self->{badtestcnt}++; |
3545
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Found prior test report -- NOT OK\n"); |
3546
|
0
|
|
|
|
|
|
return; |
3547
|
|
|
|
|
|
|
} |
3548
|
|
|
|
|
|
|
} |
3549
|
|
|
|
|
|
|
} |
3550
|
|
|
|
|
|
|
} |
3551
|
|
|
|
|
|
|
|
3552
|
0
|
|
|
|
|
|
my $system; |
3553
|
0
|
|
|
|
|
|
my $prefs_test = $self->prefs->{test}; |
3554
|
0
|
0
|
|
|
|
|
if (my $commandline |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
3555
|
|
|
|
|
|
|
= exists $prefs_test->{commandline} ? $prefs_test->{commandline} : "") { |
3556
|
0
|
|
|
|
|
|
$system = $commandline; |
3557
|
0
|
|
|
|
|
|
$ENV{PERL} = CPAN::find_perl(); |
3558
|
|
|
|
|
|
|
} elsif ($self->{modulebuild}) { |
3559
|
0
|
|
|
|
|
|
$system = sprintf "%s test", $self->_build_command(); |
3560
|
0
|
0
|
0
|
|
|
|
unless (-e "Build" || ($^O eq 'VMS' && -e "Build.com")) { |
|
|
|
0
|
|
|
|
|
3561
|
0
|
|
|
|
|
|
my $id = $self->pretty_id; |
3562
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Alert: no 'Build' file found while trying to test '$id'"); |
3563
|
|
|
|
|
|
|
} |
3564
|
|
|
|
|
|
|
} else { |
3565
|
0
|
|
|
|
|
|
$system = join " ", $self->_make_command(), "test"; |
3566
|
|
|
|
|
|
|
} |
3567
|
0
|
|
|
|
|
|
my $make_test_arg = $self->_make_phase_arg("test"); |
3568
|
0
|
0
|
|
|
|
|
$system = sprintf("%s%s", |
3569
|
|
|
|
|
|
|
$system, |
3570
|
|
|
|
|
|
|
$make_test_arg ? " $make_test_arg" : "", |
3571
|
|
|
|
|
|
|
); |
3572
|
0
|
|
|
|
|
|
my($tests_ok); |
3573
|
|
|
|
|
|
|
my $test_env; |
3574
|
0
|
0
|
|
|
|
|
if ($self->prefs->{test}) { |
3575
|
0
|
|
|
|
|
|
$test_env = $self->prefs->{test}{env}; |
3576
|
|
|
|
|
|
|
} |
3577
|
0
|
0
|
|
|
|
|
local @ENV{keys %$test_env} = values %$test_env if $test_env; |
3578
|
0
|
|
|
|
|
|
my $expect_model = $self->_prefs_with_expect("test"); |
3579
|
0
|
|
|
|
|
|
my $want_expect = 0; |
3580
|
0
|
0
|
0
|
|
|
|
if ( $expect_model && @{$expect_model->{talk}} ) { |
|
0
|
|
|
|
|
|
|
3581
|
0
|
|
|
|
|
|
my $can_expect = $CPAN::META->has_inst("Expect"); |
3582
|
0
|
0
|
|
|
|
|
if ($can_expect) { |
3583
|
0
|
|
|
|
|
|
$want_expect = 1; |
3584
|
|
|
|
|
|
|
} else { |
3585
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Expect not installed, falling back to ". |
3586
|
|
|
|
|
|
|
"testing without\n"); |
3587
|
|
|
|
|
|
|
} |
3588
|
|
|
|
|
|
|
} |
3589
|
0
|
0
|
|
|
|
|
if ($want_expect) { |
|
|
0
|
|
|
|
|
|
3590
|
0
|
0
|
|
|
|
|
if ($self->_should_report('test')) { |
3591
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ". |
3592
|
|
|
|
|
|
|
"not supported when distroprefs specify ". |
3593
|
|
|
|
|
|
|
"an interactive test\n"); |
3594
|
|
|
|
|
|
|
} |
3595
|
0
|
|
|
|
|
|
$tests_ok = $self->_run_via_expect($system,'test',$expect_model) == 0; |
3596
|
|
|
|
|
|
|
} elsif ( $self->_should_report('test') ) { |
3597
|
0
|
|
|
|
|
|
$tests_ok = CPAN::Reporter::test($self, $system); |
3598
|
|
|
|
|
|
|
} else { |
3599
|
0
|
|
|
|
|
|
$tests_ok = system($system) == 0; |
3600
|
|
|
|
|
|
|
} |
3601
|
0
|
|
|
|
|
|
$self->introduce_myself; |
3602
|
0
|
|
|
|
|
|
my $but = $self->_make_test_illuminate_prereqs(); |
3603
|
0
|
0
|
|
|
|
|
if ( $tests_ok ) { |
3604
|
0
|
0
|
|
|
|
|
if ($but) { |
3605
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Tests succeeded but $but\n"); |
3606
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new("NO $but"); |
3607
|
0
|
|
|
|
|
|
$self->store_persistent_state; |
3608
|
0
|
|
|
|
|
|
return $self->goodbye("[dependencies] -- NA"); |
3609
|
|
|
|
|
|
|
} |
3610
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(" $system -- OK\n"); |
3611
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new("YES"); |
3612
|
0
|
|
|
|
|
|
$CPAN::META->is_tested($self->{build_dir},$self->{make_test}{TIME}); |
3613
|
|
|
|
|
|
|
# probably impossible to need the next line because badtestcnt |
3614
|
|
|
|
|
|
|
# has a lifespan of one command |
3615
|
0
|
|
|
|
|
|
delete $self->{badtestcnt}; |
3616
|
|
|
|
|
|
|
} else { |
3617
|
0
|
0
|
|
|
|
|
if ($but) { |
|
|
0
|
|
|
|
|
|
3618
|
0
|
|
|
|
|
|
$but .= "; additionally test harness failed"; |
3619
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("$but\n"); |
3620
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new("NO $but"); |
3621
|
|
|
|
|
|
|
} elsif ( $self->{force_update} ) { |
3622
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new( |
3623
|
|
|
|
|
|
|
"NO but failure ignored because 'force' in effect" |
3624
|
|
|
|
|
|
|
); |
3625
|
|
|
|
|
|
|
} else { |
3626
|
0
|
|
|
|
|
|
$self->{make_test} = CPAN::Distrostatus->new("NO"); |
3627
|
|
|
|
|
|
|
} |
3628
|
0
|
|
|
|
|
|
$self->{badtestcnt}++; |
3629
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn(" $system -- NOT OK\n"); |
3630
|
0
|
|
|
|
|
|
CPAN::Shell->optprint |
3631
|
|
|
|
|
|
|
("hint", |
3632
|
|
|
|
|
|
|
sprintf |
3633
|
|
|
|
|
|
|
("//hint// to see the cpan-testers results for installing this module, try: |
3634
|
|
|
|
|
|
|
reports %s\n", |
3635
|
|
|
|
|
|
|
$self->pretty_id)); |
3636
|
|
|
|
|
|
|
} |
3637
|
0
|
|
|
|
|
|
$self->store_persistent_state; |
3638
|
|
|
|
|
|
|
|
3639
|
0
|
|
|
|
|
|
$self->post_test(); |
3640
|
|
|
|
|
|
|
|
3641
|
0
|
0
|
|
|
|
|
return $self->{force_update} ? 1 : !! $tests_ok; |
3642
|
|
|
|
|
|
|
} |
3643
|
|
|
|
|
|
|
|
3644
|
|
|
|
|
|
|
sub _make_test_illuminate_prereqs { |
3645
|
0
|
|
|
0
|
|
|
my($self) = @_; |
3646
|
0
|
|
|
|
|
|
my @prereq; |
3647
|
|
|
|
|
|
|
|
3648
|
|
|
|
|
|
|
# local $CPAN::DEBUG = 16; # Distribution |
3649
|
0
|
|
|
|
|
|
for my $m (sort keys %{$self->{sponsored_mods}}) { |
|
0
|
|
|
|
|
|
|
3650
|
0
|
0
|
|
|
|
|
next unless $self->{sponsored_mods}{$m} > 0; |
3651
|
0
|
0
|
|
|
|
|
my $m_obj = CPAN::Shell->expand("Module",$m) or next; |
3652
|
|
|
|
|
|
|
# XXX we need available_version which reflects |
3653
|
|
|
|
|
|
|
# $ENV{PERL5LIB} so that already tested but not yet |
3654
|
|
|
|
|
|
|
# installed modules are counted. |
3655
|
0
|
|
|
|
|
|
my $available_version = $m_obj->available_version; |
3656
|
0
|
|
|
|
|
|
my $available_file = $m_obj->available_file; |
3657
|
0
|
0
|
0
|
|
|
|
if ($available_version && |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
3658
|
|
|
|
|
|
|
!CPAN::Version->vlt($available_version,$self->{prereq_pm}{$m}) |
3659
|
|
|
|
|
|
|
) { |
3660
|
0
|
0
|
|
|
|
|
CPAN->debug("m[$m] good enough available_version[$available_version]") |
3661
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
3662
|
|
|
|
|
|
|
} elsif ($available_file |
3663
|
|
|
|
|
|
|
&& ( |
3664
|
|
|
|
|
|
|
!$self->{prereq_pm}{$m} |
3665
|
|
|
|
|
|
|
|| |
3666
|
|
|
|
|
|
|
$self->{prereq_pm}{$m} == 0 |
3667
|
|
|
|
|
|
|
) |
3668
|
|
|
|
|
|
|
) { |
3669
|
|
|
|
|
|
|
# lex Class::Accessor::Chained::Fast which has no $VERSION |
3670
|
0
|
0
|
|
|
|
|
CPAN->debug("m[$m] have available_file[$available_file]") |
3671
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
3672
|
|
|
|
|
|
|
} else { |
3673
|
|
|
|
|
|
|
push @prereq, $m |
3674
|
0
|
0
|
|
|
|
|
if $m_obj->{mandatory}; |
3675
|
|
|
|
|
|
|
} |
3676
|
|
|
|
|
|
|
} |
3677
|
0
|
|
|
|
|
|
my $but; |
3678
|
0
|
0
|
|
|
|
|
if (@prereq) { |
3679
|
0
|
|
|
|
|
|
my $cnt = @prereq; |
3680
|
0
|
|
|
|
|
|
my $which = join ",", @prereq; |
3681
|
0
|
0
|
|
|
|
|
$but = $cnt == 1 ? "one dependency not OK ($which)" : |
3682
|
|
|
|
|
|
|
"$cnt dependencies missing ($which)"; |
3683
|
|
|
|
|
|
|
} |
3684
|
0
|
|
|
|
|
|
$but; |
3685
|
|
|
|
|
|
|
} |
3686
|
|
|
|
|
|
|
|
3687
|
|
|
|
|
|
|
sub _prefs_with_expect { |
3688
|
0
|
|
|
0
|
|
|
my($self,$where) = @_; |
3689
|
0
|
0
|
|
|
|
|
return unless my $prefs = $self->prefs; |
3690
|
0
|
0
|
|
|
|
|
return unless my $where_prefs = $prefs->{$where}; |
3691
|
0
|
0
|
|
|
|
|
if ($where_prefs->{expect}) { |
|
|
0
|
|
|
|
|
|
3692
|
|
|
|
|
|
|
return { |
3693
|
|
|
|
|
|
|
mode => "deterministic", |
3694
|
|
|
|
|
|
|
timeout => 15, |
3695
|
|
|
|
|
|
|
talk => $where_prefs->{expect}, |
3696
|
0
|
|
|
|
|
|
}; |
3697
|
|
|
|
|
|
|
} elsif ($where_prefs->{"eexpect"}) { |
3698
|
0
|
|
|
|
|
|
return $where_prefs->{"eexpect"}; |
3699
|
|
|
|
|
|
|
} |
3700
|
0
|
|
|
|
|
|
return; |
3701
|
|
|
|
|
|
|
} |
3702
|
|
|
|
|
|
|
|
3703
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::clean ; |
3704
|
|
|
|
|
|
|
sub clean { |
3705
|
0
|
|
|
0
|
0
|
|
my($self) = @_; |
3706
|
0
|
0
|
|
|
|
|
my $make = $self->{modulebuild} ? "Build" : "make"; |
3707
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("Running $make clean\n"); |
3708
|
0
|
0
|
|
|
|
|
unless (exists $self->{archived}) { |
3709
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Distribution seems to have never been unzipped". |
3710
|
|
|
|
|
|
|
"/untarred, nothing done\n"); |
3711
|
0
|
|
|
|
|
|
return 1; |
3712
|
|
|
|
|
|
|
} |
3713
|
0
|
0
|
|
|
|
|
unless (exists $self->{build_dir}) { |
3714
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Distribution has no own directory, nothing to do.\n"); |
3715
|
0
|
|
|
|
|
|
return 1; |
3716
|
|
|
|
|
|
|
} |
3717
|
0
|
0
|
0
|
|
|
|
if (exists $self->{writemakefile} |
3718
|
|
|
|
|
|
|
and $self->{writemakefile}->failed |
3719
|
|
|
|
|
|
|
) { |
3720
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("No Makefile, don't know how to 'make clean'\n"); |
3721
|
0
|
|
|
|
|
|
return 1; |
3722
|
|
|
|
|
|
|
} |
3723
|
|
|
|
|
|
|
EXCUSE: { |
3724
|
0
|
|
|
|
|
|
my @e; |
|
0
|
|
|
|
|
|
|
3725
|
0
|
0
|
0
|
|
|
|
exists $self->{make_clean} and $self->{make_clean} eq "YES" and |
3726
|
|
|
|
|
|
|
push @e, "make clean already called once"; |
3727
|
0
|
0
|
0
|
|
|
|
$CPAN::Frontend->myprint(join "", map {" $_\n"} @e) and return if @e; |
|
0
|
|
|
|
|
|
|
3728
|
|
|
|
|
|
|
} |
3729
|
|
|
|
|
|
|
chdir $self->{build_dir} or |
3730
|
0
|
0
|
|
|
|
|
Carp::confess("Couldn't chdir to $self->{build_dir}: $!"); |
3731
|
0
|
0
|
|
|
|
|
$self->debug("Changed directory to $self->{build_dir}") if $CPAN::DEBUG; |
3732
|
|
|
|
|
|
|
|
3733
|
0
|
0
|
|
|
|
|
if ($^O eq 'MacOS') { |
3734
|
0
|
|
|
|
|
|
Mac::BuildTools::make_clean($self); |
3735
|
0
|
|
|
|
|
|
return; |
3736
|
|
|
|
|
|
|
} |
3737
|
|
|
|
|
|
|
|
3738
|
0
|
|
|
|
|
|
my $system; |
3739
|
0
|
0
|
|
|
|
|
if ($self->{modulebuild}) { |
3740
|
0
|
0
|
|
|
|
|
unless (-f "Build") { |
3741
|
0
|
|
|
|
|
|
my $cwd = CPAN::anycwd(); |
3742
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Alert: no Build file available for 'clean $self->{id}". |
3743
|
|
|
|
|
|
|
" in cwd[$cwd]. Danger, Will Robinson!"); |
3744
|
0
|
|
|
|
|
|
$CPAN::Frontend->mysleep(5); |
3745
|
|
|
|
|
|
|
} |
3746
|
0
|
|
|
|
|
|
$system = sprintf "%s clean", $self->_build_command(); |
3747
|
|
|
|
|
|
|
} else { |
3748
|
0
|
|
|
|
|
|
$system = join " ", $self->_make_command(), "clean"; |
3749
|
|
|
|
|
|
|
} |
3750
|
0
|
|
|
|
|
|
my $system_ok = system($system) == 0; |
3751
|
0
|
|
|
|
|
|
$self->introduce_myself; |
3752
|
0
|
0
|
|
|
|
|
if ( $system_ok ) { |
3753
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(" $system -- OK\n"); |
3754
|
|
|
|
|
|
|
|
3755
|
|
|
|
|
|
|
# $self->force; |
3756
|
|
|
|
|
|
|
|
3757
|
|
|
|
|
|
|
# Jost Krieger pointed out that this "force" was wrong because |
3758
|
|
|
|
|
|
|
# it has the effect that the next "install" on this distribution |
3759
|
|
|
|
|
|
|
# will untar everything again. Instead we should bring the |
3760
|
|
|
|
|
|
|
# object's state back to where it is after untarring. |
3761
|
|
|
|
|
|
|
|
3762
|
0
|
|
|
|
|
|
for my $k (qw( |
3763
|
|
|
|
|
|
|
force_update |
3764
|
|
|
|
|
|
|
install |
3765
|
|
|
|
|
|
|
writemakefile |
3766
|
|
|
|
|
|
|
make |
3767
|
|
|
|
|
|
|
make_test |
3768
|
|
|
|
|
|
|
)) { |
3769
|
0
|
|
|
|
|
|
delete $self->{$k}; |
3770
|
|
|
|
|
|
|
} |
3771
|
0
|
|
|
|
|
|
$self->{make_clean} = CPAN::Distrostatus->new("YES"); |
3772
|
|
|
|
|
|
|
|
3773
|
|
|
|
|
|
|
} else { |
3774
|
|
|
|
|
|
|
# Hmmm, what to do if make clean failed? |
3775
|
|
|
|
|
|
|
|
3776
|
0
|
|
|
|
|
|
$self->{make_clean} = CPAN::Distrostatus->new("NO"); |
3777
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn(qq{ $system -- NOT OK\n}); |
3778
|
|
|
|
|
|
|
|
3779
|
|
|
|
|
|
|
# 2006-02-27: seems silly to me to force a make now |
3780
|
|
|
|
|
|
|
# $self->force("make"); # so that this directory won't be used again |
3781
|
|
|
|
|
|
|
|
3782
|
|
|
|
|
|
|
} |
3783
|
0
|
|
|
|
|
|
$self->store_persistent_state; |
3784
|
|
|
|
|
|
|
} |
3785
|
|
|
|
|
|
|
|
3786
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::check_disabled ; |
3787
|
|
|
|
|
|
|
sub check_disabled { |
3788
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
3789
|
0
|
0
|
|
|
|
|
$self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG; |
3790
|
0
|
0
|
0
|
|
|
|
if ($self->prefs->{disabled} && ! $self->{force_update}) { |
3791
|
|
|
|
|
|
|
return sprintf( |
3792
|
|
|
|
|
|
|
"Disabled via prefs file '%s' doc %d", |
3793
|
|
|
|
|
|
|
$self->{prefs_file}, |
3794
|
|
|
|
|
|
|
$self->{prefs_file_doc}, |
3795
|
0
|
|
|
|
|
|
); |
3796
|
|
|
|
|
|
|
} |
3797
|
0
|
|
|
|
|
|
return; |
3798
|
|
|
|
|
|
|
} |
3799
|
|
|
|
|
|
|
|
3800
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::goto ; |
3801
|
|
|
|
|
|
|
sub goto { |
3802
|
0
|
|
|
0
|
0
|
|
my($self,$goto) = @_; |
3803
|
0
|
|
|
|
|
|
$goto = $self->normalize($goto); |
3804
|
|
|
|
|
|
|
my $why = sprintf( |
3805
|
|
|
|
|
|
|
"Goto '$goto' via prefs file '%s' doc %d", |
3806
|
|
|
|
|
|
|
$self->{prefs_file}, |
3807
|
|
|
|
|
|
|
$self->{prefs_file_doc}, |
3808
|
0
|
|
|
|
|
|
); |
3809
|
0
|
|
|
|
|
|
$self->{unwrapped} = CPAN::Distrostatus->new("NO $why"); |
3810
|
|
|
|
|
|
|
# 2007-07-16 akoenig : Better than NA would be if we could inherit |
3811
|
|
|
|
|
|
|
# the status of the $goto distro but given the exceptional nature |
3812
|
|
|
|
|
|
|
# of 'goto' I feel reluctant to implement it |
3813
|
0
|
|
|
|
|
|
my $goodbye_message = "[goto] -- NA $why"; |
3814
|
0
|
|
|
|
|
|
$self->goodbye($goodbye_message); |
3815
|
|
|
|
|
|
|
|
3816
|
|
|
|
|
|
|
# inject into the queue |
3817
|
|
|
|
|
|
|
|
3818
|
0
|
|
|
|
|
|
CPAN::Queue->delete($self->id); |
3819
|
0
|
|
|
|
|
|
CPAN::Queue->jumpqueue({qmod => $goto, reqtype => $self->{reqtype}}); |
3820
|
|
|
|
|
|
|
|
3821
|
|
|
|
|
|
|
# and run where we left off |
3822
|
|
|
|
|
|
|
|
3823
|
0
|
|
|
|
|
|
my($method) = (caller(1))[3]; |
3824
|
0
|
|
|
|
|
|
CPAN->instance("CPAN::Distribution",$goto)->$method(); |
3825
|
0
|
|
|
|
|
|
CPAN::Queue->delete_first($goto); |
3826
|
|
|
|
|
|
|
# XXX delete_first returns undef; is that what this should return |
3827
|
|
|
|
|
|
|
# up the call stack, eg. return $sefl->goto($goto) -- xdg, 2012-04-04 |
3828
|
|
|
|
|
|
|
} |
3829
|
|
|
|
|
|
|
|
3830
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::shortcut_install ; |
3831
|
|
|
|
|
|
|
# return values: undef means don't shortcut; 0 means shortcut as fail; |
3832
|
|
|
|
|
|
|
# and 1 means shortcut as success |
3833
|
|
|
|
|
|
|
sub shortcut_install { |
3834
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
3835
|
|
|
|
|
|
|
|
3836
|
0
|
0
|
|
|
|
|
$self->debug("checking previous install results[$self->{ID}]") if $CPAN::DEBUG; |
3837
|
0
|
0
|
|
|
|
|
if (exists $self->{install}) { |
3838
|
|
|
|
|
|
|
my $text = UNIVERSAL::can($self->{install},"text") ? |
3839
|
|
|
|
|
|
|
$self->{install}->text : |
3840
|
0
|
0
|
|
|
|
|
$self->{install}; |
3841
|
0
|
0
|
|
|
|
|
if ($text =~ /^YES/) { |
|
|
0
|
|
|
|
|
|
3842
|
0
|
|
|
|
|
|
$CPAN::META->is_installed($self->{build_dir}); |
3843
|
0
|
|
|
|
|
|
return $self->success("Already done"); |
3844
|
|
|
|
|
|
|
} elsif ($text =~ /is only/) { |
3845
|
|
|
|
|
|
|
# e.g. 'is only build_requires' |
3846
|
0
|
|
|
|
|
|
return $self->goodbye($text); |
3847
|
|
|
|
|
|
|
} else { |
3848
|
|
|
|
|
|
|
# comment in Todo on 2006-02-11; maybe retry? |
3849
|
0
|
|
|
|
|
|
return $self->goodbye("Already tried without success"); |
3850
|
|
|
|
|
|
|
} |
3851
|
|
|
|
|
|
|
} |
3852
|
|
|
|
|
|
|
|
3853
|
0
|
|
|
|
|
|
for my $slot ( qw/later configure_requires_later/ ) { |
3854
|
|
|
|
|
|
|
return $self->success($self->{$slot}) |
3855
|
0
|
0
|
|
|
|
|
if $self->{$slot}; |
3856
|
|
|
|
|
|
|
} |
3857
|
|
|
|
|
|
|
|
3858
|
0
|
|
|
|
|
|
return undef; |
3859
|
|
|
|
|
|
|
} |
3860
|
|
|
|
|
|
|
|
3861
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::install ; |
3862
|
|
|
|
|
|
|
sub install { |
3863
|
0
|
|
|
0
|
0
|
|
my($self) = @_; |
3864
|
|
|
|
|
|
|
|
3865
|
0
|
|
|
|
|
|
$self->pre_install(); |
3866
|
|
|
|
|
|
|
|
3867
|
0
|
0
|
|
|
|
|
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG; |
3868
|
0
|
0
|
|
|
|
|
if (my $goto = $self->prefs->{goto}) { |
3869
|
0
|
|
|
|
|
|
return $self->goto($goto); |
3870
|
|
|
|
|
|
|
} |
3871
|
|
|
|
|
|
|
|
3872
|
|
|
|
|
|
|
$self->test |
3873
|
0
|
0
|
|
|
|
|
or return; |
3874
|
|
|
|
|
|
|
|
3875
|
0
|
0
|
|
|
|
|
if ( defined( my $sc = $self->shortcut_install ) ) { |
3876
|
0
|
|
|
|
|
|
return $sc; |
3877
|
|
|
|
|
|
|
} |
3878
|
|
|
|
|
|
|
|
3879
|
0
|
0
|
|
|
|
|
if ($CPAN::Signal) { |
3880
|
0
|
|
|
|
|
|
delete $self->{force_update}; |
3881
|
0
|
|
|
|
|
|
return; |
3882
|
|
|
|
|
|
|
} |
3883
|
|
|
|
|
|
|
|
3884
|
0
|
0
|
|
|
|
|
my $builddir = $self->dir or |
3885
|
|
|
|
|
|
|
$CPAN::Frontend->mydie("PANIC: Cannot determine build directory\n"); |
3886
|
|
|
|
|
|
|
|
3887
|
0
|
0
|
|
|
|
|
unless (chdir $builddir) { |
3888
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!"); |
3889
|
0
|
|
|
|
|
|
return; |
3890
|
|
|
|
|
|
|
} |
3891
|
|
|
|
|
|
|
|
3892
|
0
|
0
|
|
|
|
|
$self->debug("Changed directory to $self->{build_dir}") |
3893
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
3894
|
|
|
|
|
|
|
|
3895
|
0
|
0
|
|
|
|
|
my $make = $self->{modulebuild} ? "Build" : "make"; |
3896
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("Running $make install\n"); |
3897
|
|
|
|
|
|
|
|
3898
|
0
|
0
|
|
|
|
|
if ($^O eq 'MacOS') { |
3899
|
0
|
|
|
|
|
|
Mac::BuildTools::make_install($self); |
3900
|
0
|
|
|
|
|
|
return; |
3901
|
|
|
|
|
|
|
} |
3902
|
|
|
|
|
|
|
|
3903
|
0
|
|
|
|
|
|
my $system; |
3904
|
0
|
0
|
|
|
|
|
if (my $commandline = $self->prefs->{install}{commandline}) { |
|
|
0
|
|
|
|
|
|
3905
|
0
|
|
|
|
|
|
$system = $commandline; |
3906
|
0
|
|
|
|
|
|
$ENV{PERL} = CPAN::find_perl(); |
3907
|
|
|
|
|
|
|
} elsif ($self->{modulebuild}) { |
3908
|
|
|
|
|
|
|
my($mbuild_install_build_command) = |
3909
|
|
|
|
|
|
|
exists $CPAN::HandleConfig::keys{mbuild_install_build_command} && |
3910
|
|
|
|
|
|
|
$CPAN::Config->{mbuild_install_build_command} ? |
3911
|
|
|
|
|
|
|
$CPAN::Config->{mbuild_install_build_command} : |
3912
|
0
|
0
|
0
|
|
|
|
$self->_build_command(); |
3913
|
0
|
0
|
|
|
|
|
my $install_directive = $^O eq 'VMS' ? '"install"' : 'install'; |
3914
|
|
|
|
|
|
|
$system = sprintf("%s %s %s", |
3915
|
|
|
|
|
|
|
$mbuild_install_build_command, |
3916
|
|
|
|
|
|
|
$install_directive, |
3917
|
|
|
|
|
|
|
$CPAN::Config->{mbuild_install_arg}, |
3918
|
0
|
|
|
|
|
|
); |
3919
|
|
|
|
|
|
|
} else { |
3920
|
0
|
|
|
|
|
|
my($make_install_make_command) = $self->_make_install_make_command(); |
3921
|
|
|
|
|
|
|
$system = sprintf("%s install %s", |
3922
|
|
|
|
|
|
|
$make_install_make_command, |
3923
|
|
|
|
|
|
|
$CPAN::Config->{make_install_arg}, |
3924
|
0
|
|
|
|
|
|
); |
3925
|
|
|
|
|
|
|
} |
3926
|
|
|
|
|
|
|
|
3927
|
0
|
0
|
0
|
|
|
|
my($stderr) = $^O eq "MSWin32" || $^O eq 'VMS' ? "" : " 2>&1 "; |
3928
|
0
|
|
|
|
|
|
my $brip = CPAN::HandleConfig->prefs_lookup($self, |
3929
|
|
|
|
|
|
|
q{build_requires_install_policy}); |
3930
|
0
|
|
0
|
|
|
|
$brip ||="ask/yes"; |
3931
|
0
|
|
|
|
|
|
my $id = $self->id; |
3932
|
0
|
|
0
|
|
|
|
my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command |
3933
|
0
|
|
|
|
|
|
my $want_install = "yes"; |
3934
|
0
|
0
|
|
|
|
|
if ($reqtype eq "b") { |
3935
|
0
|
0
|
|
|
|
|
if ($brip eq "no") { |
|
|
0
|
|
|
|
|
|
3936
|
0
|
|
|
|
|
|
$want_install = "no"; |
3937
|
|
|
|
|
|
|
} elsif ($brip =~ m|^ask/(.+)|) { |
3938
|
0
|
|
|
|
|
|
my $default = $1; |
3939
|
0
|
0
|
|
|
|
|
$default = "yes" unless $default =~ /^(y|n)/i; |
3940
|
0
|
|
|
|
|
|
$want_install = |
3941
|
|
|
|
|
|
|
CPAN::Shell::colorable_makemaker_prompt |
3942
|
|
|
|
|
|
|
("$id is just needed temporarily during building or testing. ". |
3943
|
|
|
|
|
|
|
"Do you want to install it permanently?", |
3944
|
|
|
|
|
|
|
$default); |
3945
|
|
|
|
|
|
|
} |
3946
|
|
|
|
|
|
|
} |
3947
|
0
|
0
|
|
|
|
|
unless ($want_install =~ /^y/i) { |
3948
|
0
|
|
|
|
|
|
my $is_only = "is only 'build_requires'"; |
3949
|
0
|
|
|
|
|
|
$self->{install} = CPAN::Distrostatus->new("NO -- $is_only"); |
3950
|
0
|
|
|
|
|
|
delete $self->{force_update}; |
3951
|
0
|
|
|
|
|
|
return $self->goodbye("Not installing because $is_only"); |
3952
|
|
|
|
|
|
|
} |
3953
|
|
|
|
|
|
|
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB}) |
3954
|
|
|
|
|
|
|
? $ENV{PERL5LIB} |
3955
|
0
|
0
|
0
|
|
|
|
: ($ENV{PERLLIB} || ""); |
3956
|
|
|
|
|
|
|
|
3957
|
0
|
0
|
|
|
|
|
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : ""; |
3958
|
0
|
|
|
|
|
|
$CPAN::META->set_perl5lib; |
3959
|
0
|
0
|
|
|
|
|
local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default}; |
3960
|
0
|
0
|
|
|
|
|
local $ENV{NONINTERACTIVE_TESTING} = 1 if $CPAN::Config->{use_prompt_default}; |
3961
|
|
|
|
|
|
|
|
3962
|
0
|
|
0
|
|
|
|
my($pipe) = FileHandle->new("$system $stderr |") || Carp::croak("Can't execute $system: $!"); |
3963
|
0
|
|
|
|
|
|
my($makeout) = ""; |
3964
|
0
|
|
|
|
|
|
while (<$pipe>) { |
3965
|
0
|
|
|
|
|
|
print $_; # intentionally NOT use Frontend->myprint because it |
3966
|
|
|
|
|
|
|
# looks irritating when we markup in color what we |
3967
|
|
|
|
|
|
|
# just pass through from an external program |
3968
|
0
|
|
|
|
|
|
$makeout .= $_; |
3969
|
|
|
|
|
|
|
} |
3970
|
0
|
|
|
|
|
|
$pipe->close; |
3971
|
0
|
|
|
|
|
|
my $close_ok = $? == 0; |
3972
|
0
|
|
|
|
|
|
$self->introduce_myself; |
3973
|
0
|
0
|
|
|
|
|
if ( $close_ok ) { |
3974
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(" $system -- OK\n"); |
3975
|
0
|
|
|
|
|
|
$CPAN::META->is_installed($self->{build_dir}); |
3976
|
0
|
|
|
|
|
|
$self->{install} = CPAN::Distrostatus->new("YES"); |
3977
|
0
|
0
|
|
|
|
|
if ($CPAN::Config->{'cleanup_after_install'}) { |
3978
|
0
|
|
|
|
|
|
my $parent = File::Spec->catdir( $self->{build_dir}, File::Spec->updir ); |
3979
|
0
|
0
|
|
|
|
|
chdir $parent or $CPAN::Frontend->mydie("Couldn't chdir to $parent: $!\n"); |
3980
|
0
|
|
|
|
|
|
File::Path::rmtree($self->{build_dir}); |
3981
|
0
|
|
|
|
|
|
my $yml = "$self->{build_dir}.yml"; |
3982
|
0
|
0
|
|
|
|
|
if (-e $yml) { |
3983
|
0
|
0
|
|
|
|
|
unlink $yml or $CPAN::Frontend->mydie("Couldn't unlink $yml: $!\n"); |
3984
|
|
|
|
|
|
|
} |
3985
|
|
|
|
|
|
|
} |
3986
|
|
|
|
|
|
|
} else { |
3987
|
0
|
|
|
|
|
|
$self->{install} = CPAN::Distrostatus->new("NO"); |
3988
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn(" $system -- NOT OK\n"); |
3989
|
0
|
|
|
|
|
|
my $mimc = |
3990
|
|
|
|
|
|
|
CPAN::HandleConfig->prefs_lookup($self, |
3991
|
|
|
|
|
|
|
q{make_install_make_command}); |
3992
|
0
|
0
|
0
|
|
|
|
if ( |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
3993
|
|
|
|
|
|
|
$makeout =~ /permission/s |
3994
|
|
|
|
|
|
|
&& $> > 0 |
3995
|
|
|
|
|
|
|
&& ( |
3996
|
|
|
|
|
|
|
! $mimc |
3997
|
|
|
|
|
|
|
|| $mimc eq (CPAN::HandleConfig->prefs_lookup($self, |
3998
|
|
|
|
|
|
|
q{make})) |
3999
|
|
|
|
|
|
|
) |
4000
|
|
|
|
|
|
|
) { |
4001
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint( |
4002
|
|
|
|
|
|
|
qq{----\n}. |
4003
|
|
|
|
|
|
|
qq{ You may have to su }. |
4004
|
|
|
|
|
|
|
qq{to root to install the package\n}. |
4005
|
|
|
|
|
|
|
qq{ (Or you may want to run something like\n}. |
4006
|
|
|
|
|
|
|
qq{ o conf make_install_make_command 'sudo make'\n}. |
4007
|
|
|
|
|
|
|
qq{ to raise your permissions.} |
4008
|
|
|
|
|
|
|
); |
4009
|
|
|
|
|
|
|
} |
4010
|
|
|
|
|
|
|
} |
4011
|
0
|
|
|
|
|
|
delete $self->{force_update}; |
4012
|
0
|
0
|
|
|
|
|
unless ($CPAN::Config->{'cleanup_after_install'}) { |
4013
|
0
|
|
|
|
|
|
$self->store_persistent_state; |
4014
|
|
|
|
|
|
|
} |
4015
|
|
|
|
|
|
|
|
4016
|
0
|
|
|
|
|
|
$self->post_install(); |
4017
|
|
|
|
|
|
|
|
4018
|
0
|
|
|
|
|
|
return !! $close_ok; |
4019
|
|
|
|
|
|
|
} |
4020
|
|
|
|
|
|
|
|
4021
|
|
|
|
|
|
|
sub introduce_myself { |
4022
|
0
|
|
|
0
|
0
|
|
my($self) = @_; |
4023
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(sprintf(" %s\n",$self->pretty_id)); |
4024
|
|
|
|
|
|
|
} |
4025
|
|
|
|
|
|
|
|
4026
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::dir ; |
4027
|
|
|
|
|
|
|
sub dir { |
4028
|
0
|
|
|
0
|
0
|
|
shift->{build_dir}; |
4029
|
|
|
|
|
|
|
} |
4030
|
|
|
|
|
|
|
|
4031
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::perldoc ; |
4032
|
|
|
|
|
|
|
sub perldoc { |
4033
|
0
|
|
|
0
|
0
|
|
my($self) = @_; |
4034
|
|
|
|
|
|
|
|
4035
|
0
|
|
|
|
|
|
my($dist) = $self->id; |
4036
|
0
|
|
|
|
|
|
my $package = $self->called_for; |
4037
|
|
|
|
|
|
|
|
4038
|
0
|
0
|
|
|
|
|
if ($CPAN::META->has_inst("Pod::Perldocs")) { |
4039
|
0
|
0
|
|
|
|
|
my($perl) = $self->perl |
4040
|
|
|
|
|
|
|
or $CPAN::Frontend->mydie("Couldn't find executable perl\n"); |
4041
|
0
|
|
|
|
|
|
my @args = ($perl, q{-MPod::Perldocs}, q{-e}, |
4042
|
|
|
|
|
|
|
q{Pod::Perldocs->run()}, $package); |
4043
|
0
|
|
|
|
|
|
my($wstatus); |
4044
|
0
|
0
|
|
|
|
|
unless ( ($wstatus = system(@args)) == 0 ) { |
4045
|
0
|
|
|
|
|
|
my $estatus = $wstatus >> 8; |
4046
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(qq{ |
4047
|
|
|
|
|
|
|
Function system("@args") |
4048
|
|
|
|
|
|
|
returned status $estatus (wstat $wstatus) |
4049
|
|
|
|
|
|
|
}); |
4050
|
|
|
|
|
|
|
} |
4051
|
|
|
|
|
|
|
} |
4052
|
|
|
|
|
|
|
else { |
4053
|
0
|
|
|
|
|
|
$self->_display_url( $CPAN::Defaultdocs . $package ); |
4054
|
|
|
|
|
|
|
} |
4055
|
|
|
|
|
|
|
} |
4056
|
|
|
|
|
|
|
|
4057
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::_check_binary ; |
4058
|
|
|
|
|
|
|
sub _check_binary { |
4059
|
0
|
|
|
0
|
|
|
my ($dist,$shell,$binary) = @_; |
4060
|
0
|
|
|
|
|
|
my ($pid,$out); |
4061
|
|
|
|
|
|
|
|
4062
|
0
|
0
|
|
|
|
|
$CPAN::Frontend->myprint(qq{ + _check_binary($binary)\n}) |
4063
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
4064
|
|
|
|
|
|
|
|
4065
|
0
|
0
|
|
|
|
|
if ($CPAN::META->has_inst("File::Which")) { |
4066
|
0
|
|
|
|
|
|
return File::Which::which($binary); |
4067
|
|
|
|
|
|
|
} else { |
4068
|
0
|
|
|
|
|
|
local *README; |
4069
|
0
|
0
|
|
|
|
|
$pid = open README, "which $binary|" |
4070
|
|
|
|
|
|
|
or $CPAN::Frontend->mywarn(qq{Could not fork 'which $binary': $!\n}); |
4071
|
0
|
0
|
|
|
|
|
return unless $pid; |
4072
|
0
|
|
|
|
|
|
while () { |
4073
|
0
|
|
|
|
|
|
$out .= $_; |
4074
|
|
|
|
|
|
|
} |
4075
|
0
|
0
|
0
|
|
|
|
close README |
4076
|
|
|
|
|
|
|
or $CPAN::Frontend->mywarn("Could not run 'which $binary': $!\n") |
4077
|
|
|
|
|
|
|
and return; |
4078
|
|
|
|
|
|
|
} |
4079
|
|
|
|
|
|
|
|
4080
|
0
|
0
|
0
|
|
|
|
$CPAN::Frontend->myprint(qq{ + $out \n}) |
4081
|
|
|
|
|
|
|
if $CPAN::DEBUG && $out; |
4082
|
|
|
|
|
|
|
|
4083
|
0
|
|
|
|
|
|
return $out; |
4084
|
|
|
|
|
|
|
} |
4085
|
|
|
|
|
|
|
|
4086
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::_display_url ; |
4087
|
|
|
|
|
|
|
sub _display_url { |
4088
|
0
|
|
|
0
|
|
|
my($self,$url) = @_; |
4089
|
0
|
|
|
|
|
|
my($res,$saved_file,$pid,$out); |
4090
|
|
|
|
|
|
|
|
4091
|
0
|
0
|
|
|
|
|
$CPAN::Frontend->myprint(qq{ + _display_url($url)\n}) |
4092
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
4093
|
|
|
|
|
|
|
|
4094
|
|
|
|
|
|
|
# should we define it in the config instead? |
4095
|
0
|
|
|
|
|
|
my $html_converter = "html2text.pl"; |
4096
|
|
|
|
|
|
|
|
4097
|
0
|
|
0
|
|
|
|
my $web_browser = $CPAN::Config->{'lynx'} || undef; |
4098
|
0
|
0
|
|
|
|
|
my $web_browser_out = $web_browser |
4099
|
|
|
|
|
|
|
? CPAN::Distribution->_check_binary($self,$web_browser) |
4100
|
|
|
|
|
|
|
: undef; |
4101
|
|
|
|
|
|
|
|
4102
|
0
|
0
|
|
|
|
|
if ($web_browser_out) { |
4103
|
|
|
|
|
|
|
# web browser found, run the action |
4104
|
0
|
|
|
|
|
|
my $browser = CPAN::HandleConfig->safe_quote($CPAN::Config->{'lynx'}); |
4105
|
0
|
0
|
|
|
|
|
$CPAN::Frontend->myprint(qq{system[$browser $url]}) |
4106
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
4107
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(qq{ |
4108
|
|
|
|
|
|
|
Displaying URL |
4109
|
|
|
|
|
|
|
$url |
4110
|
|
|
|
|
|
|
with browser $browser |
4111
|
|
|
|
|
|
|
}); |
4112
|
0
|
|
|
|
|
|
$CPAN::Frontend->mysleep(1); |
4113
|
0
|
|
|
|
|
|
system("$browser $url"); |
4114
|
0
|
0
|
|
|
|
|
if ($saved_file) { 1 while unlink($saved_file) } |
|
0
|
|
|
|
|
|
|
4115
|
|
|
|
|
|
|
} else { |
4116
|
|
|
|
|
|
|
# web browser not found, let's try text only |
4117
|
0
|
|
|
|
|
|
my $html_converter_out = |
4118
|
|
|
|
|
|
|
CPAN::Distribution->_check_binary($self,$html_converter); |
4119
|
0
|
|
|
|
|
|
$html_converter_out = CPAN::HandleConfig->safe_quote($html_converter_out); |
4120
|
|
|
|
|
|
|
|
4121
|
0
|
0
|
|
|
|
|
if ($html_converter_out ) { |
4122
|
|
|
|
|
|
|
# html2text found, run it |
4123
|
0
|
|
|
|
|
|
$saved_file = CPAN::Distribution->_getsave_url( $self, $url ); |
4124
|
0
|
0
|
|
|
|
|
$CPAN::Frontend->mydie(qq{ERROR: problems while getting $url\n}) |
4125
|
|
|
|
|
|
|
unless defined($saved_file); |
4126
|
|
|
|
|
|
|
|
4127
|
0
|
|
|
|
|
|
local *README; |
4128
|
0
|
0
|
|
|
|
|
$pid = open README, "$html_converter $saved_file |" |
4129
|
|
|
|
|
|
|
or $CPAN::Frontend->mydie(qq{ |
4130
|
|
|
|
|
|
|
Could not fork '$html_converter $saved_file': $!}); |
4131
|
0
|
|
|
|
|
|
my($fh,$filename); |
4132
|
0
|
0
|
|
|
|
|
if ($CPAN::META->has_usable("File::Temp")) { |
4133
|
0
|
|
|
|
|
|
$fh = File::Temp->new( |
4134
|
|
|
|
|
|
|
dir => File::Spec->tmpdir, |
4135
|
|
|
|
|
|
|
template => 'cpan_htmlconvert_XXXX', |
4136
|
|
|
|
|
|
|
suffix => '.txt', |
4137
|
|
|
|
|
|
|
unlink => 0, |
4138
|
|
|
|
|
|
|
); |
4139
|
0
|
|
|
|
|
|
$filename = $fh->filename; |
4140
|
|
|
|
|
|
|
} else { |
4141
|
0
|
|
|
|
|
|
$filename = "cpan_htmlconvert_$$.txt"; |
4142
|
0
|
|
|
|
|
|
$fh = FileHandle->new(); |
4143
|
0
|
0
|
|
|
|
|
open $fh, ">$filename" or die; |
4144
|
|
|
|
|
|
|
} |
4145
|
0
|
|
|
|
|
|
while () { |
4146
|
0
|
|
|
|
|
|
$fh->print($_); |
4147
|
|
|
|
|
|
|
} |
4148
|
0
|
0
|
|
|
|
|
close README or |
4149
|
|
|
|
|
|
|
$CPAN::Frontend->mydie(qq{Could not run '$html_converter $saved_file': $!}); |
4150
|
0
|
|
|
|
|
|
my $tmpin = $fh->filename; |
4151
|
0
|
0
|
|
|
|
|
$CPAN::Frontend->myprint(sprintf(qq{ |
4152
|
|
|
|
|
|
|
Run '%s %s' and |
4153
|
|
|
|
|
|
|
saved output to %s\n}, |
4154
|
|
|
|
|
|
|
$html_converter, |
4155
|
|
|
|
|
|
|
$saved_file, |
4156
|
|
|
|
|
|
|
$tmpin, |
4157
|
|
|
|
|
|
|
)) if $CPAN::DEBUG; |
4158
|
0
|
|
|
|
|
|
close $fh; |
4159
|
0
|
|
|
|
|
|
local *FH; |
4160
|
0
|
0
|
|
|
|
|
open FH, $tmpin |
4161
|
|
|
|
|
|
|
or $CPAN::Frontend->mydie(qq{Could not open "$tmpin": $!}); |
4162
|
0
|
|
|
|
|
|
my $fh_pager = FileHandle->new; |
4163
|
0
|
|
|
|
|
|
local($SIG{PIPE}) = "IGNORE"; |
4164
|
0
|
|
0
|
|
|
|
my $pager = $CPAN::Config->{'pager'} || "cat"; |
4165
|
0
|
0
|
|
|
|
|
$fh_pager->open("|$pager") |
4166
|
|
|
|
|
|
|
or $CPAN::Frontend->mydie(qq{ |
4167
|
|
|
|
|
|
|
Could not open pager '$pager': $!}); |
4168
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(qq{ |
4169
|
|
|
|
|
|
|
Displaying URL |
4170
|
|
|
|
|
|
|
$url |
4171
|
|
|
|
|
|
|
with pager "$pager" |
4172
|
|
|
|
|
|
|
}); |
4173
|
0
|
|
|
|
|
|
$CPAN::Frontend->mysleep(1); |
4174
|
0
|
|
|
|
|
|
$fh_pager->print(); |
4175
|
0
|
|
|
|
|
|
$fh_pager->close; |
4176
|
|
|
|
|
|
|
} else { |
4177
|
|
|
|
|
|
|
# coldn't find the web browser or html converter |
4178
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(qq{ |
4179
|
|
|
|
|
|
|
You need to install lynx or $html_converter to use this feature.}); |
4180
|
|
|
|
|
|
|
} |
4181
|
|
|
|
|
|
|
} |
4182
|
|
|
|
|
|
|
} |
4183
|
|
|
|
|
|
|
|
4184
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::_getsave_url ; |
4185
|
|
|
|
|
|
|
sub _getsave_url { |
4186
|
0
|
|
|
0
|
|
|
my($dist, $shell, $url) = @_; |
4187
|
|
|
|
|
|
|
|
4188
|
0
|
0
|
|
|
|
|
$CPAN::Frontend->myprint(qq{ + _getsave_url($url)\n}) |
4189
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
4190
|
|
|
|
|
|
|
|
4191
|
0
|
|
|
|
|
|
my($fh,$filename); |
4192
|
0
|
0
|
|
|
|
|
if ($CPAN::META->has_usable("File::Temp")) { |
4193
|
0
|
|
|
|
|
|
$fh = File::Temp->new( |
4194
|
|
|
|
|
|
|
dir => File::Spec->tmpdir, |
4195
|
|
|
|
|
|
|
template => "cpan_getsave_url_XXXX", |
4196
|
|
|
|
|
|
|
suffix => ".html", |
4197
|
|
|
|
|
|
|
unlink => 0, |
4198
|
|
|
|
|
|
|
); |
4199
|
0
|
|
|
|
|
|
$filename = $fh->filename; |
4200
|
|
|
|
|
|
|
} else { |
4201
|
0
|
|
|
|
|
|
$fh = FileHandle->new; |
4202
|
0
|
|
|
|
|
|
$filename = "cpan_getsave_url_$$.html"; |
4203
|
|
|
|
|
|
|
} |
4204
|
0
|
|
|
|
|
|
my $tmpin = $filename; |
4205
|
0
|
0
|
|
|
|
|
if ($CPAN::META->has_usable('LWP')) { |
4206
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("Fetching with LWP: |
4207
|
|
|
|
|
|
|
$url |
4208
|
|
|
|
|
|
|
"); |
4209
|
0
|
|
|
|
|
|
my $Ua; |
4210
|
0
|
|
|
|
|
|
CPAN::LWP::UserAgent->config; |
4211
|
0
|
|
|
|
|
|
eval { $Ua = CPAN::LWP::UserAgent->new; }; |
|
0
|
|
|
|
|
|
|
4212
|
0
|
0
|
|
|
|
|
if ($@) { |
4213
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("ERROR: CPAN::LWP::UserAgent->new dies with $@\n"); |
4214
|
0
|
|
|
|
|
|
return; |
4215
|
|
|
|
|
|
|
} else { |
4216
|
0
|
|
|
|
|
|
my($var); |
4217
|
|
|
|
|
|
|
$Ua->proxy('http', $var) |
4218
|
0
|
0
|
0
|
|
|
|
if $var = $CPAN::Config->{http_proxy} || $ENV{http_proxy}; |
4219
|
|
|
|
|
|
|
$Ua->no_proxy($var) |
4220
|
0
|
0
|
0
|
|
|
|
if $var = $CPAN::Config->{no_proxy} || $ENV{no_proxy}; |
4221
|
|
|
|
|
|
|
} |
4222
|
|
|
|
|
|
|
|
4223
|
0
|
|
|
|
|
|
my $req = HTTP::Request->new(GET => $url); |
4224
|
0
|
|
|
|
|
|
$req->header('Accept' => 'text/html'); |
4225
|
0
|
|
|
|
|
|
my $res = $Ua->request($req); |
4226
|
0
|
0
|
|
|
|
|
if ($res->is_success) { |
4227
|
0
|
0
|
|
|
|
|
$CPAN::Frontend->myprint(" + request successful.\n") |
4228
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
4229
|
0
|
|
|
|
|
|
print $fh $res->content; |
4230
|
0
|
|
|
|
|
|
close $fh; |
4231
|
0
|
0
|
|
|
|
|
$CPAN::Frontend->myprint(qq{ + saved content to $tmpin \n}) |
4232
|
|
|
|
|
|
|
if $CPAN::DEBUG; |
4233
|
0
|
|
|
|
|
|
return $tmpin; |
4234
|
|
|
|
|
|
|
} else { |
4235
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(sprintf( |
4236
|
|
|
|
|
|
|
"LWP failed with code[%s], message[%s]\n", |
4237
|
|
|
|
|
|
|
$res->code, |
4238
|
|
|
|
|
|
|
$res->message, |
4239
|
|
|
|
|
|
|
)); |
4240
|
0
|
|
|
|
|
|
return; |
4241
|
|
|
|
|
|
|
} |
4242
|
|
|
|
|
|
|
} else { |
4243
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn(" LWP not available\n"); |
4244
|
0
|
|
|
|
|
|
return; |
4245
|
|
|
|
|
|
|
} |
4246
|
|
|
|
|
|
|
} |
4247
|
|
|
|
|
|
|
|
4248
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::_build_command |
4249
|
|
|
|
|
|
|
sub _build_command { |
4250
|
0
|
|
|
0
|
|
|
my($self) = @_; |
4251
|
0
|
0
|
|
|
|
|
if ($^O eq "MSWin32") { # special code needed at least up to |
|
|
0
|
|
|
|
|
|
4252
|
|
|
|
|
|
|
# Module::Build 0.2611 and 0.2706; a fix |
4253
|
|
|
|
|
|
|
# in M:B has been promised 2006-01-30 |
4254
|
0
|
0
|
|
|
|
|
my($perl) = $self->perl or $CPAN::Frontend->mydie("Couldn't find executable perl\n"); |
4255
|
0
|
|
|
|
|
|
return "$perl ./Build"; |
4256
|
|
|
|
|
|
|
} |
4257
|
|
|
|
|
|
|
elsif ($^O eq 'VMS') { |
4258
|
0
|
|
|
|
|
|
return "$^X Build.com"; |
4259
|
|
|
|
|
|
|
} |
4260
|
0
|
|
|
|
|
|
return "./Build"; |
4261
|
|
|
|
|
|
|
} |
4262
|
|
|
|
|
|
|
|
4263
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::_should_report |
4264
|
|
|
|
|
|
|
sub _should_report { |
4265
|
0
|
|
|
0
|
|
|
my($self, $phase) = @_; |
4266
|
0
|
0
|
|
|
|
|
die "_should_report() requires a 'phase' argument" |
4267
|
|
|
|
|
|
|
if ! defined $phase; |
4268
|
|
|
|
|
|
|
|
4269
|
|
|
|
|
|
|
# configured |
4270
|
0
|
|
|
|
|
|
my $test_report = CPAN::HandleConfig->prefs_lookup($self, |
4271
|
|
|
|
|
|
|
q{test_report}); |
4272
|
0
|
0
|
|
|
|
|
return unless $test_report; |
4273
|
|
|
|
|
|
|
|
4274
|
|
|
|
|
|
|
# don't repeat if we cached a result |
4275
|
|
|
|
|
|
|
return $self->{should_report} |
4276
|
0
|
0
|
|
|
|
|
if exists $self->{should_report}; |
4277
|
|
|
|
|
|
|
|
4278
|
|
|
|
|
|
|
# don't report if we generated a Makefile.PL |
4279
|
0
|
0
|
|
|
|
|
if ( $self->{had_no_makefile_pl} ) { |
4280
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn( |
4281
|
|
|
|
|
|
|
"Will not send CPAN Testers report with generated Makefile.PL.\n" |
4282
|
|
|
|
|
|
|
); |
4283
|
0
|
|
|
|
|
|
return $self->{should_report} = 0; |
4284
|
|
|
|
|
|
|
} |
4285
|
|
|
|
|
|
|
|
4286
|
|
|
|
|
|
|
# available |
4287
|
0
|
0
|
|
|
|
|
if ( ! $CPAN::META->has_inst("CPAN::Reporter")) { |
4288
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarnonce( |
4289
|
|
|
|
|
|
|
"CPAN::Reporter not installed. No reports will be sent.\n" |
4290
|
|
|
|
|
|
|
); |
4291
|
0
|
|
|
|
|
|
return $self->{should_report} = 0; |
4292
|
|
|
|
|
|
|
} |
4293
|
|
|
|
|
|
|
|
4294
|
|
|
|
|
|
|
# capable |
4295
|
0
|
|
|
|
|
|
my $crv = CPAN::Reporter->VERSION; |
4296
|
0
|
0
|
|
|
|
|
if ( CPAN::Version->vlt( $crv, 0.99 ) ) { |
4297
|
|
|
|
|
|
|
# don't cache $self->{should_report} -- need to check each phase |
4298
|
0
|
0
|
|
|
|
|
if ( $phase eq 'test' ) { |
4299
|
0
|
|
|
|
|
|
return 1; |
4300
|
|
|
|
|
|
|
} |
4301
|
|
|
|
|
|
|
else { |
4302
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn( |
4303
|
|
|
|
|
|
|
"Reporting on the '$phase' phase requires CPAN::Reporter 0.99, but \n" . |
4304
|
|
|
|
|
|
|
"you only have version $crv\. Only 'test' phase reports will be sent.\n" |
4305
|
|
|
|
|
|
|
); |
4306
|
0
|
|
|
|
|
|
return; |
4307
|
|
|
|
|
|
|
} |
4308
|
|
|
|
|
|
|
} |
4309
|
|
|
|
|
|
|
|
4310
|
|
|
|
|
|
|
# appropriate |
4311
|
0
|
0
|
|
|
|
|
if ($self->is_dot_dist) { |
4312
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ". |
4313
|
|
|
|
|
|
|
"for local directories\n"); |
4314
|
0
|
|
|
|
|
|
return $self->{should_report} = 0; |
4315
|
|
|
|
|
|
|
} |
4316
|
0
|
0
|
0
|
|
|
|
if ($self->prefs->{patches} |
|
|
|
0
|
|
|
|
|
4317
|
|
|
|
|
|
|
&& |
4318
|
0
|
|
|
|
|
|
@{$self->prefs->{patches}} |
4319
|
|
|
|
|
|
|
&& |
4320
|
|
|
|
|
|
|
$self->{patched} |
4321
|
|
|
|
|
|
|
) { |
4322
|
0
|
|
|
|
|
|
$CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ". |
4323
|
|
|
|
|
|
|
"when the source has been patched\n"); |
4324
|
0
|
|
|
|
|
|
return $self->{should_report} = 0; |
4325
|
|
|
|
|
|
|
} |
4326
|
|
|
|
|
|
|
|
4327
|
|
|
|
|
|
|
# proceed and cache success |
4328
|
0
|
|
|
|
|
|
return $self->{should_report} = 1; |
4329
|
|
|
|
|
|
|
} |
4330
|
|
|
|
|
|
|
|
4331
|
|
|
|
|
|
|
#-> sub CPAN::Distribution::reports |
4332
|
|
|
|
|
|
|
sub reports { |
4333
|
0
|
|
|
0
|
0
|
|
my($self) = @_; |
4334
|
0
|
|
|
|
|
|
my $pathname = $self->id; |
4335
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("Distribution: $pathname\n"); |
4336
|
|
|
|
|
|
|
|
4337
|
0
|
0
|
|
|
|
|
unless ($CPAN::META->has_inst("CPAN::DistnameInfo")) { |
4338
|
0
|
|
|
|
|
|
$CPAN::Frontend->mydie("CPAN::DistnameInfo not installed; cannot continue"); |
4339
|
|
|
|
|
|
|
} |
4340
|
0
|
0
|
|
|
|
|
unless ($CPAN::META->has_usable("LWP")) { |
4341
|
0
|
|
|
|
|
|
$CPAN::Frontend->mydie("LWP not installed; cannot continue"); |
4342
|
|
|
|
|
|
|
} |
4343
|
0
|
0
|
|
|
|
|
unless ($CPAN::META->has_usable("File::Temp")) { |
4344
|
0
|
|
|
|
|
|
$CPAN::Frontend->mydie("File::Temp not installed; cannot continue"); |
4345
|
|
|
|
|
|
|
} |
4346
|
|
|
|
|
|
|
|
4347
|
0
|
|
|
|
|
|
my $d = CPAN::DistnameInfo->new($pathname); |
4348
|
|
|
|
|
|
|
|
4349
|
0
|
|
|
|
|
|
my $dist = $d->dist; # "CPAN-DistnameInfo" |
4350
|
0
|
|
|
|
|
|
my $version = $d->version; # "0.02" |
4351
|
0
|
|
|
|
|
|
my $maturity = $d->maturity; # "released" |
4352
|
0
|
|
|
|
|
|
my $filename = $d->filename; # "CPAN-DistnameInfo-0.02.tar.gz" |
4353
|
0
|
|
|
|
|
|
my $cpanid = $d->cpanid; # "GBARR" |
4354
|
0
|
|
|
|
|
|
my $distvname = $d->distvname; # "CPAN-DistnameInfo-0.02" |
4355
|
|
|
|
|
|
|
|
4356
|
0
|
|
|
|
|
|
my $url = sprintf "http://www.cpantesters.org/show/%s.yaml", $dist; |
4357
|
|
|
|
|
|
|
|
4358
|
0
|
|
|
|
|
|
CPAN::LWP::UserAgent->config; |
4359
|
0
|
|
|
|
|
|
my $Ua; |
4360
|
0
|
|
|
|
|
|
eval { $Ua = CPAN::LWP::UserAgent->new; }; |
|
0
|
|
|
|
|
|
|
4361
|
0
|
0
|
|
|
|
|
if ($@) { |
4362
|
0
|
|
|
|
|
|
$CPAN::Frontend->mydie("CPAN::LWP::UserAgent->new dies with $@\n"); |
4363
|
|
|
|
|
|
|
} |
4364
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("Fetching '$url'..."); |
4365
|
0
|
|
|
|
|
|
my $resp = $Ua->get($url); |
4366
|
0
|
0
|
|
|
|
|
unless ($resp->is_success) { |
4367
|
0
|
|
|
|
|
|
$CPAN::Frontend->mydie(sprintf "Could not download '%s': %s\n", $url, $resp->code); |
4368
|
|
|
|
|
|
|
} |
4369
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("DONE\n\n"); |
4370
|
0
|
|
|
|
|
|
my $yaml = $resp->content; |
4371
|
|
|
|
|
|
|
# what a long way round! |
4372
|
0
|
|
|
|
|
|
my $fh = File::Temp->new( |
4373
|
|
|
|
|
|
|
dir => File::Spec->tmpdir, |
4374
|
|
|
|
|
|
|
template => 'cpan_reports_XXXX', |
4375
|
|
|
|
|
|
|
suffix => '.yaml', |
4376
|
|
|
|
|
|
|
unlink => 0, |
4377
|
|
|
|
|
|
|
); |
4378
|
0
|
|
|
|
|
|
my $tfilename = $fh->filename; |
4379
|
0
|
|
|
|
|
|
print $fh $yaml; |
4380
|
0
|
0
|
|
|
|
|
close $fh or $CPAN::Frontend->mydie("Could not close '$tfilename': $!"); |
4381
|
0
|
|
|
|
|
|
my $unserialized = CPAN->_yaml_loadfile($tfilename)->[0]; |
4382
|
0
|
0
|
|
|
|
|
unlink $tfilename or $CPAN::Frontend->mydie("Could not unlink '$tfilename': $!"); |
4383
|
0
|
|
|
|
|
|
my %other_versions; |
4384
|
|
|
|
|
|
|
my $this_version_seen; |
4385
|
0
|
|
|
|
|
|
for my $rep (@$unserialized) { |
4386
|
0
|
|
|
|
|
|
my $rversion = $rep->{version}; |
4387
|
0
|
0
|
|
|
|
|
if ($rversion eq $version) { |
4388
|
0
|
0
|
|
|
|
|
unless ($this_version_seen++) { |
4389
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint ("$rep->{version}:\n"); |
4390
|
|
|
|
|
|
|
} |
4391
|
0
|
|
0
|
|
|
|
my $arch = $rep->{archname} || $rep->{platform} || '????'; |
4392
|
0
|
|
0
|
|
|
|
my $grade = $rep->{action} || $rep->{status} || '????'; |
4393
|
0
|
|
0
|
|
|
|
my $ostext = $rep->{ostext} || ucfirst($rep->{osname}) || '????'; |
4394
|
|
|
|
|
|
|
$CPAN::Frontend->myprint |
4395
|
|
|
|
|
|
|
(sprintf("%1s%1s%-4s %s on %s %s (%s)\n", |
4396
|
|
|
|
|
|
|
$arch eq $Config::Config{archname}?"*":"", |
4397
|
|
|
|
|
|
|
$grade eq "PASS"?"+":$grade eq"FAIL"?"-":"", |
4398
|
|
|
|
|
|
|
$grade, |
4399
|
|
|
|
|
|
|
$rep->{perl}, |
4400
|
|
|
|
|
|
|
$ostext, |
4401
|
|
|
|
|
|
|
$rep->{osvers}, |
4402
|
0
|
0
|
|
|
|
|
$arch, |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4403
|
|
|
|
|
|
|
)); |
4404
|
|
|
|
|
|
|
} else { |
4405
|
0
|
|
|
|
|
|
$other_versions{$rep->{version}}++; |
4406
|
|
|
|
|
|
|
} |
4407
|
|
|
|
|
|
|
} |
4408
|
0
|
0
|
|
|
|
|
unless ($this_version_seen) { |
4409
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("No reports found for version '$version' |
4410
|
|
|
|
|
|
|
Reports for other versions:\n"); |
4411
|
0
|
|
|
|
|
|
for my $v (sort keys %other_versions) { |
4412
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint(" $v\: $other_versions{$v}\n"); |
4413
|
|
|
|
|
|
|
} |
4414
|
|
|
|
|
|
|
} |
4415
|
0
|
|
|
|
|
|
$url =~ s/\.yaml/.html/; |
4416
|
0
|
|
|
|
|
|
$CPAN::Frontend->myprint("See $url for details\n"); |
4417
|
|
|
|
|
|
|
} |
4418
|
|
|
|
|
|
|
|
4419
|
|
|
|
|
|
|
1; |