File Coverage

blib/lib/Module/CPANTS/Kwalitee/Manifest.pm
Criterion Covered Total %
statement 57 64 89.0
branch 18 28 64.2
condition 5 6 83.3
subroutine 8 9 88.8
pod 3 3 100.0
total 91 110 82.7


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__