File Coverage

blib/lib/Test/CheckManifest.pm
Criterion Covered Total %
statement 152 166 91.5
branch 55 80 68.7
condition 33 57 57.8
subroutine 16 16 100.0
pod 1 1 100.0
total 257 320 80.3


line stmt bran cond sub pod time code
1             package Test::CheckManifest;
2              
3             # ABSTRACT: Check if your Manifest matches your distro
4              
5 4     4   3583 use strict;
  4         8  
  4         221  
6 4     4   23 use warnings;
  4         8  
  4         122  
7              
8 4     4   93 use Cwd;
  4         18  
  4         355  
9 4     4   94 use Carp;
  4         9  
  4         344  
10 4     4   22 use File::Spec;
  4         7  
  4         100  
11 4     4   21 use File::Basename;
  4         8  
  4         294  
12 4     4   1523 use Test::Builder;
  4         15133  
  4         92  
13 4     4   23 use File::Find;
  4         8  
  4         1061  
14              
15             our $VERSION = '1.28';
16             our $VERBOSE = 1;
17              
18             my $test = Test::Builder->new();
19             my $test_bool = 1;
20             my $plan = 0;
21             my $counter = 0;
22              
23             sub import {
24 4     4   43 my $self = shift;
25 4         12 my $caller = caller;
26 4         14 my %plan = @_;
27              
28 4         13 for my $func ( qw( ok_manifest ) ) {
29 4     4   21 no strict 'refs';
  4         7  
  4         10498  
30 4         14 *{$caller."::".$func} = \&$func;
  4         34  
31             }
32              
33 4         25 $test->exported_to($caller);
34 4         53 $test->plan(%plan);
35            
36 4 100       1567 $plan = 1 if(exists $plan{tests});
37             }
38              
39             sub ok_manifest{
40 11     11 1 252 my ($hashref,$msg) = @_;
41            
42 11 100       51 $test->plan(tests => 1) unless $plan;
43            
44 11         645 my $is_hashref = 1;
45 11 100       57 $is_hashref = 0 unless ref($hashref);
46            
47 11 100       35 unless ( $is_hashref ) {
48 1         3 $msg = $hashref;
49 1         3 $hashref = {};
50             }
51              
52 11         1416 my $tmp_path = dirname( File::Spec->rel2abs( $0 ) );
53              
54 11 50       69 if ( $hashref->{file} ) {
    100          
55 0         0 $tmp_path = dirname $hashref->{file};
56             }
57             elsif ( $hashref->{dir} ) {
58 1         4 $tmp_path = $hashref->{dir};
59             }
60            
61 11         21 my $bool = 1;
62 11         762 my $home = Cwd::realpath( $tmp_path );
63 11         23 my $manifest;
64              
65 11         20 my $counter = 0;
66 11         19 while ( 1 ) {
67 22         223 my $manifest_path = File::Spec->catfile( $home . '/MANIFEST' );
68 22 100       522 last if -f $manifest_path;
69              
70 11         776 my $tmp_home = Cwd::realpath( File::Spec->catdir( $home, '..' ) );
71              
72 11 50 33     180 last if !$tmp_home || $tmp_home eq $home || $counter++ == 20;
      33        
73 11         52 $home = $tmp_home;
74             }
75              
76 11         22 eval { $manifest = Cwd::realpath( $home . '/MANIFEST' ); 1; };
  11         733  
  11         69  
77 11 50       43 if ( !$manifest ) {
78 0         0 $test->BAILOUT( 'Cannot find a MANIFEST. Please check!' );
79             }
80            
81 11         21 my $skip;
82 11         175 my $skip_path = File::Spec->catfile( $home, 'MANIFEST.SKIP' );
83 11 50       33 eval { $skip = Cwd::realpath( $skip_path ) if -f $skip_path; 1; };
  11         186  
  11         21  
84            
85 11         23 my @missing_files = ();
86 11         21 my @files_plus = ();
87 11         35 my $arref = ['/blib' , '/_build'];
88 11 100 100     90 my $filter = $is_hashref &&
89             $hashref->{filter} ? $hashref->{filter} : [];
90 11 100 66     93 my $comb = $is_hashref &&
91             $hashref->{bool} &&
92             $hashref->{bool} =~ m/^and$/i ?
93             'and' :
94             'or';
95            
96 11 100 100     112 push @$arref, @{$hashref->{exclude}}
  5   66     16  
97             if $is_hashref and exists $hashref->{exclude} and
98             ref($hashref->{exclude}) eq 'ARRAY';
99            
100 11         33 for(@$arref){
101 27 50       131 croak 'path in excluded array must be "absolute"' unless m!^/!;
102 27         81 my $path = $home . $_;
103 27 100       530 next unless -e $path;
104 13         770 $_ = Cwd::realpath($path);
105             }
106            
107 11         35 @$arref = grep { defined }@$arref;
  27         91  
108            
109 11 50       586 unless( open my $fh, '<', $manifest ){
110 0         0 $bool = 0;
111 0         0 $msg = "can't open $manifest";
112             }
113             else{
114             { # extra block to use "last"
115            
116 11         19 my $files_in_skip = _read_skip( $skip, \$msg, \$bool );
  11         49  
117 11 50       41 last unless $files_in_skip;
118              
119 11         44 my @files = _read_file( $fh );
120 11         169 close $fh;
121            
122 11         33 chomp @files;
123            
124             {
125 11         20 local $/ = "\r";
  11         68  
126 11         39 chomp @files;
127             }
128            
129 11         31 for my $tfile(@files){
130 132         404 $tfile = (split(/\s{2,}/,$tfile,2))[0];
131 132 50       2989 next unless -e $home . '/' . $tfile;
132 132         9494 $tfile = Cwd::realpath($home . '/' . $tfile);
133             }
134            
135 11         26 my (@dir_files,%files_hash,%excluded);
136 11         162 @files_hash{@files} = ();
137            
138             find({no_chdir => 1,
139             wanted => sub{
140 616     616   1300 my $file = $File::Find::name;
141 616         1527 my $is_excluded = _is_excluded(
142             $file,
143             $arref,
144             $filter,
145             $comb,
146             $files_in_skip,
147             $home,
148             );
149            
150 616 100 100     45712 push(@dir_files,Cwd::realpath($file)) if -f $file and !$is_excluded;
151            
152 616 100 100     52973 $excluded{$file} = 1 if -f $file and $is_excluded
153             }
154 11         1269 },$home);
155              
156             #use Data::Dumper;
157             #print STDERR ">>",++$counter,":",Dumper(\@files,\@dir_files);
158             SFILE:
159 11         144 for my $file(@dir_files){
160 164         234 for my $check(@files){
161 1388 100       4044 if($file eq $check){
162 110         279 delete $files_hash{$check};
163 110         267 next SFILE;
164             }
165             }
166 54         143 push(@missing_files,$file);
167 54         145 $bool = 0;
168             }
169            
170 11         155 delete $files_hash{$_} for keys %excluded;
171 11         59 @files_plus = sort keys %files_hash;
172 11 50       175 $bool = 0 if scalar @files_plus > 0;
173            
174             } # close extra block
175             }
176            
177 11         119 my $diag = 'The following files are not named in the MANIFEST file: '.
178             join(', ',@missing_files);
179 11         37 my $plus = 'The following files are not part of distro but named in the MANIFEST file: '.
180             join(', ',@files_plus);
181            
182 11         127 $test->is_num($bool,$test_bool,$msg);
183 11 50 100     13598 $test->diag($diag) if scalar @missing_files >= 1 and $test_bool == 1 and $VERBOSE;
      66        
184 11 0 33     959 $test->diag($plus) if scalar @files_plus >= 1 and $test_bool == 1 and $VERBOSE;
      33        
185             }
186              
187             sub _read_file {
188 11     11   18 my ($fh) = @_;
189            
190 11         15 my @files;
191 11         17 my $selftest = 0;
192              
193 11         262 while( my $fh_line = <$fh> ){
194 132         237 chomp $fh_line;
195            
196 132 50       322 $selftest++ if $fh_line =~ m{# MANIFEST for Test-CheckManifest};
197              
198 132 50       318 next if $fh_line =~ m{ \A \s* \# }x;
199 132 50 33     323 next if $selftest && $fh_line =~ m{# selftest};
200            
201 132         149 my ($file);
202            
203 132 100       386 if ( ($file) = $fh_line =~ /^'(\\[\\']|.+)+'\s*(.*)/) {
204 11         194 $file =~ s/\\([\\'])/$1/g;
205             }
206             else {
207 121         506 ($file) = $fh_line =~ /^(\S+)\s*(.*)/;
208             }
209              
210 132 50       331 next unless $file;
211              
212 132         707 push @files, $file;
213             }
214            
215 11         78 return @files;
216             }
217              
218             sub _not_ok_manifest{
219 6     6   822 $test_bool = 0;
220 6         23 ok_manifest(@_);
221 6         23 $test_bool = 1;
222             }
223              
224             sub _is_excluded{
225 616     616   5379 my ($file,$dirref,$filter,$bool,$files_in_skip,$home) = @_;
226 616         2076 my @excluded_files = qw(
227             pm_to_blib Makefile META.yml Build pod2htmd.tmp
228             pod2htmi.tmp Build.bat .cvsignore MYMETA.json MYMETA.yml
229             );
230              
231 616 50 33     3716 if ( $files_in_skip and 'ARRAY' eq ref $files_in_skip ) {
232 616         6628 (my $local_file = $file) =~ s{\Q$home\E/?}{};
233 616         1013 for my $rx ( @{$files_in_skip} ) {
  616         1970  
234 0         0 my $regex = qr/$rx/;
235 0 0       0 return 1 if $local_file =~ $regex;
236             }
237             }
238            
239 616         1026 my @matches = grep{ $file =~ /$_$/ }@excluded_files;
  6160         66493  
240            
241 616 100       1315 if($bool eq 'or'){
242 559 50 33     1061 push @matches, $file if grep{ref($_) and ref($_) eq 'Regexp' and $file =~ /$_/}@$filter;
  560 100       6602  
243 559 100       1102 push @matches, $file if grep{$file =~ /^\Q$_\E/}@$dirref;
  1344         19194  
244             }
245             else{
246 57 100 66     92 if(grep{$file =~ /$_/ and ref($_) and ref($_) eq 'Regexp'}@$filter and
  57 50 66     565  
  6 50       102  
247             grep{$file =~ /^\Q$_\E/ and not ref($_)}@$dirref){
248 0         0 push @matches, $file;
249             }
250             }
251            
252 616         2422 return scalar @matches;
253             }
254              
255             sub _read_skip {
256 11     11   23 my ($skip, $msg, $bool) = @_;
257              
258 11 50 33     68 return [] unless $skip and -e $skip;
259            
260 0           my @files;
261 0 0 0       if( -e $skip and not open my $skip_fh, '<', $skip ) {
262 0           $$bool = 0;
263 0           $$msg = "can't open $skip";
264 0           return;
265             }
266             else {
267 0           @files = _read_file( $skip_fh );
268             }
269              
270 0           return \@files;
271             }
272              
273             1;
274              
275             __END__