File Coverage

blib/lib/Module/CPANTS/Kwalitee/FindModules.pm
Criterion Covered Total %
statement 70 118 59.3
branch 33 74 44.5
condition 4 15 26.6
subroutine 8 10 80.0
pod 3 3 100.0
total 118 220 53.6


line stmt bran cond sub pod time code
1             package Module::CPANTS::Kwalitee::FindModules;
2 7     7   46803 use warnings;
  7         36  
  7         391  
3 7     7   58 use strict;
  7         16  
  7         242  
4 7     7   529 use File::Spec::Functions qw(catfile);
  7         802  
  7         14357  
5              
6             our $VERSION = '1.02';
7             $VERSION =~ s/_//; ## no critic
8              
9 49     49 1 169 sub order { 30 }
10              
11             ##################################################################
12             # Analyse
13             ##################################################################
14              
15             sub analyse {
16 12     12 1 45 my $class = shift;
17 12         27 my $me = shift;
18 12   50     286 my $files = $me->d->{files_array} || [];
19              
20 12 50 66     345 if ($me->d->{meta_yml} && $me->d->{meta_yml}{provides}) {
21 0         0 my $provides = $me->d->{meta_yml}{provides};
22 0         0 for my $module (sort keys %$provides) {
23 0         0 my $data = $provides->{$module};
24 0 0       0 next unless ref $data eq ref {}; # ignore wrong format
25 0   0     0 my $file = $data->{file} || '';
26 0         0 my $found = {
27             module => $module,
28             file => $file,
29             in_basedir => 0,
30             in_lib => 0,
31             };
32 0         0 my $loc;
33 0 0       0 if ($file =~ /^lib\W/) {
    0          
34 0         0 $found->{in_lib} = 1;
35             }
36             elsif ($file !~ /\//) {
37 0         0 $found->{in_basedir} = 1;
38             }
39              
40 0         0 push @{$me->d->{modules}}, $found;
  0         0  
41 0 0       0 if (exists $me->d->{files_hash}{$file}) {
42 0         0 (my $path_part = $module) =~ s|::|/|g;
43 0 0       0 if ($file =~ /\b$path_part\.pm$/) {
    0          
44 0         0 $me->d->{files_hash}{$file}{module} = $module;
45             } elsif ("$path_part.pm" =~ /\b$file$/) {
46 0   0     0 $me->d->{files_hash}{$file}{module} ||= $module;
47             }
48             } else {
49 0         0 $found->{not_exists} = 1;
50             }
51             }
52             }
53             else {
54 12         265 my %in_basedir = map {$_ => 1} grep {/^[^\/]+\.pm$/} @$files;
  3         26  
  20         132  
55              
56 12         72 foreach my $file (@$files) {
57 20 100       105 next unless $file =~ /\.pm$/;
58 9 50       49 next if $file =~ m{^x?t/};
59 9 50       44 next if $file =~ m{^test/};
60 9 50       54 next if $file =~ m/^(bin|scripts?|ex|eg|examples?|samples?|demos?)\/\w/i;
61 9 50       40 next if $file =~ m{^inc/}; # skip Module::Install stuff
62 9 50       44 next if $file =~ m{^(local|perl5|fatlib)/};
63              
64             # proper file in lib/
65 9 100       78 if ($file =~ m|^lib/(.*)\.pm$|) {
66 6         19 my $module = $1;
67 6         56 $module =~ s|/|::|g;
68 6         15 push (@{$me->d->{modules}}, {
  6         128  
69             module => $module,
70             file => $file,
71             in_basedir => 0,
72             in_lib => 1,
73             });
74 6         221 $me->d->{files_hash}{$file}{module} = $module;
75             }
76             else {
77             # open file and find first package
78 3         36 my ($basename) = $file =~ /(\w+)\.pm/;
79 3         13 my $module;
80 3         13 my $max_lines_to_look_at = 666;
81 3 50       107 open (my $fh, "<", catfile($me->distdir, $file)) or die "__PACKAGE__: Cannot open $file to find package declaration: $!";
82 3         228 while (my $line = <$fh>) {
83 3 50       26 next if $line =~ /^\s*#/; # ignore comments
84 3 50       36 if ($line =~ /^\s*package\s*(.*?)\s*;/) {
85 3         18 $module = $1;
86 3 50 33     42 last if $basename and $module =~ /\b$basename$/;
87             }
88 0 0       0 last if $line =~ /^__(DATA|END)__/;
89 0         0 $max_lines_to_look_at--;
90 0 0       0 last unless $max_lines_to_look_at;
91             }
92             # try to guess from filename
93 3 50       14 unless ($module) {
94 0         0 $file =~ m|(.*)\.pm$|;
95 0         0 $module = $1;
96 0         0 $module =~ s|^[a-z]+/||; # remove lowercase prefixes which most likely are not part of the distname (but something like 'src/')
97 0         0 $module =~ s|/|::|g;
98             }
99 3 50       9 if ($module) {
100 3         70 push(@{$me->d->{modules}}, {
101             module => $module,
102             file => $file,
103 3 50       5 in_basedir => $in_basedir{$file} ? 1 : 0,
104             in_lib => 0,
105             });
106 3         119 $me->d->{files_hash}{$file}{module} = $module;
107             }
108             }
109             }
110             }
111              
112 12         153 for my $file (keys %{$me->d->{files_hash}}) {
  12         239  
113 20 50       222 next unless $file =~ /^inc\/(.+)\.pm/;
114 0         0 my $module = $1;
115 0         0 $module =~ s|/|::|g;
116 0   0     0 push @{$me->d->{included_modules} ||= []}, $module;
  0         0  
117             }
118              
119 12 100       264 if (exists $me->d->{modules}) {
120 9         88 $me->d->{modules} = [sort {$a->{module} cmp $b->{module}} @{$me->d->{modules}}];
  0         0  
  9         153  
121             }
122 12 50       341 if (exists $me->d->{included_modules}) {
123 0         0 $me->d->{included_modules} = [sort @{$me->d->{included_modules}}];
  0         0  
124             }
125              
126 12         127 return 1;
127             }
128              
129              
130              
131             ##################################################################
132             # Kwalitee Indicators
133             ##################################################################
134              
135             sub kwalitee_indicators {
136             return [
137             {
138             name => 'proper_libs',
139             error => q{There is more than one .pm file in the base dir, or the .pm files are not in lib/ directory.},
140             remedy => q{Move your *.pm files in a directory named 'lib'. The directory structure should look like 'lib/Your/Module.pm' for a module named 'Your::Module'. If you need to provide additional files, e.g. for testing, that should not be considered for Kwalitee, then you should look at the 'provides' map in META.yml to limit the files scanned; or use the 'no_index' map to exclude parts of the distribution.},
141             is_extra => 1,
142             code => sub {
143 12     12   94 my $d = shift;
144 12 100       21 my @modules = @{$d->{modules} || []};
  12         89  
145 12 100       44 return 1 unless @modules;
146              
147 9         24 my @not_in_lib = grep { !$_->{in_lib} } @modules;
  9         37  
148 9 100       64 return 1 unless @not_in_lib;
149              
150 3         8 my @in_basedir = grep { $_->{in_basedir} } @not_in_lib;
  3         9  
151 3 50       10 return 1 if @in_basedir == 1;
152              
153 0         0 $d->{error}{proper_libs} = join ', ', map {$_->{file}} @not_in_lib;
  0         0  
154              
155 0         0 return 0;
156             },
157             details => sub {
158 0     0   0 my $d = shift;
159 0 0       0 my @modules = @{$d->{modules} || []};
  0         0  
160 0 0       0 return "No modules were found" unless @modules;
161 0         0 return "The following files were found: ".$d->{error}{proper_libs};
162             },
163             },
164             {
165             name => 'no_missing_files_in_provides',
166             error => q{Provides field in the META.yml lists a file that does not found in the distribution.},
167             remedy => q{Use authoring tool like Dist::Zilla, Milla, and Minilla to generate correct provides.},
168             is_extra => 1,
169             code => sub {
170 12     12   98 my $d = shift;
171 12 100       21 my @modules = @{$d->{modules} || []};
  12         103  
172 12 100       55 return 1 unless @modules;
173              
174 9 50       28 if (my @not_exists = grep { $_->{not_exists} } @modules) {
  9         47  
175 0         0 $d->{error}{no_missing_files_in_provides} = join ', ', map {$_->{file}} @not_exists;
  0         0  
176 0         0 return 0;
177             }
178 9         27 return 1;
179             },
180             details => sub {
181 0     0   0 my $d = shift;
182 0 0       0 my @modules = @{$d->{modules} || []};
  0         0  
183 0 0       0 return "No modules were found" unless @modules;
184 0         0 return "The following files were missing: ".$d->{error}{no_missing_files_in_provides};
185             },
186             },
187 8     8 1 254 ];
188             }
189              
190              
191             q{Favourite record of the moment:
192             Fat Freddys Drop: Based on a true story};
193              
194              
195             __END__