line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Prove::Plugin::TraceUse; |
2
|
|
|
|
|
|
|
|
3
|
13
|
|
|
13
|
|
1153686
|
use warnings; |
|
13
|
|
|
|
|
35
|
|
|
13
|
|
|
|
|
425
|
|
4
|
13
|
|
|
13
|
|
69
|
use strict; |
|
13
|
|
|
|
|
30
|
|
|
13
|
|
|
|
|
468
|
|
5
|
|
|
|
|
|
|
|
6
|
13
|
|
|
13
|
|
11198
|
use version qw/is_lax qv/; our $VERSION = qv('1.0.3'); |
|
13
|
|
|
|
|
34726
|
|
|
13
|
|
|
|
|
86
|
|
7
|
|
|
|
|
|
|
|
8
|
13
|
|
|
13
|
|
1414
|
use Carp; |
|
13
|
|
|
|
|
27
|
|
|
13
|
|
|
|
|
970
|
|
9
|
13
|
|
|
13
|
|
13516
|
use Tree::Simple; |
|
13
|
|
|
|
|
43588
|
|
|
13
|
|
|
|
|
94
|
|
10
|
13
|
|
|
13
|
|
14345
|
use Set::Object qw/set/; |
|
13
|
|
|
|
|
139880
|
|
|
13
|
|
|
|
|
674
|
|
11
|
13
|
|
|
13
|
|
14782
|
use Pod::Perldoc; |
|
13
|
|
|
|
|
336929
|
|
|
13
|
|
|
|
|
592
|
|
12
|
13
|
|
|
13
|
|
12605
|
use File::Slurp; |
|
13
|
|
|
|
|
218374
|
|
|
13
|
|
|
|
|
1173
|
|
13
|
13
|
|
|
13
|
|
15199
|
use Safe; |
|
13
|
|
|
|
|
576585
|
|
|
13
|
|
|
|
|
17825
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $pd; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub _parse_module_and_version { |
18
|
|
|
|
|
|
|
|
19
|
209
|
|
|
209
|
|
426
|
my @parsed = (); |
20
|
|
|
|
|
|
|
|
21
|
209
|
100
|
|
|
|
1598
|
if ( $_[0] =~ /^\s+\d+\.\s+(\S+)(?: ([\d\._]+))?,/ ) { |
22
|
203
|
|
|
|
|
3631
|
@parsed = grep defined , ($1,$2); |
23
|
|
|
|
|
|
|
} |
24
|
209
|
|
|
|
|
2245
|
return @parsed; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _parse_traceuse { |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# General idea: |
31
|
|
|
|
|
|
|
# * create a tree from the indentation levels |
32
|
|
|
|
|
|
|
# * root nodes should be modules with [main] |
33
|
|
|
|
|
|
|
# * output that has less indent modules than any [main] |
34
|
|
|
|
|
|
|
# should give a parse error |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# When tree done: |
37
|
|
|
|
|
|
|
# * check @INC of local system |
38
|
|
|
|
|
|
|
# * root nodes are candidates for being a dependency |
39
|
|
|
|
|
|
|
# * root nodes not in @INC shoule be skipped and next level considered instead |
40
|
|
|
|
|
|
|
|
41
|
1
|
|
|
1
|
|
79
|
my @lines = split /\n/, $_[0]; |
42
|
|
|
|
|
|
|
|
43
|
1
|
|
|
|
|
25
|
my %indent_parents = |
44
|
|
|
|
|
|
|
( 0 => Tree::Simple->new( 1, Tree::Simple->ROOT ) ); |
45
|
|
|
|
|
|
|
|
46
|
1
|
|
|
|
|
70
|
for ( @lines ) { |
47
|
|
|
|
|
|
|
|
48
|
108
|
|
|
|
|
43008
|
my($mod,$ver) = _parse_module_and_version($_); |
49
|
|
|
|
|
|
|
|
50
|
108
|
100
|
|
|
|
324
|
next unless $mod; |
51
|
|
|
|
|
|
|
|
52
|
102
|
|
|
|
|
628
|
my $node = Tree::Simple->new([$mod,$ver]); |
53
|
|
|
|
|
|
|
|
54
|
102
|
|
|
|
|
5103
|
my ($indent) = /^\s+\d+\.(\s+)\S+/; |
55
|
|
|
|
|
|
|
|
56
|
102
|
|
|
|
|
189
|
my $indent_level = length $indent; |
57
|
|
|
|
|
|
|
|
58
|
102
|
|
|
|
|
175
|
$indent_parents{$indent_level} = $node; |
59
|
102
|
|
|
|
|
175
|
my $parent = $indent_parents{$indent_level - 2}; |
60
|
|
|
|
|
|
|
|
61
|
102
|
50
|
|
|
|
230
|
unless ( $parent ) { |
62
|
0
|
|
|
|
|
0
|
confess "Odd, should have had a parent for:\n$_\nIndent: $indent_level, indent: [$indent]\n"; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
102
|
|
|
|
|
10110
|
$parent->addChild( $node ); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
1
|
|
|
|
|
24
|
return $indent_parents{0}; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub _system_inc { |
74
|
|
|
|
|
|
|
|
75
|
36
|
|
|
36
|
|
24682
|
my $negate = shift; |
76
|
|
|
|
|
|
|
|
77
|
36
|
|
|
|
|
182
|
my $s1 = set( @INC ); |
78
|
|
|
|
|
|
|
|
79
|
36
|
50
|
|
|
|
1287
|
my $s2 = set( ".", |
80
|
|
|
|
|
|
|
(exists($ENV{PERL5LIB}) ? split( ":", $ENV{PERL5LIB}) : ()) |
81
|
|
|
|
|
|
|
); |
82
|
|
|
|
|
|
|
|
83
|
36
|
100
|
|
|
|
620
|
my @i = $negate ? (@$s2) : @{$s1 - $s2}; |
|
18
|
|
|
|
|
359
|
|
84
|
|
|
|
|
|
|
|
85
|
36
|
|
|
|
|
4751
|
return @i; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _module_dir { |
90
|
|
|
|
|
|
|
|
91
|
16
|
|
|
16
|
|
12855
|
my ($mod,$check_noninc) = @_; |
92
|
|
|
|
|
|
|
|
93
|
16
|
|
|
|
|
60
|
my @inc = _system_inc; |
94
|
16
|
|
|
|
|
57
|
my @noninc = _system_inc(1); |
95
|
|
|
|
|
|
|
|
96
|
16
|
|
66
|
|
|
89
|
$pd ||= Pod::Perldoc->new; |
97
|
|
|
|
|
|
|
|
98
|
16
|
100
|
|
|
|
1158
|
my $d = $check_noninc ? $pd->searchfor( 1, $mod, @noninc ) : $pd->searchfor( 1, $mod, @inc ); |
99
|
|
|
|
|
|
|
|
100
|
16
|
100
|
|
|
|
889186
|
return unless $d; |
101
|
|
|
|
|
|
|
|
102
|
9
|
|
|
|
|
48
|
(my $m2 = $mod) =~ s|::|/|g; |
103
|
9
|
|
|
|
|
25
|
$m2 .= ".pm"; |
104
|
|
|
|
|
|
|
|
105
|
9
|
|
|
|
|
208
|
$d =~ s|/$m2||; |
106
|
|
|
|
|
|
|
|
107
|
9
|
50
|
|
|
|
403
|
return unless -d $d; |
108
|
|
|
|
|
|
|
|
109
|
9
|
|
|
|
|
66
|
return $d; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub __recursively_check_loaded_modules { |
114
|
3
|
|
|
3
|
|
26
|
my($node,$dep_ref) = @_; |
115
|
|
|
|
|
|
|
|
116
|
3
|
|
|
|
|
7
|
for ( @{ $node->getAllChildren } ) { |
|
3
|
|
|
|
|
15
|
|
117
|
|
|
|
|
|
|
|
118
|
6
|
|
|
|
|
60
|
my $mdir = _module_dir( $_->getNodeValue->[0] ); |
119
|
6
|
|
|
|
|
41
|
my $mdir_n = _module_dir( $_->getNodeValue->[0], 1 ); |
120
|
|
|
|
|
|
|
|
121
|
6
|
100
|
66
|
|
|
58
|
if ( |
122
|
|
|
|
|
|
|
defined($mdir) and not defined($mdir_n) |
123
|
|
|
|
|
|
|
) { |
124
|
5
|
|
|
|
|
35
|
push @$dep_ref, $_->getNodeValue; |
125
|
|
|
|
|
|
|
} else { |
126
|
1
|
|
|
|
|
8
|
__recursively_check_loaded_modules($_, $dep_ref); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub _find_dependent_modules { |
134
|
|
|
|
|
|
|
|
135
|
2
|
|
|
2
|
|
20255
|
my ($t) = @_; |
136
|
|
|
|
|
|
|
|
137
|
2
|
|
|
|
|
5
|
my @dependencies; |
138
|
|
|
|
|
|
|
|
139
|
2
|
|
|
|
|
11
|
__recursively_check_loaded_modules($t,\@dependencies); |
140
|
|
|
|
|
|
|
|
141
|
2
|
|
|
|
|
40
|
return \@dependencies; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub _find_module_in_code { |
146
|
|
|
|
|
|
|
|
147
|
34
|
|
|
34
|
|
120
|
my($mod,$code) = @_; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
## super simple test if the module is present in the code without being comented |
150
|
34
|
|
|
|
|
3705
|
return $code =~ /^[^#]*\b$mod\b.*\d.*$/m; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub _check_makefile_pl_for_module { |
155
|
|
|
|
|
|
|
|
156
|
11
|
|
|
11
|
|
4479
|
my($mod) = @_; |
157
|
|
|
|
|
|
|
|
158
|
11
|
|
|
|
|
33
|
my $mf = read_file( "./Makefile.PL" ); |
159
|
|
|
|
|
|
|
|
160
|
11
|
|
|
|
|
767
|
return _find_module_in_code($mod,$mf); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub _check_build_pl_for_module { |
165
|
|
|
|
|
|
|
|
166
|
11
|
|
|
11
|
|
12666
|
my($mod) = @_; |
167
|
|
|
|
|
|
|
|
168
|
11
|
|
|
|
|
38
|
my $bf = read_file( "./Build.PL" ); |
169
|
|
|
|
|
|
|
|
170
|
11
|
|
|
|
|
1109
|
return _find_module_in_code($mod,$bf); |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub _parse_makefile_pl { |
175
|
|
|
|
|
|
|
|
176
|
3
|
|
|
3
|
|
26808
|
my ($makefile_input) = @_; |
177
|
|
|
|
|
|
|
|
178
|
3
|
|
|
|
|
8
|
my $makefile_content; |
179
|
|
|
|
|
|
|
|
180
|
3
|
100
|
|
|
|
35
|
if ( $makefile_input ) { |
|
|
50
|
|
|
|
|
|
181
|
|
|
|
|
|
|
|
182
|
2
|
50
|
|
|
|
57
|
if ( -e $makefile_input ) { |
183
|
2
|
|
|
|
|
17
|
$makefile_content = read_file($makefile_input); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
else { |
186
|
0
|
|
|
|
|
0
|
croak "Dont know what to do with input"; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
elsif ( -e "Makefile.PL" ) { |
191
|
1
|
|
|
|
|
35
|
$makefile_content = read_file("Makefile.PL"); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
3
|
50
|
|
|
|
284
|
return unless $makefile_content; |
195
|
|
|
|
|
|
|
|
196
|
3
|
|
|
|
|
63
|
my($prereq_content) = $makefile_content =~ /^\s*PREREQ_PM\s*=>\s*({\s*[^}]+})/m; |
197
|
|
|
|
|
|
|
|
198
|
3
|
|
|
|
|
38
|
my $compartment = Safe->new; |
199
|
|
|
|
|
|
|
|
200
|
3
|
|
|
|
|
3712
|
my $prereq_hash_ref = $compartment->reval($prereq_content); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
## make sure it is sane |
203
|
3
|
|
|
|
|
2004
|
while ( my($mod,$ver) = each %$prereq_hash_ref) { |
204
|
|
|
|
|
|
|
|
205
|
0
|
0
|
|
|
|
0
|
if ( not is_lax($ver) ) { |
206
|
0
|
|
|
|
|
0
|
delete $prereq_hash_ref->{$mod}; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
3
|
|
|
|
|
19
|
return $prereq_hash_ref; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub _parse_build_pl { |
216
|
|
|
|
|
|
|
|
217
|
3
|
|
|
3
|
|
16093
|
my ($build_input) = @_; |
218
|
|
|
|
|
|
|
|
219
|
3
|
|
|
|
|
8
|
my $build_content; |
220
|
|
|
|
|
|
|
|
221
|
3
|
100
|
|
|
|
30
|
if ( $build_input ) { |
|
|
50
|
|
|
|
|
|
222
|
|
|
|
|
|
|
|
223
|
2
|
50
|
|
|
|
49
|
if ( -e $build_input ) { |
224
|
2
|
|
|
|
|
11
|
$build_content = read_file($build_input); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
else { |
227
|
0
|
|
|
|
|
0
|
croak "Dont know what to do with input"; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
elsif ( -e "Build.PL" ) { |
232
|
1
|
|
|
|
|
58
|
$build_content = read_file("Build.PL"); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
3
|
50
|
|
|
|
284
|
return unless $build_content; |
236
|
|
|
|
|
|
|
|
237
|
3
|
|
|
|
|
59
|
my($prereq_content) = $build_content =~ /^\s*requires\s*=>\s*({\s*[^}]+})/m; |
238
|
|
|
|
|
|
|
|
239
|
3
|
50
|
|
|
|
11
|
return unless $prereq_content; |
240
|
|
|
|
|
|
|
|
241
|
3
|
|
|
|
|
31
|
my $compartment = Safe->new; |
242
|
3
|
|
|
|
|
3924
|
my $prereq_hash_ref = $compartment->reval($prereq_content); |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
## make sure it is sane |
245
|
3
|
|
|
|
|
1873
|
while ( my($mod,$ver) = each %$prereq_hash_ref) { |
246
|
|
|
|
|
|
|
|
247
|
0
|
0
|
|
|
|
0
|
if ( not is_lax($ver) ) { |
248
|
0
|
|
|
|
|
0
|
delete $prereq_hash_ref->{$mod}; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
3
|
|
|
|
|
18
|
return $prereq_hash_ref; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
{ |
258
|
|
|
|
|
|
|
package TAP::Harness::FOO; |
259
|
|
|
|
|
|
|
|
260
|
13
|
|
|
13
|
|
296
|
use strict; |
|
13
|
|
|
|
|
26
|
|
|
13
|
|
|
|
|
530
|
|
261
|
13
|
|
|
13
|
|
70
|
use warnings; |
|
13
|
|
|
|
|
23
|
|
|
13
|
|
|
|
|
478
|
|
262
|
13
|
|
|
13
|
|
67
|
use version; |
|
13
|
|
|
|
|
26
|
|
|
13
|
|
|
|
|
114
|
|
263
|
|
|
|
|
|
|
|
264
|
13
|
|
|
13
|
|
1197
|
use base 'TAP::Harness'; |
|
13
|
|
|
|
|
20
|
|
|
13
|
|
|
|
|
15898
|
|
265
|
|
|
|
|
|
|
|
266
|
13
|
|
|
13
|
|
215804
|
use File::Temp; |
|
13
|
|
|
|
|
148191
|
|
|
13
|
|
|
|
|
1310
|
|
267
|
13
|
|
|
13
|
|
156
|
use File::Slurp; |
|
13
|
|
|
|
|
26
|
|
|
13
|
|
|
|
|
1034
|
|
268
|
|
|
|
|
|
|
|
269
|
13
|
|
|
13
|
|
79
|
use List::Util qw/max/; |
|
13
|
|
|
|
|
30
|
|
|
13
|
|
|
|
|
1328
|
|
270
|
|
|
|
|
|
|
|
271
|
13
|
|
|
13
|
|
15922
|
use Term::ANSIColor; |
|
13
|
|
|
|
|
113017
|
|
|
13
|
|
|
|
|
13570
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub _uniquify_dependencies { |
274
|
|
|
|
|
|
|
|
275
|
4
|
|
|
4
|
|
24837
|
my $self = shift; |
276
|
|
|
|
|
|
|
|
277
|
4
|
|
|
|
|
8
|
my %d; |
278
|
|
|
|
|
|
|
|
279
|
4
|
|
|
|
|
6
|
for ( @{ $self->{collected_dependencies} } ) { |
|
4
|
|
|
|
|
13
|
|
280
|
|
|
|
|
|
|
|
281
|
9
|
100
|
100
|
|
|
156
|
if ( version->new($_->[1]) > version->new($d{ $_->[0] } || 0) ) { |
282
|
6
|
|
|
|
|
29
|
$d{ $_->[0] } = $_->[1]; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
4
|
|
|
|
|
8
|
my @d; |
288
|
4
|
|
|
|
|
21
|
while ( my ($k,$v) = each %d ) { |
289
|
5
|
|
|
|
|
20
|
push @d, [$k,$v]; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
4
|
|
|
|
|
16
|
$self->{collected_dependencies} = \@d; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub present_dependencies { |
297
|
|
|
|
|
|
|
|
298
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
299
|
|
|
|
|
|
|
|
300
|
0
|
|
|
|
|
0
|
my @d = sort { |
301
|
0
|
|
|
|
|
0
|
$a->[0] cmp $b->[0] |
302
|
0
|
|
|
|
|
0
|
} @{ $self->{collected_dependencies} }; |
303
|
|
|
|
|
|
|
|
304
|
0
|
|
|
|
|
0
|
my $n = max( map {length $_->[0]} @d ) + 2; |
|
0
|
|
|
|
|
0
|
|
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
0
|
print "# TraceUse report:\n"; |
307
|
|
|
|
|
|
|
|
308
|
0
|
0
|
|
|
|
0
|
if ( not @d ) { |
309
|
0
|
|
|
|
|
0
|
print "# no noncore dependencies found\n"; |
310
|
0
|
|
|
|
|
0
|
return; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
0
|
my $makefile_requirements = App::Prove::Plugin::TraceUse::_parse_makefile_pl(); |
314
|
0
|
|
|
|
|
0
|
my $build_requirements = App::Prove::Plugin::TraceUse::_parse_build_pl(); |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
my $present_file_dep = sub { |
317
|
0
|
|
|
0
|
|
0
|
my ($dep_hash) = @_; |
318
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
0
|
my $hash_fails = 0; |
320
|
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
0
|
for (@d) { |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
|
|
0
|
my($mod,$ver) = @$_; |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
|
|
0
|
my $v = $dep_hash->{$mod}; |
326
|
|
|
|
|
|
|
|
327
|
0
|
0
|
0
|
|
|
0
|
if ( not $v ) { |
|
|
0
|
|
|
|
|
|
328
|
0
|
|
|
|
|
0
|
print "# "; |
329
|
0
|
|
|
|
|
0
|
print colored ['bold red'], sprintf "%-${n}s => '%s',\n", "'".$_->[0]."'", $_->[1]; |
330
|
0
|
|
|
|
|
0
|
$hash_fails = 1; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
elsif ( $v and qv($v) < qv($ver) ) { |
333
|
0
|
|
|
|
|
0
|
print "# "; |
334
|
0
|
|
|
|
|
0
|
print colored ['bold yellow'], sprintf "%-${n}s => '%s',\n", "'".$_->[0]."'", $_->[1]; |
335
|
0
|
|
|
|
|
0
|
$hash_fails = 1; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
0
|
0
|
|
|
|
0
|
if ( not $hash_fails ) { |
341
|
0
|
|
|
|
|
0
|
print "# - dependencies are ok\n"; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
0
|
|
|
|
|
0
|
return not $hash_fails; |
345
|
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
0
|
}; |
347
|
|
|
|
|
|
|
|
348
|
0
|
|
|
|
|
0
|
my $dependencies_are_good = 1; |
349
|
|
|
|
|
|
|
|
350
|
0
|
0
|
|
|
|
0
|
if ( $makefile_requirements ) { |
351
|
|
|
|
|
|
|
|
352
|
0
|
|
|
|
|
0
|
print "# Makefile.PL:\n"; |
353
|
0
|
|
|
|
|
0
|
my $ok = $present_file_dep->($makefile_requirements); |
354
|
0
|
|
0
|
|
|
0
|
$dependencies_are_good &&= $ok; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
0
|
0
|
|
|
|
0
|
if ( $build_requirements ) { |
359
|
|
|
|
|
|
|
|
360
|
0
|
|
|
|
|
0
|
print "# Build.PL:\n"; |
361
|
0
|
|
|
|
|
0
|
my $ok = $present_file_dep->($build_requirements); |
362
|
0
|
|
0
|
|
|
0
|
$dependencies_are_good &&= $ok; |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
0
|
0
|
0
|
|
|
0
|
if ( not $dependencies_are_good and 0 ) { |
367
|
0
|
|
|
|
|
0
|
print "# List of dependencies found during testing:\n"; |
368
|
0
|
|
|
|
|
0
|
for ( @d ) { |
369
|
0
|
|
|
|
|
0
|
printf "# %-${n}s => '%s',\n", "'".$_->[0]."'", $_->[1]; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
sub new { |
376
|
|
|
|
|
|
|
|
377
|
1
|
|
|
1
|
|
15
|
my $self = shift; |
378
|
|
|
|
|
|
|
|
379
|
1
|
|
|
|
|
13
|
my $tf = File::Temp->new; |
380
|
1
|
|
|
|
|
756
|
my $fn = "$tf"; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
## add the traceuse option |
383
|
1
|
|
|
|
|
35
|
$_[0]->{switches} = ["-d:TraceUse=hidecore,output:$fn"]; |
384
|
|
|
|
|
|
|
|
385
|
1
|
|
|
|
|
16
|
my $obj = $self->SUPER::new(@_); |
386
|
|
|
|
|
|
|
|
387
|
1
|
|
|
|
|
9125
|
$obj->{collected_dependencies} = []; |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
my $trace_use_sub = sub { |
390
|
|
|
|
|
|
|
|
391
|
0
|
|
|
0
|
|
0
|
my $dt = read_file( $fn ); |
392
|
0
|
|
|
|
|
0
|
my $p = App::Prove::Plugin::TraceUse::_parse_traceuse($dt); |
393
|
0
|
|
|
|
|
0
|
my $deps = App::Prove::Plugin::TraceUse::_find_dependent_modules($p); |
394
|
0
|
|
|
|
|
0
|
push @{ $obj->{collected_dependencies} }, @$deps; |
|
0
|
|
|
|
|
0
|
|
395
|
|
|
|
|
|
|
|
396
|
1
|
|
|
|
|
8
|
}; |
397
|
|
|
|
|
|
|
|
398
|
1
|
|
|
|
|
11
|
$obj->callback( "after_test", $trace_use_sub ); |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
my $collected_dependencies = sub { |
401
|
0
|
|
|
0
|
|
0
|
$obj->_uniquify_dependencies; |
402
|
0
|
|
|
|
|
0
|
$obj->present_dependencies; |
403
|
1
|
|
|
|
|
26
|
}; |
404
|
|
|
|
|
|
|
|
405
|
1
|
|
|
|
|
5
|
$obj->callback( "after_runtests", $collected_dependencies ); |
406
|
|
|
|
|
|
|
|
407
|
1
|
|
|
|
|
20
|
return $obj; |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
sub load { |
415
|
|
|
|
|
|
|
|
416
|
0
|
|
|
0
|
1
|
|
my( $class, $p ) = @_; |
417
|
|
|
|
|
|
|
|
418
|
0
|
|
|
|
|
|
my $app = $p->{app_prove}; |
419
|
|
|
|
|
|
|
|
420
|
0
|
0
|
0
|
|
|
|
if ( defined($app->harness) and $app->harness ne "TAP::Harness" ) { |
421
|
0
|
|
|
|
|
|
croak "TraceUse plugin is only compatible wtih TAP::Harness"; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
0
|
|
|
|
|
|
$app->{harness_class} = "TAP::Harness::FOO"; |
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
|
1; |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
1; # Magic true value required at end of module |
431
|
|
|
|
|
|
|
__END__ |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=encoding utf8 |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=head1 NAME |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
App::Prove::Plugin::TraceUse - Report all modules used during testing |
438
|
|
|
|
|
|
|
and check if they are listed as dependencies in Makefile.PL and |
439
|
|
|
|
|
|
|
Build.PL |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=head1 VERSION |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
This document describes App::Prove::Plugin::TraceUse version 1.0.3 |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=head1 SYNOPSIS |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
# Run this module as a plugin to the prove script, ie: |
450
|
|
|
|
|
|
|
# cd /your/module/folder |
451
|
|
|
|
|
|
|
# prove -l -PTraceUse |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# Will output the following in the end |
454
|
|
|
|
|
|
|
# if dependencies are missing in MakeFile/Build: |
455
|
|
|
|
|
|
|
# (missing deps in red, bad version in yellow) |
456
|
|
|
|
|
|
|
# |
457
|
|
|
|
|
|
|
# [...] |
458
|
|
|
|
|
|
|
# TraceUse report: |
459
|
|
|
|
|
|
|
# Makefile.PL: |
460
|
|
|
|
|
|
|
# 'File::Slurp' => '9999.19', |
461
|
|
|
|
|
|
|
# 'Tree::Simple' => '1.18', |
462
|
|
|
|
|
|
|
# Build.PL: |
463
|
|
|
|
|
|
|
# 'File::Slurp' => '9999.19', |
464
|
|
|
|
|
|
|
# 'Tree::Simple' => '1.18', |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=head1 DESCRIPTION |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
This module keeps track of all modules and versions loaded during |
470
|
|
|
|
|
|
|
testing. if Makefile.PL and Build.PL are formatted as they come from a |
471
|
|
|
|
|
|
|
plain module-starter, it will recognize the requirement list and check |
472
|
|
|
|
|
|
|
this list with what was found during testing. It reports any non-core |
473
|
|
|
|
|
|
|
modules not listed as requirements |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
Currently it does not care about core modules changing between perl |
476
|
|
|
|
|
|
|
versions. |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=head1 INTERFACE |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=head2 load |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
Don't call this. It gets called by App::Prove. Does the following: |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=over |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
=item Makes sure user didnt specify any other harness class than TAP::Harness |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
=item Creates a subclass of TAP::Harness and makes App::Prove use that. |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=item Adds -d:TraceUse=hidecore,output:$fn to perl switches for perl |
491
|
|
|
|
|
|
|
tests. $fn is a temp file name for this test. |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=item Adds a callback to "after_test" to catch TraceUse output |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
=back |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=over |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=item C<< TraceUse plugin is only compatible wtih TAP::Harness >> |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
Apparently you use something else than TAP::Harness. Unfortunately |
504
|
|
|
|
|
|
|
that does not compute with this plugin. |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=item C<< Odd, should have had a parent for... >> |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
Parsing the Devel::TraceUse output failed. Send me data to investigate. |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=back |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
App::Prove::Plugin::TraceUse requires no configuration files or environment variables. |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
App::Prove |
521
|
|
|
|
|
|
|
Test::Perl::Critic |
522
|
|
|
|
|
|
|
Test::Pod::Coverage |
523
|
|
|
|
|
|
|
Test::Most |
524
|
|
|
|
|
|
|
Set::Object |
525
|
|
|
|
|
|
|
Test::Pod |
526
|
|
|
|
|
|
|
File::Slurp |
527
|
|
|
|
|
|
|
Tree::Simple |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
None reported. |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
No bugs have been reported. |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
538
|
|
|
|
|
|
|
C<bug-app-prove-plugin-traceuse@rt.cpan.org>, or through the web interface at |
539
|
|
|
|
|
|
|
L<http://rt.cpan.org>. |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head1 AUTHOR |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Torbjørn Lindahl C<< <torbjorn.lindahl@gmail.com> >> |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
Copyright (c) 2013, Torbjørn Lindahl C<< <torbjorn.lindahl@gmail.com> >>. All rights reserved. |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |
552
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. See L<perlartistic>. |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTY |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY |
558
|
|
|
|
|
|
|
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN |
559
|
|
|
|
|
|
|
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES |
560
|
|
|
|
|
|
|
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER |
561
|
|
|
|
|
|
|
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
562
|
|
|
|
|
|
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE |
563
|
|
|
|
|
|
|
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH |
564
|
|
|
|
|
|
|
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL |
565
|
|
|
|
|
|
|
NECESSARY SERVICING, REPAIR, OR CORRECTION. |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING |
568
|
|
|
|
|
|
|
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR |
569
|
|
|
|
|
|
|
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE |
570
|
|
|
|
|
|
|
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, |
571
|
|
|
|
|
|
|
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE |
572
|
|
|
|
|
|
|
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING |
573
|
|
|
|
|
|
|
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A |
574
|
|
|
|
|
|
|
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF |
575
|
|
|
|
|
|
|
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF |
576
|
|
|
|
|
|
|
SUCH DAMAGES. |