lib/App/Project/Doctor/Check/Dependencies.pm

        start → end → jump
        

    1: package App::Project::Doctor::Check::Dependencies;
    2: 
    3: use strict;
    4: use warnings;
    5: use autodie qw(:all);
    6: 
    7: use parent -norequire, 'App::Project::Doctor::Check::Base';
    8: 
    9: use Carp qw(croak carp);
   10: use Readonly;
   11: 
   12: our $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.
   16: Readonly::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: sub name        { 'Dependencies' }
   26: # One-line description for verbose and --help output.
   27: sub description { 'All used modules are declared as build prerequisites.' }
   28: # This check can auto-fix by appending a 'requires' line to cpanfile.
   29: sub can_fix     { 1 }
   30: # Run after POD (40) so dependency errors appear together at the end.
   31: sub order       { 50 }
   32: 
   33: sub check {
●34 → 43 → 53   34: 	my ($self, $ctx) = @_;
   35: 	# Guard: $ctx must support has_file(), abs_path(), and perl_files().
   36: 	croak 'check requires an App::Project::Doctor::Context' unless ref $ctx;
   37: 
   38: 	my @findings;
   39: 
   40: 	# Try to parse the distribution's declared prerequisites.  Returns undef
   41: 	# when no supported builder file exists.
   42: 	my $declared = _collect_declared($ctx);
   43: 	unless (defined $declared) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
   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: 		return _f(
  Mutants (Total: 2, Killed: 2, Survived: 0)
   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 → 62 → 75   53: 	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: 	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: 	for my $mod (sort keys %{$used}) {
   63: 		next if $CORE{$mod};          # Core modules need no declaration.
   64: 		next if $declared->{$mod};    # Already listed as a prereq -- fine.
   65: 		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: 			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 → 75 → 82   75: 	unless (@findings) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
   76: 		push @findings, _f(
   77: 			severity => 'pass',
   78: 			message  => 'All non-core used modules are declared as prerequisites.',
   79: 		);
   80: 	}
   81: 
   82: 	return @findings;
  Mutants (Total: 2, Killed: 2, Survived: 0)
   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.
   93: sub _f {
   94: 	require App::Project::Doctor::Finding;
   95: 	# Prepend check_name so every call site stays concise.
   96: 	return App::Project::Doctor::Finding->new(check_name => 'Dependencies', @_);
  Mutants (Total: 2, Killed: 2, Survived: 0)
   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).
  104: sub _collect_used {
●105 → 108 → 130  105: 	my $ctx = shift;
  106: 	my %used;
  107: 	my $files = $ctx->perl_files('lib', 'script', 'bin');
  108: 	for my $rel (@{$files}) {
  109: 		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: 		$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: 		$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: 		while ($content =~ /^\s*(?:use|require)\s+([\w:]+)/mg) {
  125: 			my $mod = $1;
  126: 			next if $mod =~ /^\d/;    # bare version number, e.g. 'use 5.010'
  127: 			push @{ $used{$mod} }, $rel;
  128: 		}
  129: 	}
  130: 	return \%used;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  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.
  138: sub _collect_declared {
●139 → 142 → 147  139: 	my $ctx = shift;
  140: 
  141: 	# cpanfile is the preferred format; check it first.
  142: 	if ($ctx->has_file('cpanfile')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  143: 		return _parse_cpanfile($ctx->abs_path('cpanfile'));
  Mutants (Total: 2, Killed: 2, Survived: 0)
  144: 	}
  145: 
  146: 	# Fall back to Makefile.PL by converting it to cpanfile syntax in memory.
●147 → 147 → 158  147: 	if ($ctx->has_file('Makefile.PL')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  148: 		my $text = eval {
  149: 			require App::makefilepl2cpanfile;
  150: 			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: 		carp "App::makefilepl2cpanfile failed: $@" if $@;
  154: 		return defined $text ? _parse_cpanfile_text($text) : undef;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  155: 	}
  156: 
  157: 	# No supported builder file found; caller will emit a warning.
  158: 	return undef;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  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.
  165: sub _parse_cpanfile {
●166 → 169 → 175  166: 	my $path = shift;
  167: 	my %mods;
  168: 	open my $fh, '<', $path;
  169: 	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: 		$mods{$1} = 1 if /^\s*requires\s+['"]?([\w:]+)['"]?/;
  174: 	}
  175: 	close $fh;
  176: 	return \%mods;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  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.
  183: sub _parse_cpanfile_text {
●184 → 188 → 191  184: 	my $text = shift;
  185: 	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: 	for my $line (split /\n/, $text) {
  189: 		$mods{$1} = 1 if $line =~ /^\s*requires\s+['"]?([\w:]+)['"]?/;
  190: 	}
  191: 	return \%mods;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_191_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_191_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  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.
  198: sub _path_to_module {
  199: 	my $rel = shift;
  200: 	# Strip the lib/ prefix, convert path separators to ::, remove .pm.
  201: 	$rel =~ s{^lib/}{};
  202: 	$rel =~ s{/}{::}g;
  203: 	$rel =~ s{\.pm$}{};
  204: 	return $rel;

					

					
Mutants (Total: 2, Killed: 0, Survived: 2)
					

				
BOOL_NEGATE_204_2: Negate boolean return expression
MEDIUM: Add tests asserting both true and false outcomes

								

								
🧪 Suggested Test
								
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );

								
							
RETURN_UNDEF_204_2: Replace return expression with undef
LOW: Mutation survived, but impact may be minor

								

								
🧪 Suggested Test
								
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );

								
							
  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.
  211: sub _fix_add_prereq {
  212: 	my ($ctx, $mod) = @_;
  213: 	return sub {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  214: 		if ($ctx->has_file('cpanfile')) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
  215: 			# Append rather than rewrite so we don't disturb the existing content.
  216: 			open my $fh, '>>', $ctx->abs_path('cpanfile');
  217: 			print {$fh} "requires '$mod';\n";
  218: 			close $fh;
  219: 		} else {
  220: 			# We can only auto-fix cpanfile; Makefile.PL edits need human judgement.
  221: 			carp "Auto-fix for Makefile.PL not implemented; add '$mod' manually.";
  222: 		}
  223: 	};
  224: }
  225: 
  226: 1;
  227: 
  228: __END__
  229: 
  230: =head1 NAME
  231: 
  232: App::Project::Doctor::Check::Dependencies - Check that used modules are declared
  233: 
  234: =head1 DESCRIPTION
  235: 
  236: Scans all C<.pm>, C<.pl>, and script files for C<use>/C<require> statements
  237: and compares against C<cpanfile> or C<Makefile.PL> prerequisites
  238: (via L<App::makefilepl2cpanfile>).  Core modules are excluded.
  239: 
  240: =head3 MESSAGES
  241: 
  242:   Code | Trigger                      | Resolution
  243:   -----|------------------------------|-------------------------------------------
  244:   D001 | No builder or cpanfile found | Add a Makefile.PL or cpanfile
  245:   D002 | Module used but not declared | Fix appends a 'requires' line to cpanfile
  246: 
  247: =head3 FORMAL SPECIFICATION
  248: 
  249:   used     = { mod | (use|require mod) in source_files ctx }
  250:   declared = parse_prereqs (builder_file ctx)
  251:   missing  = used \\ (declared union CORE)
  252: 
  253:   check ctx ==
  254:     if declared = undef then [warning]
  255:     else [error+fix per m in missing] ++ (if missing = {} then [pass] else [])
  256: 
  257: =head1 AUTHOR
  258: 
  259: Nigel Horne C<< <njh@nigelhorne.com> >>
  260: 
  261: =head1 LICENSE
  262: 
  263: Copyright (C) 2026 Nigel Horne.
  264: This library is free software; you can redistribute it and/or modify
  265: it under the same terms as Perl itself.
  266: 
  267: =cut