line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::PrereqScanner::NotQuiteLite::App; |
2
|
|
|
|
|
|
|
|
3
|
58
|
|
|
58
|
|
31356
|
use strict; |
|
58
|
|
|
|
|
124
|
|
|
58
|
|
|
|
|
1728
|
|
4
|
58
|
|
|
58
|
|
321
|
use warnings; |
|
58
|
|
|
|
|
118
|
|
|
58
|
|
|
|
|
1507
|
|
5
|
58
|
|
|
58
|
|
273
|
use File::Find; |
|
58
|
|
|
|
|
109
|
|
|
58
|
|
|
|
|
3621
|
|
6
|
58
|
|
|
58
|
|
394
|
use File::Glob 'bsd_glob'; |
|
58
|
|
|
|
|
105
|
|
|
58
|
|
|
|
|
5337
|
|
7
|
58
|
|
|
58
|
|
369
|
use File::Basename; |
|
58
|
|
|
|
|
106
|
|
|
58
|
|
|
|
|
2716
|
|
8
|
58
|
|
|
58
|
|
285
|
use File::Spec; |
|
58
|
|
|
|
|
111
|
|
|
58
|
|
|
|
|
930
|
|
9
|
58
|
|
|
58
|
|
22596
|
use CPAN::Meta::Prereqs; |
|
58
|
|
|
|
|
89450
|
|
|
58
|
|
|
|
|
1679
|
|
10
|
58
|
|
|
58
|
|
395
|
use CPAN::Meta::Requirements; |
|
58
|
|
|
|
|
117
|
|
|
58
|
|
|
|
|
883
|
|
11
|
58
|
|
|
58
|
|
853
|
use Perl::PrereqScanner::NotQuiteLite; |
|
58
|
|
|
|
|
105
|
|
|
58
|
|
|
|
|
1008
|
|
12
|
58
|
|
|
58
|
|
23636
|
use Perl::PrereqScanner::NotQuiteLite::Util::Prereqs; |
|
58
|
|
|
|
|
156
|
|
|
58
|
|
|
|
|
3240
|
|
13
|
|
|
|
|
|
|
|
14
|
58
|
|
|
58
|
|
348
|
use constant WIN32 => $^O eq 'MSWin32'; |
|
58
|
|
|
|
|
116
|
|
|
58
|
|
|
|
|
214922
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my %IsTestClassFamily = map {$_ => 1} qw( |
17
|
|
|
|
|
|
|
Test::Class |
18
|
|
|
|
|
|
|
Test::Class::Moose |
19
|
|
|
|
|
|
|
Test::Class::Most |
20
|
|
|
|
|
|
|
Test::Class::Sugar |
21
|
|
|
|
|
|
|
Test::Classy |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub new { |
25
|
42
|
|
|
42
|
1
|
195993
|
my ($class, %opts) = @_; |
26
|
|
|
|
|
|
|
|
27
|
42
|
|
|
|
|
202
|
for my $key (keys %opts) { |
28
|
212
|
50
|
|
|
|
518
|
next unless $key =~ /\-/; |
29
|
0
|
|
|
|
|
0
|
(my $replaced_key = $key) =~ s/\-/_/g; |
30
|
0
|
|
|
|
|
0
|
$opts{$replaced_key} = $opts{$key}; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
42
|
|
|
|
|
382
|
$opts{prereqs} = CPAN::Meta::Prereqs->new; |
34
|
42
|
50
|
|
|
|
1784
|
$opts{parsers} = [':bundled'] unless defined $opts{parsers}; |
35
|
42
|
50
|
|
|
|
156
|
$opts{recommends} = 0 unless defined $opts{recommends}; |
36
|
42
|
50
|
|
|
|
132
|
$opts{suggests} = 0 unless defined $opts{suggests}; |
37
|
42
|
|
33
|
|
|
161
|
$opts{base_dir} ||= File::Spec->curdir; |
38
|
|
|
|
|
|
|
|
39
|
42
|
100
|
|
|
|
149
|
$opts{cpanfile} = 1 if $opts{save_cpanfile}; |
40
|
|
|
|
|
|
|
|
41
|
42
|
100
|
66
|
|
|
199
|
if ($opts{features} and ref $opts{features} ne 'HASH') { |
42
|
12
|
|
|
|
|
27
|
my @features; |
43
|
12
|
100
|
|
|
|
87
|
if (!ref $opts{features}) { |
|
|
50
|
|
|
|
|
|
44
|
10
|
|
|
|
|
48
|
@features = split ';', $opts{features}; |
45
|
|
|
|
|
|
|
} elsif (ref $opts{features} eq 'ARRAY') { |
46
|
2
|
|
|
|
|
3
|
@features = @{$opts{features}}; |
|
2
|
|
|
|
|
6
|
|
47
|
|
|
|
|
|
|
} |
48
|
12
|
|
|
|
|
28
|
my %map; |
49
|
12
|
|
|
|
|
35
|
for my $spec (@features) { |
50
|
12
|
|
|
|
|
58
|
my ($identifier, $description, $paths) = split ':', $spec; |
51
|
12
|
|
|
|
|
41
|
my @paths = map { bsd_glob(File::Spec->catdir($opts{base_dir}, $_)) } split ',', $paths; |
|
12
|
|
|
|
|
434
|
|
52
|
12
|
|
|
|
|
38
|
if (WIN32) { |
53
|
|
|
|
|
|
|
s|\\|/|g for @paths; |
54
|
|
|
|
|
|
|
} |
55
|
12
|
|
|
|
|
82
|
$map{$identifier} = { |
56
|
|
|
|
|
|
|
description => $description, |
57
|
|
|
|
|
|
|
paths => \@paths, |
58
|
|
|
|
|
|
|
}; |
59
|
|
|
|
|
|
|
} |
60
|
12
|
|
|
|
|
45
|
$opts{features} = \%map; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
42
|
100
|
66
|
|
|
181
|
if ($opts{ignore} and ref $opts{ignore} eq 'ARRAY') { |
64
|
2
|
|
|
|
|
21
|
require Regexp::Trie; |
65
|
2
|
|
|
|
|
22
|
my $re = Regexp::Trie->new; |
66
|
2
|
|
|
|
|
11
|
for (@{$opts{ignore}}) { |
|
2
|
|
|
|
|
8
|
|
67
|
2
|
|
|
|
|
4
|
s|\\|/|g if WIN32; |
68
|
2
|
|
|
|
|
9
|
$re->add($_); |
69
|
|
|
|
|
|
|
} |
70
|
2
|
|
33
|
|
|
139
|
$opts{ignore_re} ||= $re->_regexp; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
42
|
100
|
66
|
|
|
736
|
if ($opts{private} and ref $opts{private} eq 'ARRAY') { |
74
|
1
|
|
|
|
|
5
|
require Regexp::Trie; |
75
|
1
|
|
|
|
|
9
|
my $re = Regexp::Trie->new; |
76
|
1
|
|
|
|
|
4
|
for (@{$opts{private}}) { |
|
1
|
|
|
|
|
3
|
|
77
|
1
|
|
|
|
|
3
|
$re->add($_); |
78
|
|
|
|
|
|
|
} |
79
|
1
|
|
33
|
|
|
40
|
$opts{private_re} ||= $re->_regexp; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
42
|
100
|
66
|
|
|
342
|
if ($opts{optional} and ref $opts{optional} eq 'ARRAY') { |
83
|
2
|
|
|
|
|
74
|
require Regexp::Trie; |
84
|
2
|
|
|
|
|
21
|
my $re = Regexp::Trie->new; |
85
|
2
|
|
|
|
|
11
|
for (@{$opts{optional}}) { |
|
2
|
|
|
|
|
8
|
|
86
|
2
|
|
|
|
|
5
|
s|\\|/|g if WIN32; |
87
|
2
|
|
|
|
|
7
|
$re->add($_); |
88
|
|
|
|
|
|
|
} |
89
|
2
|
|
33
|
|
|
118
|
$opts{optional_re} ||= $re->_regexp; |
90
|
|
|
|
|
|
|
} |
91
|
42
|
100
|
|
|
|
656
|
if ($opts{optional_re}) { |
92
|
3
|
|
|
|
|
11
|
$opts{suggests} = 1; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
42
|
50
|
|
|
|
141
|
if (my $index_name = delete $opts{use_index}) { |
96
|
0
|
|
|
|
|
0
|
my $index_package = "CPAN::Common::Index::$index_name"; |
97
|
0
|
0
|
|
|
|
0
|
if (eval "require $index_package; 1") { |
98
|
0
|
|
|
|
|
0
|
$opts{index} = $index_package->new; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
42
|
100
|
|
|
|
129
|
if ($opts{scan_also}) { |
103
|
2
|
|
33
|
|
|
16
|
$opts{libs} ||= delete $opts{scan_also}; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
42
|
|
|
|
|
224
|
bless \%opts, $class; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub run { |
110
|
42
|
|
|
42
|
1
|
120
|
my ($self, @args) = @_; |
111
|
|
|
|
|
|
|
|
112
|
42
|
50
|
|
|
|
119
|
unless (@args) { |
113
|
|
|
|
|
|
|
# for configure requires |
114
|
42
|
|
|
|
|
117
|
push @args, "Makefile.PL", "Build.PL"; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# for test requires |
117
|
42
|
|
|
|
|
100
|
push @args, "t"; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# for runtime requires; |
120
|
42
|
50
|
33
|
|
|
207
|
if ($self->{blib} and -d File::Spec->catdir($self->{base_dir}, 'blib')) { |
121
|
0
|
|
|
|
|
0
|
push @args, "blib/lib", "blib/bin", "blib/script"; |
122
|
|
|
|
|
|
|
} else { |
123
|
42
|
|
|
|
|
85
|
push @args, "lib"; |
124
|
42
|
|
|
|
|
2986
|
push @args, glob(File::Spec->catfile($self->{base_dir}, '*.pm')); |
125
|
42
|
|
|
|
|
312
|
push @args, "bin", "script", "scripts"; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# extra libs |
129
|
42
|
100
|
|
|
|
102
|
push @args, map { bsd_glob(File::Spec->catdir($self->{base_dir}, $_)) } @{$self->{libs} || []}; |
|
2
|
|
|
|
|
84
|
|
|
42
|
|
|
|
|
301
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# for develop requires |
132
|
42
|
50
|
|
|
|
578
|
push @args, "xt", "author" if $self->{develop}; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
42
|
50
|
|
|
|
128
|
if ($self->{verbose}) { |
136
|
0
|
|
|
|
|
0
|
print STDERR "Scanning the following files/directories\n"; |
137
|
0
|
|
|
|
|
0
|
print STDERR " $_\n" for sort @args; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
42
|
|
|
|
|
115
|
for my $path (@args) { |
141
|
329
|
100
|
|
|
|
3492
|
my $item = File::Spec->file_name_is_absolute($path) ? $path : File::Spec->catfile($self->{base_dir}, $path); |
142
|
329
|
100
|
|
|
|
7321
|
-d $item ? $self->_scan_dir($item) : |
|
|
100
|
|
|
|
|
|
143
|
|
|
|
|
|
|
-f $item ? $self->_scan_file($item) : |
144
|
|
|
|
|
|
|
next; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# add test requirements by .pm files used in .t files |
148
|
42
|
|
|
|
|
535
|
$self->_add_test_requires($self->{allow_test_pms}); |
149
|
|
|
|
|
|
|
|
150
|
42
|
|
|
|
|
225
|
$self->_exclude_local_modules; |
151
|
|
|
|
|
|
|
|
152
|
42
|
100
|
|
|
|
133
|
if ($self->{exclude_core}) { |
153
|
6
|
|
|
|
|
21
|
$self->_exclude_core_prereqs; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
42
|
50
|
|
|
|
1121
|
if ($self->{index}) { |
157
|
0
|
|
|
|
|
0
|
$self->_dedupe_indexed_prereqs; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
42
|
|
|
|
|
167
|
$self->_dedupe; |
161
|
|
|
|
|
|
|
|
162
|
42
|
100
|
66
|
|
|
305
|
if ($self->{print} or $self->{cpanfile}) { |
163
|
15
|
50
|
|
|
|
73
|
if ($self->{json}) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# TODO: feature support (how should we express it?) |
165
|
0
|
0
|
|
|
|
0
|
eval { require JSON::PP } or die "requires JSON::PP"; |
|
0
|
|
|
|
|
0
|
|
166
|
0
|
|
|
|
|
0
|
print JSON::PP->new->pretty(1)->canonical->encode($self->{prereqs}->as_string_hash); |
167
|
|
|
|
|
|
|
} elsif ($self->{cpanfile}) { |
168
|
15
|
50
|
|
|
|
36
|
eval { require Perl::PrereqScanner::NotQuiteLite::Util::CPANfile } or die "requires Module::CPANfile"; |
|
15
|
|
|
|
|
1266
|
|
169
|
15
|
|
|
|
|
211
|
my $file = File::Spec->catfile($self->{base_dir}, "cpanfile"); |
170
|
15
|
|
|
|
|
163
|
my $cpanfile = Perl::PrereqScanner::NotQuiteLite::Util::CPANfile->load_and_merge($file, $self->{prereqs}, $self->{features}); |
171
|
|
|
|
|
|
|
|
172
|
15
|
50
|
|
|
|
64
|
$self->_dedupe_indexed_prereqs($cpanfile->prereqs) if $self->{index}; |
173
|
|
|
|
|
|
|
|
174
|
15
|
50
|
|
|
|
46
|
if ($self->{save_cpanfile}) { |
|
|
0
|
|
|
|
|
|
175
|
15
|
|
|
|
|
58
|
$cpanfile->save($file); |
176
|
|
|
|
|
|
|
} elsif ($self->{print}) { |
177
|
0
|
|
|
|
|
0
|
print $cpanfile->to_string, "\n"; |
178
|
|
|
|
|
|
|
} |
179
|
15
|
|
|
|
|
2071
|
return $cpanfile; |
180
|
|
|
|
|
|
|
} elsif ($self->{print}) { |
181
|
0
|
|
|
|
|
0
|
$self->_print_prereqs; |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
} |
184
|
27
|
|
|
|
|
165
|
$self->{prereqs}; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
0
|
1
|
0
|
sub index { shift->{index} } |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub _print_prereqs { |
190
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
0
|
my $combined = CPAN::Meta::Requirements->new; |
193
|
|
|
|
|
|
|
|
194
|
0
|
|
|
|
|
0
|
for my $req ($self->_requirements) { |
195
|
0
|
|
|
|
|
0
|
$combined->add_requirements($req); |
196
|
|
|
|
|
|
|
} |
197
|
0
|
|
|
|
|
0
|
my $hash = $combined->as_string_hash; |
198
|
0
|
|
|
|
|
0
|
for my $module (sort keys %$hash) { |
199
|
0
|
0
|
|
|
|
0
|
next if $module eq 'perl'; |
200
|
0
|
|
0
|
|
|
0
|
my $version = $hash->{$module} || 0; |
201
|
0
|
0
|
|
|
|
0
|
$version = qq{"$version"} unless $version =~ /^[0-9]+(?:\.[0-9]+)?$/; |
202
|
0
|
0
|
|
|
|
0
|
print $version eq '0' ? "$module\n" : "$module~$version\n"; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub _requirements { |
207
|
54
|
|
|
54
|
|
131
|
my ($self, $prereqs) = @_; |
208
|
|
|
|
|
|
|
|
209
|
54
|
|
33
|
|
|
288
|
$prereqs ||= $self->{prereqs}; |
210
|
54
|
|
|
|
|
534
|
my @phases = qw/configure runtime build test/; |
211
|
54
|
50
|
|
|
|
169
|
push @phases, 'develop' if $self->{develop}; |
212
|
54
|
0
|
|
|
|
189
|
my @types = $self->{suggests} ? qw/requires recommends suggests/ : $self->{recommends} ? qw/requires recommends/ : qw/requires/; |
|
|
50
|
|
|
|
|
|
213
|
54
|
|
|
|
|
86
|
my @requirements; |
214
|
54
|
|
|
|
|
117
|
for my $phase (@phases) { |
215
|
216
|
|
|
|
|
880
|
for my $type (@types) { |
216
|
648
|
|
|
|
|
2566
|
my $req = $prereqs->requirements_for($phase, $type); |
217
|
648
|
100
|
|
|
|
19519
|
next unless $req->required_modules; |
218
|
57
|
|
|
|
|
347
|
push @requirements, $req; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
54
|
100
|
|
|
|
360
|
if ($self->{features}) { |
223
|
18
|
50
|
|
|
|
40
|
my @feature_prereqs = grep defined, map {$self->{features}{$_}{prereqs}} keys %{$self->{features} || {}}; |
|
18
|
|
|
|
|
63
|
|
|
18
|
|
|
|
|
65
|
|
224
|
18
|
|
|
|
|
50
|
for my $feature_prereqs (@feature_prereqs) { |
225
|
15
|
|
|
|
|
30
|
for my $phase (@phases) { |
226
|
60
|
|
|
|
|
230
|
for my $type (@types) { |
227
|
180
|
|
|
|
|
668
|
my $req = $feature_prereqs->requirements_for($phase, $type); |
228
|
180
|
100
|
|
|
|
5247
|
next unless $req->required_modules; |
229
|
18
|
|
|
|
|
98
|
push @requirements, $req; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
54
|
|
|
|
|
228
|
@requirements; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub _exclude_local_modules { |
239
|
42
|
|
|
42
|
|
222
|
my $self = shift; |
240
|
|
|
|
|
|
|
|
241
|
42
|
100
|
|
|
|
89
|
my @local_dirs = ("inc", @{$self->{libs} || []}); |
|
42
|
|
|
|
|
319
|
|
242
|
42
|
|
|
|
|
287
|
for my $dir (@local_dirs) { |
243
|
44
|
|
|
|
|
348
|
my $local_dir = File::Spec->catdir($self->{base_dir}, $dir); |
244
|
44
|
100
|
|
|
|
846
|
next unless -d $local_dir; |
245
|
|
|
|
|
|
|
find({ |
246
|
|
|
|
|
|
|
wanted => sub { |
247
|
6
|
|
|
6
|
|
19
|
my $file = $_; |
248
|
6
|
100
|
|
|
|
381
|
return unless -f $file; |
249
|
2
|
|
|
|
|
106
|
my $relpath = File::Spec->abs2rel($file, $local_dir); |
250
|
|
|
|
|
|
|
|
251
|
2
|
50
|
|
|
|
13
|
return unless $relpath =~ /\.pm$/; |
252
|
2
|
|
|
|
|
6
|
my $module = $relpath; |
253
|
2
|
|
|
|
|
8
|
$module =~ s!\.pm$!!; |
254
|
2
|
|
|
|
|
9
|
$module =~ s![\\/]!::!g; |
255
|
2
|
|
|
|
|
5
|
$self->{possible_modules}{$module} = 1; |
256
|
2
|
100
|
|
|
|
42
|
$self->{possible_modules}{"inc::$module"} = 1 if $dir eq 'inc'; |
257
|
|
|
|
|
|
|
}, |
258
|
2
|
|
|
|
|
156
|
no_chdir => 1, |
259
|
|
|
|
|
|
|
}, $local_dir); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
42
|
|
|
|
|
149
|
my $private_re = $self->{private_re}; |
263
|
42
|
|
|
|
|
169
|
for my $req ($self->_requirements) { |
264
|
59
|
|
|
|
|
133
|
for my $module ($req->required_modules) { |
265
|
161
|
100
|
100
|
|
|
825
|
next unless $self->{possible_modules}{$module} or ($private_re and $module =~ /$private_re/); |
|
|
|
100
|
|
|
|
|
266
|
8
|
|
|
|
|
29
|
$req->clear_requirement($module); |
267
|
8
|
50
|
|
|
|
111
|
if ($self->{verbose}) { |
268
|
0
|
|
|
|
|
0
|
print STDERR " excluded $module (local)\n"; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub _exclude_core_prereqs { |
275
|
6
|
|
|
6
|
|
11
|
my $self = shift; |
276
|
|
|
|
|
|
|
|
277
|
6
|
50
|
|
|
|
14
|
eval { require Module::CoreList; Module::CoreList->VERSION('2.99') } or die "requires Module::CoreList 2.99"; |
|
6
|
|
|
|
|
5004
|
|
|
6
|
|
|
|
|
175970
|
|
278
|
|
|
|
|
|
|
|
279
|
6
|
|
100
|
|
|
39
|
my $perl_version = $self->{perl_version} || $self->_find_used_perl_version || '5.008001'; |
280
|
6
|
100
|
|
|
|
235
|
if ($perl_version =~ /^v?5\.(0?[1-9][0-9]?)(?:\.([0-9]))?$/) { |
281
|
1
|
|
50
|
|
|
14
|
$perl_version = sprintf '5.%03d%03d', $1, $2 || 0; |
282
|
|
|
|
|
|
|
} |
283
|
6
|
50
|
|
|
|
692
|
$perl_version = '5.008001' unless exists $Module::CoreList::version{$perl_version}; |
284
|
|
|
|
|
|
|
|
285
|
6
|
|
|
|
|
52
|
my %core_alias = ( |
286
|
|
|
|
|
|
|
'Getopt::Long::Parser' => 'Getopt::Long', |
287
|
|
|
|
|
|
|
'Tie::File::Cache' => 'Tie::File', |
288
|
|
|
|
|
|
|
'Tie::File::Heap' => 'Tie::File', |
289
|
|
|
|
|
|
|
'Tie::StdScalar' => 'Tie::Scalar', |
290
|
|
|
|
|
|
|
'Tie::StdArray' => 'Tie::Array', |
291
|
|
|
|
|
|
|
'Tie::StdHash' => 'Tie::Hash', |
292
|
|
|
|
|
|
|
'Tie::ExtraHash' => 'Tie::Hash', |
293
|
|
|
|
|
|
|
'Tie::RefHash::Nestable' => 'Tie::RefHash', |
294
|
|
|
|
|
|
|
); |
295
|
|
|
|
|
|
|
|
296
|
6
|
|
|
|
|
18
|
for my $req ($self->_requirements) { |
297
|
8
|
|
|
|
|
28
|
for my $module ($req->required_modules) { |
298
|
27
|
50
|
|
|
|
1241
|
$module = $core_alias{$module} if exists $core_alias{$module}; |
299
|
27
|
100
|
66
|
|
|
88
|
if (Module::CoreList::is_core($module, undef, $perl_version) and |
300
|
|
|
|
|
|
|
!Module::CoreList::deprecated_in($module, undef, $perl_version) |
301
|
|
|
|
|
|
|
) { |
302
|
20
|
50
|
|
|
|
70399
|
my $core_version = $Module::CoreList::version{$perl_version}{$module} or next; |
303
|
20
|
100
|
|
|
|
110
|
next unless $req->accepts_module($module => $core_version); |
304
|
19
|
|
|
|
|
1681
|
$req->clear_requirement($module); |
305
|
19
|
50
|
|
|
|
329
|
if ($self->{verbose}) { |
306
|
0
|
|
|
|
|
0
|
print STDERR " excluded $module ($perl_version core)\n"; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub _find_used_perl_version { |
314
|
6
|
|
|
6
|
|
15
|
my $self = shift; |
315
|
6
|
|
|
|
|
13
|
my @perl_versions; |
316
|
6
|
|
|
|
|
36
|
my $perl_requirements = CPAN::Meta::Requirements->new; |
317
|
6
|
|
|
|
|
99
|
for my $req ($self->_requirements) { |
318
|
8
|
|
|
|
|
27
|
my $perl_req = $req->requirements_for_module('perl'); |
319
|
8
|
100
|
|
|
|
117
|
$perl_requirements->add_string_requirement('perl', $perl_req) if $perl_req; |
320
|
|
|
|
|
|
|
} |
321
|
6
|
50
|
|
|
|
148
|
return $perl_requirements->is_simple ? $perl_requirements->requirements_for_module('perl') : undef; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub _add_test_requires { |
325
|
42
|
|
|
42
|
|
178
|
my ($self, $force) = @_; |
326
|
|
|
|
|
|
|
|
327
|
42
|
50
|
|
|
|
299
|
if (my $test_reqs = $self->{prereqs}->requirements_for('test', 'requires')) { |
328
|
42
|
|
|
|
|
1950
|
my @required_modules = $test_reqs->required_modules; |
329
|
42
|
|
|
|
|
342
|
for my $module (@required_modules) { |
330
|
10
|
100
|
|
|
|
121
|
$force = 1 if exists $IsTestClassFamily{$module}; |
331
|
10
|
100
|
|
|
|
23
|
my $relpath = $self->{possible_modules}{$module} or next; |
332
|
3
|
50
|
|
|
|
11
|
my $context = delete $self->{_test_pm}{$relpath} or next; |
333
|
3
|
|
|
|
|
112
|
$test_reqs->add_requirements($context->requires); |
334
|
3
|
50
|
33
|
|
|
330
|
if ($self->{recommends} or $self->{suggests}) { |
335
|
3
|
|
|
|
|
11
|
$self->{prereqs}->requirements_for('test', 'recommends')->add_requirements($context->recommends); |
336
|
|
|
|
|
|
|
} |
337
|
3
|
50
|
|
|
|
28
|
if ($self->{suggests}) { |
338
|
3
|
|
|
|
|
9
|
$self->{prereqs}->requirements_for('test', 'suggests')->add_requirements($context->suggests); |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
} |
341
|
42
|
100
|
|
|
|
215
|
if ($force) { |
342
|
2
|
50
|
|
|
|
4
|
for my $context (values %{$self->{_test_pm} || {}}) { |
|
2
|
|
|
|
|
10
|
|
343
|
2
|
|
|
|
|
7
|
$test_reqs->add_requirements($context->requires); |
344
|
2
|
50
|
33
|
|
|
205
|
if ($self->{recommends} or $self->{suggests}) { |
345
|
2
|
|
|
|
|
6
|
$self->{prereqs}->requirements_for('test', 'recommends')->add_requirements($context->recommends); |
346
|
|
|
|
|
|
|
} |
347
|
2
|
50
|
|
|
|
17
|
if ($self->{suggests}) { |
348
|
2
|
|
|
|
|
7
|
$self->{prereqs}->requirements_for('test', 'suggests')->add_requirements($context->suggests); |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub _dedupe { |
356
|
42
|
|
|
42
|
|
78
|
my $self = shift; |
357
|
|
|
|
|
|
|
|
358
|
42
|
|
|
|
|
88
|
my $prereqs = $self->{prereqs}; |
359
|
|
|
|
|
|
|
|
360
|
42
|
100
|
|
|
|
86
|
my %features = map {$_ => $self->{features}{$_}{prereqs}} keys %{$self->{features} || {}}; |
|
12
|
|
|
|
|
47
|
|
|
42
|
|
|
|
|
231
|
|
361
|
|
|
|
|
|
|
|
362
|
42
|
|
|
|
|
229
|
dedupe_prereqs_and_features($prereqs, \%features); |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
sub _get_uri { |
366
|
0
|
|
|
0
|
|
0
|
my ($self, $module) = @_; |
367
|
0
|
|
0
|
|
|
0
|
$self->{uri_cache}{$module} ||= $self->__get_uri($module); |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub __get_uri { |
371
|
0
|
|
|
0
|
|
0
|
my ($self, $module) = @_; |
372
|
0
|
0
|
|
|
|
0
|
my $res = $self->{index}->search_packages({ package => $module }) or return; |
373
|
|
|
|
|
|
|
## ignore (non-dual) core modules |
374
|
0
|
0
|
|
|
|
0
|
return if URI->new($res->{uri})->dist_name eq 'perl'; |
375
|
0
|
|
|
|
|
0
|
return $res->{uri}; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub _dedupe_indexed_prereqs { |
379
|
0
|
|
|
0
|
|
0
|
my ($self, $prereqs) = @_; |
380
|
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
0
|
require URI::cpan; |
382
|
|
|
|
|
|
|
|
383
|
0
|
|
|
|
|
0
|
for my $req ($self->_requirements($prereqs)) { |
384
|
0
|
|
|
|
|
0
|
my %uri_map; |
385
|
0
|
|
|
|
|
0
|
for my $module ($req->required_modules) { |
386
|
0
|
0
|
|
|
|
0
|
next if $module eq 'perl'; |
387
|
0
|
0
|
|
|
|
0
|
my $uri = $self->_get_uri($module) or next; |
388
|
0
|
|
|
|
|
0
|
$uri_map{$uri}{$module} = $req->requirements_for_module($module); |
389
|
|
|
|
|
|
|
} |
390
|
0
|
|
|
|
|
0
|
for my $uri (keys %uri_map) { |
391
|
0
|
|
|
|
|
0
|
my @modules = keys %{$uri_map{$uri}}; |
|
0
|
|
|
|
|
0
|
|
392
|
0
|
0
|
|
|
|
0
|
next if @modules < 2; |
393
|
|
|
|
|
|
|
|
394
|
0
|
|
|
|
|
0
|
my @modules_without_version = grep {!$uri_map{$uri}{$_}} @modules; |
|
0
|
|
|
|
|
0
|
|
395
|
0
|
0
|
|
|
|
0
|
next unless @modules_without_version; |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
# clear unversioned prereqs if a versioned prereq exists |
398
|
0
|
0
|
|
|
|
0
|
if (@modules > @modules_without_version) { |
399
|
0
|
|
|
|
|
0
|
$req->clear_requirement($_) for @modules_without_version; |
400
|
0
|
|
|
|
|
0
|
next; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
# Replace with the main module if none is versioned |
404
|
0
|
|
|
|
|
0
|
my $dist = URI->new($uri)->dist_name; |
405
|
0
|
|
|
|
|
0
|
(my $main_module = $dist) =~ s/-/::/g; |
406
|
0
|
0
|
|
|
|
0
|
if ($self->_get_uri($main_module)) { |
407
|
0
|
|
|
|
|
0
|
$req->add_minimum($main_module); |
408
|
0
|
|
|
|
|
0
|
for my $module (@modules_without_version) { |
409
|
0
|
0
|
|
|
|
0
|
next if $main_module eq $module; |
410
|
0
|
|
|
|
|
0
|
$req->clear_requirement($module); |
411
|
0
|
0
|
|
|
|
0
|
if ($self->{verbose}) { |
412
|
0
|
|
|
|
|
0
|
print STDERR " deduped $module (in favor of $main_module)\n"; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
} else { |
416
|
|
|
|
|
|
|
# special case for distributions without a main module |
417
|
0
|
|
|
|
|
0
|
my %score; |
418
|
0
|
|
|
|
|
0
|
for my $module (@modules_without_version) { |
419
|
0
|
|
|
|
|
0
|
my $depth = $module =~ s/::/::/g; |
420
|
0
|
|
|
|
|
0
|
my $length = length $module; |
421
|
0
|
|
0
|
|
|
0
|
$score{$module} = join ".", ($depth || 0), $length; |
422
|
|
|
|
|
|
|
} |
423
|
0
|
0
|
|
|
|
0
|
my $topmost = (sort {$score{$a} <=> $score{$b} or $a cmp $b} @modules_without_version)[0]; |
|
0
|
|
|
|
|
0
|
|
424
|
0
|
|
|
|
|
0
|
for my $module (@modules_without_version) { |
425
|
0
|
0
|
|
|
|
0
|
next if $topmost eq $module; |
426
|
0
|
|
|
|
|
0
|
$req->clear_requirement($module); |
427
|
0
|
0
|
|
|
|
0
|
if ($self->{verbose}) { |
428
|
0
|
|
|
|
|
0
|
print STDERR " deduped $module (in favor of $topmost)\n"; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
sub _scan_dir { |
437
|
22
|
|
|
22
|
|
87
|
my ($self, $dir) = @_; |
438
|
|
|
|
|
|
|
find ({ |
439
|
|
|
|
|
|
|
no_chdir => 1, |
440
|
|
|
|
|
|
|
wanted => sub { |
441
|
87
|
|
|
87
|
|
260
|
my $file = $_; |
442
|
87
|
100
|
|
|
|
5087
|
return unless -f $file; |
443
|
42
|
|
|
|
|
2490
|
my $relpath = File::Spec->abs2rel($file, $self->{base_dir}); |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
return unless $relpath =~ /\.(?:pl|PL|pm|cgi|psgi|t)$/ or |
446
|
|
|
|
|
|
|
dirname($relpath) =~ m!\b(?:bin|scripts?)$! or |
447
|
42
|
0
|
33
|
|
|
342
|
($self->{develop} and $relpath =~ /^(?:author)\b/); |
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
448
|
42
|
|
|
|
|
164
|
$self->_scan_file($file); |
449
|
|
|
|
|
|
|
}, |
450
|
22
|
|
|
|
|
2166
|
}, $dir); |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
sub _scan_file { |
454
|
74
|
|
|
74
|
|
226
|
my ($self, $file) = @_; |
455
|
|
|
|
|
|
|
|
456
|
74
|
|
|
|
|
127
|
$file =~ s|\\|/|g if WIN32; |
457
|
74
|
100
|
|
|
|
238
|
if ($self->{ignore_re}) { |
458
|
6
|
100
|
|
|
|
194
|
return if $file =~ /\b$self->{ignore_re}\b/; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
71
|
100
|
100
|
|
|
400
|
my $optional = $self->{optional_re} && $file =~ /\b$self->{optional_re}\b/ ? 1 : 0; |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
my $context = Perl::PrereqScanner::NotQuiteLite->new( |
464
|
|
|
|
|
|
|
parsers => $self->{parsers}, |
465
|
|
|
|
|
|
|
recommends => $self->{recommends}, |
466
|
|
|
|
|
|
|
suggests => $self->{suggests}, |
467
|
|
|
|
|
|
|
verbose => $self->{verbose}, |
468
|
71
|
|
|
|
|
679
|
optional => $optional, |
469
|
|
|
|
|
|
|
)->scan_file($file); |
470
|
|
|
|
|
|
|
|
471
|
71
|
|
|
|
|
10008
|
my $relpath = File::Spec->abs2rel($file, $self->{base_dir}); |
472
|
71
|
|
|
|
|
220
|
$relpath =~ s|\\|/|g if WIN32; |
473
|
|
|
|
|
|
|
|
474
|
71
|
|
|
|
|
171
|
my $prereqs = $self->{prereqs}; |
475
|
71
|
100
|
|
|
|
242
|
if ($self->{features}) { |
476
|
22
|
|
|
|
|
42
|
for my $identifier (keys %{$self->{features}}) { |
|
22
|
|
|
|
|
88
|
|
477
|
22
|
|
|
|
|
53
|
my $feature = $self->{features}{$identifier}; |
478
|
22
|
100
|
|
|
|
34
|
if (grep {$file =~ m!^$_(?:/|$)!} @{$feature->{paths}}) { |
|
25
|
|
|
|
|
527
|
|
|
22
|
|
|
|
|
59
|
|
479
|
12
|
|
66
|
|
|
123
|
$prereqs = $feature->{prereqs} ||= CPAN::Meta::Prereqs->new; |
480
|
12
|
|
|
|
|
495
|
last; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
71
|
100
|
|
|
|
785
|
if ($relpath =~ m!(?:^|[\\/])t[\\/]!) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
486
|
10
|
100
|
|
|
|
51
|
if ($relpath =~ /\.t$/) { |
|
|
100
|
|
|
|
|
|
487
|
3
|
|
|
|
|
15
|
$self->_add($prereqs, test => $context); |
488
|
|
|
|
|
|
|
} elsif ($relpath =~ /\.pm$/) { |
489
|
6
|
|
|
|
|
23
|
$self->{_test_pm}{$relpath} = $context; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
} elsif ($relpath =~ m!(?:^|[\\/])(?:xt|inc|author)[\\/]!) { |
492
|
0
|
|
|
|
|
0
|
$self->_add($prereqs, develop => $context); |
493
|
|
|
|
|
|
|
} elsif ($relpath =~ m!(?:(?:^|[\\/])Makefile|^Build)\.PL$!) { |
494
|
0
|
|
|
|
|
0
|
$self->_add($prereqs, configure => $context); |
495
|
|
|
|
|
|
|
} elsif ($relpath =~ m!(?:^|[\\/])(?:.+)\.PL$!) { |
496
|
0
|
|
|
|
|
0
|
$self->_add($prereqs, build => $context); |
497
|
|
|
|
|
|
|
} else { |
498
|
61
|
|
|
|
|
278
|
$self->_add($prereqs, runtime => $context); |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
71
|
100
|
|
|
|
1631
|
if ($relpath =~ /\.pm$/) { |
502
|
67
|
|
|
|
|
144
|
my $module = $relpath; |
503
|
67
|
|
|
|
|
282
|
$module =~ s!\.pm$!!; |
504
|
67
|
|
|
|
|
246
|
$module =~ s![\\/]!::!g; |
505
|
67
|
|
|
|
|
241
|
$self->{possible_modules}{$module} = $relpath; |
506
|
67
|
|
|
|
|
234
|
$module =~ s!^(?:inc|blib|x?t)::!!; |
507
|
67
|
|
|
|
|
156
|
$self->{possible_modules}{$module} = $relpath; |
508
|
67
|
|
|
|
|
192
|
$module =~ s!^lib::!!; |
509
|
67
|
|
|
|
|
4444
|
$self->{possible_modules}{$module} = $relpath; |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
sub _add { |
514
|
64
|
|
|
64
|
|
189
|
my ($self, $prereqs, $phase, $context) = @_; |
515
|
|
|
|
|
|
|
|
516
|
64
|
|
|
|
|
325
|
$prereqs->requirements_for($phase, 'requires') |
517
|
|
|
|
|
|
|
->add_requirements($context->requires); |
518
|
|
|
|
|
|
|
|
519
|
64
|
50
|
33
|
|
|
7491
|
if ($self->{suggests} or $self->{recommends}) { |
520
|
64
|
|
|
|
|
198
|
$prereqs->requirements_for($phase, 'recommends') |
521
|
|
|
|
|
|
|
->add_requirements($context->recommends); |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
64
|
50
|
|
|
|
1024
|
if ($self->{suggests}) { |
525
|
64
|
|
|
|
|
192
|
$prereqs->requirements_for($phase, 'suggests') |
526
|
|
|
|
|
|
|
->add_requirements($context->suggests); |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
1; |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
__END__ |