File Coverage

File:blib/lib/App/Project/Doctor/Check/Dependencies.pm
Coverage:97.9%

linestmtbrancondsubtimecode
1package App::Project::Doctor::Check::Dependencies;
2
3
4
4
4
4
4000
4
53
use strict;
4
4
4
4
4
7
4
133
use warnings;
5
4
4
4
4
8
4
18
use autodie qw(:all);
6
7
4
4
4
4
8504
5
14
use parent -norequire, 'App::Project::Doctor::Check::Base';
8
9
4
4
4
4
117
5
121
use Carp qw(croak carp);
10
4
4
4
4
6
6
3134
use Readonly;
11
12our $VERSION = '0.02';
13
14# Modules that ship with Perl core and need no prereq declaration.
15# 'lib' and 'Cwd' are pragmas/modules commonly seen in source but not CPAN deps.
16Readonly::Hash my %CORE => map { $_ => 1 } qw(
17        strict warnings autodie Carp Scalar::Util List::Util POSIX Storable
18        File::Spec File::Find File::Path File::Temp File::Basename File::Copy
19        Data::Dumper Exporter base parent lib overload constant vars utf8 feature
20        Getopt::Long Pod::Usage Params::Validate::Strict Params::Get Readonly
21        Cwd Encode Fcntl IO::File IO::Handle
22);
23
24# Short name shown in check_name and report column headings.
25
2
2
187
sub name        { 'Dependencies' }
26# One-line description for verbose and --help output.
27
1
1
2
sub description { 'All used modules are declared as build prerequisites.' }
28# This check can auto-fix by appending a 'requires' line to cpanfile.
29
2
2
3
sub can_fix     { 1 }
30# Run after POD (40) so dependency errors appear together at the end.
31
2
2
5
sub order       { 50 }
32
33sub check {
34
10
10
99
        my ($self, $ctx) = @_;
35        # Guard: $ctx must support has_file(), abs_path(), and perl_files().
36
10
50
18
        croak 'check requires an App::Project::Doctor::Context' unless ref $ctx;
37
38
10
8
        my @findings;
39
40        # Try to parse the distribution's declared prerequisites.  Returns undef
41        # when no supported builder file exists.
42
10
15
        my $declared = _collect_declared($ctx);
43
10
100
17
        unless (defined $declared) {
44                # Without a builder file we cannot compare; warn rather than error
45                # because the distribution might be using a non-standard build system.
46
2
5
                return _f(
47                        severity => 'warning',
48                        message  => 'No Makefile.PL, Build.PL, or cpanfile -- cannot check prerequisites.',
49                );
50        }
51
52        # Collect every module referenced via 'use' or 'require' in source files.
53
8
12
        my $used = _collect_used($ctx);
54
55        # Build the set of modules this distribution provides.  A module that
56        # lives under lib/ is part of the distribution itself and cannot be its
57        # own prerequisite -- flagging it would be a false positive.
58
8
6
8
8
7
11
        my %own_modules = map { _path_to_module($_) => 1 } @{ $ctx->lib_modules };
59
60        # Any module that is used but neither declared nor bundled in Perl core
61        # is a missing prerequisite -- users of the distribution won't have it.
62
8
8
9
23
        for my $mod (sort keys %{$used}) {
63
16
100
39
                next if $CORE{$mod};          # Core modules need no declaration.
64
6
100
29
                next if $declared->{$mod};    # Already listed as a prereq -- fine.
65
3
50
3
                next if $own_modules{$mod};   # Provided by this distribution itself.
66                push @findings, _f(
67                        severity => 'error',
68                        message  => "Module '$mod' used in source but not declared as a prerequisite.",
69
3
3
5
6
                        detail   => 'Found in: ' . join(', ', @{ $used->{$mod} }),
70                        fix      => _fix_add_prereq($ctx, $mod),
71                );
72        }
73
74        # Only emit a pass finding when every used module is accounted for.
75
8
100
19
        unless (@findings) {
76
5
7
                push @findings, _f(
77                        severity => 'pass',
78                        message  => 'All non-core used modules are declared as prerequisites.',
79                );
80        }
81
82
8
29
        return @findings;
83}
84
85# ---------------------------------------------------------------------------
86# Private helpers
87# ---------------------------------------------------------------------------
88
89# Purpose:    Build a Finding with check_name pre-filled to 'Dependencies'.
90# Entry:      %args is a valid Finding constructor argument list.
91# Exit:       App::Project::Doctor::Finding object.
92# Side effects: None.
93sub _f {
94
10
10
24
        require App::Project::Doctor::Finding;
95        # Prepend check_name so every call site stays concise.
96
10
37
        return App::Project::Doctor::Finding->new(check_name => 'Dependencies', @_);
97}
98
99# Purpose:    Scan source files for 'use' and 'require' statements and return
100#             a map of module name -> list of files where it appears.
101# Entry:      $ctx is a valid Context object with perl_files() support.
102# Exit:       Hashref { module_name => [file, ...] }.
103# Side effects: None (file reads are read-only).
104sub _collect_used {
105
10
10
14
        my $ctx = shift;
106
10
7
        my %used;
107
10
22
        my $files = $ctx->perl_files('lib', 'script', 'bin');
108
10
10
27
12
        for my $rel (@{$files}) {
109
8
8
50
5
10
                my $content = eval { $ctx->slurp($rel) } // next;
110
111                # Remove __END__ and __DATA__ sections.  Everything after either token
112                # is non-executable and may contain stray 'use' keywords (e.g. in
113                # embedded scripts or heredoc data) that are not real dependencies.
114
8
11
                $content =~ s/^__(?:END|DATA)__\b.*\z//ms;
115
116                # Remove POD blocks before scanning.  A SYNOPSIS example such as
117                #   "use L<Foo::Bar>"
118                # fools the regex below into capturing 'L' as a module name because
119                # '<' terminates the [\w:]+ match.  Each POD block runs from any
120                # =word line to the matching =cut (or end of file if =cut is absent).
121
8
9
                $content =~ s/^=[a-z]\w*\b.*?(?:^=cut\b[^\n]*\n|\z)//gms;
122
123                # Now scan what remains (executable code only) for load statements.
124
8
26
                while ($content =~ /^\s*(?:use|require)\s+([\w:]+)/mg) {
125
19
14
                        my $mod = $1;
126
19
100
22
                        next if $mod =~ /^\d/;    # bare version number, e.g. 'use 5.010'
127
18
18
16
44
                        push @{ $used{$mod} }, $rel;
128                }
129        }
130
10
13
        return \%used;
131}
132
133# Purpose:    Parse the distribution's declared prerequisites from cpanfile
134#             or Makefile.PL (via App::makefilepl2cpanfile).
135# Entry:      $ctx is a valid Context object.
136# Exit:       Hashref { module_name => 1 }, or undef when no builder file found.
137# Side effects: May carp if App::makefilepl2cpanfile fails.
138sub _collect_declared {
139
10
10
13
        my $ctx = shift;
140
141        # cpanfile is the preferred format; check it first.
142
10
100
17
        if ($ctx->has_file('cpanfile')) {
143
6
41
                return _parse_cpanfile($ctx->abs_path('cpanfile'));
144        }
145
146        # Fall back to Makefile.PL by converting it to cpanfile syntax in memory.
147
4
100
10
        if ($ctx->has_file('Makefile.PL')) {
148
3
4
                my $text = eval {
149
3
293
                        require App::makefilepl2cpanfile;
150
3
14654
                        App::makefilepl2cpanfile::generate(makefile => $ctx->abs_path('Makefile.PL'))
151                };
152                # Carp rather than die so a broken Makefile.PL doesn't abort the whole run.
153
3
100
1073
                carp "App::makefilepl2cpanfile failed: $@" if $@;
154
3
100
181
                return defined $text ? _parse_cpanfile_text($text) : undef;
155        }
156
157        # No supported builder file found; caller will emit a warning.
158
1
1
        return undef;
159}
160
161# Purpose:    Parse a cpanfile on disk and return its required modules.
162# Entry:      $path is the absolute path to a cpanfile.
163# Exit:       Hashref { module_name => 1 }.
164# Side effects: Opens and reads the file.
165sub _parse_cpanfile {
166
7
7
1436
        my $path = shift;
167
7
6
        my %mods;
168
7
11
        open my $fh, '<', $path;
169
7
1917
        while (<$fh>) {
170                # Match lines like: requires 'Foo::Bar';   or   requires "Foo::Bar" => '1.00';
171                # \s* allows for indented requires inside 'on' phase blocks, e.g.:
172                #   on 'runtime' => sub { requires 'Foo'; };
173
8
100
40
                $mods{$1} = 1 if /^\s*requires\s+['"]?([\w:]+)['"]?/;
174        }
175
7
9
        close $fh;
176
7
776
        return \%mods;
177}
178
179# Purpose:    Parse an in-memory cpanfile string (produced by makefilepl2cpanfile).
180# Entry:      $text is a cpanfile-format string.
181# Exit:       Hashref { module_name => 1 }.
182# Side effects: None.
183sub _parse_cpanfile_text {
184
2
2
4
        my $text = shift;
185
2
2
        my %mods;
186        # Use the same pattern as _parse_cpanfile but on a string instead of a file.
187        # \s* handles indented requires inside 'on' phase blocks.
188
2
44
        for my $line (split /\n/, $text) {
189
16
100
32
                $mods{$1} = 1 if $line =~ /^\s*requires\s+['"]?([\w:]+)['"]?/;
190        }
191
2
4
        return \%mods;
192}
193
194# Purpose:    Convert a lib/-relative file path to a Perl module name.
195# Entry:      $rel is a path like 'lib/Foo/Bar.pm' (forward slashes, always).
196# Exit:       String module name, e.g. 'Foo::Bar'.
197# Side effects: None.
198sub _path_to_module {
199
6
6
6
        my $rel = shift;
200        # Strip the lib/ prefix, convert path separators to ::, remove .pm.
201
6
9
        $rel =~ s{^lib/}{};
202
6
7
        $rel =~ s{/}{::}g;
203
6
9
        $rel =~ s{\.pm$}{};
204
6
10
        return $rel;
205}
206
207# Purpose:    Return a coderef that appends a 'requires' line to cpanfile.
208# Entry:      $ctx is the Context; $mod is the undeclared module name.
209# Exit:       Coderef ($ctx) -> void; appends one line to cpanfile on disk.
210# Side effects: Modifies cpanfile when the coderef is called.
211sub _fix_add_prereq {
212
5
5
13
        my ($ctx, $mod) = @_;
213        return sub {
214
3
100
3
45
                if ($ctx->has_file('cpanfile')) {
215                        # Append rather than rewrite so we don't disturb the existing content.
216
2
4
                        open my $fh, '>>', $ctx->abs_path('cpanfile');
217
2
2
109
6
                        print {$fh} "requires '$mod';\n";
218
2
3
                        close $fh;
219                } else {
220                        # We can only auto-fix cpanfile; Makefile.PL edits need human judgement.
221
1
19
                        carp "Auto-fix for Makefile.PL not implemented; add '$mod' manually.";
222                }
223
5
13
        };
224}
225
2261;
227