line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Module::CPANTS::Kwalitee::Manifest; |
2
|
7
|
|
|
7
|
|
4154
|
use warnings; |
|
7
|
|
|
|
|
34
|
|
|
7
|
|
|
|
|
260
|
|
3
|
7
|
|
|
7
|
|
61
|
use strict; |
|
7
|
|
|
|
|
18
|
|
|
7
|
|
|
|
|
182
|
|
4
|
7
|
|
|
7
|
|
67
|
use File::Spec::Functions qw(catfile); |
|
7
|
|
|
|
|
17
|
|
|
7
|
|
|
|
|
318
|
|
5
|
7
|
|
|
7
|
|
3401
|
use Array::Diff; |
|
7
|
|
|
|
|
50730
|
|
|
7
|
|
|
|
|
80
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '1.02'; |
8
|
|
|
|
|
|
|
$VERSION =~ s/_//; ## no critic |
9
|
|
|
|
|
|
|
|
10
|
56
|
|
|
56
|
1
|
136
|
sub order { 100 } |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
################################################################## |
13
|
|
|
|
|
|
|
# Analyse |
14
|
|
|
|
|
|
|
################################################################## |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub analyse { |
17
|
12
|
|
|
12
|
1
|
48
|
my $class = shift; |
18
|
12
|
|
|
|
|
45
|
my $me = shift; |
19
|
|
|
|
|
|
|
|
20
|
12
|
|
|
|
|
330
|
my $distdir = $me->distdir; |
21
|
12
|
|
|
|
|
150
|
my $manifest_file = catfile($distdir, 'MANIFEST'); |
22
|
|
|
|
|
|
|
|
23
|
12
|
100
|
|
|
|
262
|
if (-e $manifest_file) { |
24
|
|
|
|
|
|
|
# read manifest |
25
|
4
|
50
|
|
|
|
181
|
open(my $fh, '<', $manifest_file) or die "cannot read MANIFEST $manifest_file: $!"; |
26
|
4
|
|
|
|
|
11
|
my %seen; |
27
|
4
|
|
|
|
|
91
|
while (<$fh>) { |
28
|
7
|
|
|
|
|
19
|
chomp; |
29
|
7
|
50
|
|
|
|
32
|
next if /^\s*#/; # discard pure comments |
30
|
7
|
50
|
|
|
|
26
|
if (s/^'(\\[\\']|.+)+'\s*.*/$1/) { |
31
|
0
|
|
|
|
|
0
|
s/\\([\\'])/$1/g; |
32
|
|
|
|
|
|
|
} else { |
33
|
7
|
|
|
|
|
13
|
s/\s.*$//; |
34
|
|
|
|
|
|
|
} # strip quotes and comments |
35
|
7
|
50
|
|
|
|
16
|
next unless $_; # discard blank lines |
36
|
7
|
|
|
|
|
70
|
$seen{$_}++; |
37
|
|
|
|
|
|
|
} |
38
|
4
|
|
|
|
|
43
|
close $fh; |
39
|
|
|
|
|
|
|
|
40
|
4
|
|
|
|
|
25
|
my @manifest = sort keys %seen; |
41
|
4
|
50
|
|
|
|
9
|
my @files = sort keys %{$me->d->{files_hash} || {}}; |
|
4
|
|
|
|
|
112
|
|
42
|
4
|
|
|
|
|
70
|
my @dupes = grep {$seen{$_} > 1} @manifest; |
|
7
|
|
|
|
|
43
|
|
43
|
|
|
|
|
|
|
|
44
|
4
|
|
|
|
|
66
|
my $diff = Array::Diff->diff(\@manifest, \@files); |
45
|
4
|
100
|
66
|
|
|
2171
|
if ($diff->count == 0 && !@dupes) { |
46
|
1
|
|
|
|
|
35
|
$me->d->{manifest_matches_dist} = 1; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
else { |
49
|
3
|
|
|
|
|
91
|
$me->d->{manifest_matches_dist} = 0; |
50
|
3
|
|
|
|
|
48
|
my @error = ( |
51
|
|
|
|
|
|
|
'MANIFEST ('.(@manifest + @dupes).') does not match dist ('.@files."):", |
52
|
|
|
|
|
|
|
); |
53
|
3
|
50
|
|
|
|
15
|
if (my @added = @{$diff->added}) { |
|
3
|
|
|
|
|
79
|
|
54
|
3
|
|
|
|
|
48
|
push @error, "Missing in MANIFEST: ".join(', ', @added); |
55
|
|
|
|
|
|
|
} |
56
|
3
|
100
|
|
|
|
15
|
if (my @deleted = @{$diff->deleted}) { |
|
3
|
|
|
|
|
69
|
|
57
|
1
|
|
|
|
|
13
|
push @error, "Missing in Dist: " . join(', ', @deleted); |
58
|
|
|
|
|
|
|
} |
59
|
3
|
50
|
|
|
|
23
|
if (@dupes) { |
60
|
0
|
|
|
|
|
0
|
push @error, "Duplicates in MANIFEST: " . join(', ', @dupes); |
61
|
|
|
|
|
|
|
} |
62
|
3
|
|
|
|
|
67
|
$me->d->{error}{manifest_matches_dist} = \@error; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Tweak symlinks error for a local distribution (RT #97858) |
66
|
4
|
100
|
100
|
|
|
120
|
if ($me->d->{is_local_distribution} && $me->d->{error}{symlinks}) { |
67
|
1
|
|
|
|
|
59
|
my %manifested = map {$_ => 1} @manifest; |
|
1
|
|
|
|
|
15
|
|
68
|
1
|
|
|
|
|
28
|
my @symlinks = grep {$manifested{$_}} split ',', $me->d->{error}{symlinks}; |
|
1
|
|
|
|
|
27
|
|
69
|
1
|
50
|
|
|
|
14
|
if (@symlinks) { |
70
|
0
|
|
|
|
|
0
|
$me->d->{error}{symlinks} = join ',', @symlinks; |
71
|
|
|
|
|
|
|
} else { |
72
|
1
|
|
|
|
|
31
|
delete $me->d->{error}{symlinks}; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
else { |
77
|
8
|
|
|
|
|
228
|
$me->d->{manifest_matches_dist} = 0; |
78
|
8
|
|
|
|
|
239
|
$me->d->{error}{manifest_matches_dist} = q{Cannot find MANIFEST in dist.}; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
################################################################## |
83
|
|
|
|
|
|
|
# Kwalitee Indicators |
84
|
|
|
|
|
|
|
################################################################## |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub kwalitee_indicators { |
87
|
|
|
|
|
|
|
return [ |
88
|
|
|
|
|
|
|
{ |
89
|
|
|
|
|
|
|
name => 'manifest_matches_dist', |
90
|
|
|
|
|
|
|
error => q{MANIFEST does not match the contents of this distribution.}, |
91
|
|
|
|
|
|
|
remedy => q{Run a proper command ("make manifest" or "./Build manifest", maybe with a force option), or use a distribution builder to generate the MANIFEST. Or update MANIFEST manually.}, |
92
|
12
|
100
|
|
12
|
|
120
|
code => sub { shift->{manifest_matches_dist} ? 1 : 0 }, |
93
|
|
|
|
|
|
|
details => sub { |
94
|
0
|
|
|
0
|
|
0
|
my $d = shift; |
95
|
0
|
|
|
|
|
0
|
my $error = $d->{error}{manifest_matches_dist}; |
96
|
0
|
0
|
|
|
|
0
|
return $error unless ref $error; |
97
|
0
|
|
|
|
|
0
|
return join "\n", @$error; |
98
|
|
|
|
|
|
|
}, |
99
|
|
|
|
|
|
|
} |
100
|
8
|
|
|
8
|
1
|
105
|
]; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
q{Listening to: YAPC::Europe 2007}; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
__END__ |