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

        start → end → jump
        

    1: package App::Project::Doctor::Check::Pod;
    2: 
    3: # This check verifies that every .pm file under lib/ contains valid POD
    4: # documentation.  It uses Pod::Checker to detect syntax errors.
    5: # Modules with no POD at all get a fixable finding that writes a skeleton.
    6: 
    7: use strict;
    8: use warnings;
    9: use autodie qw(:all);
   10: 
   11: # Inherit the standard check interface from Check::Base.
   12: use parent -norequire, 'App::Project::Doctor::Check::Base';
   13: 
   14: # croak dies with the caller's location; carp warns there.
   15: use Carp qw(croak carp);
   16: 
   17: our $VERSION = '0.02';
   18: 
   19: # Short name used in Finding.check_name and text-report columns.
   20: sub name        { 'POD' }
   21: # One-line description for --help and verbose output.
   22: sub description { 'Every .pm file contains valid, parseable POD documentation.' }
   23: # This check can offer a fix (append a POD skeleton).
   24: sub can_fix     { 1 }
   25: # Run after Dependencies (50) but before Security (60).
   26: sub order       { 40 }
   27: 
   28: sub check {
●29 → 38 → 45   29: 	my ($self, $ctx) = @_;
   30: 	# Guard: require a proper Context object.
   31: 	croak 'check requires an App::Project::Doctor::Context' unless ref $ctx;
   32: 
   33: 	my @findings;
   34: 	# lib_modules() returns an arrayref of .pm paths relative to the distro root.
   35: 	my $modules = $ctx->lib_modules;
   36: 
   37: 	# If there are no .pm files at all there is nothing to check.
   38: 	unless (@{$modules}) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
   39: 		return _f(
  Mutants (Total: 2, Killed: 2, Survived: 0)
   40: 			severity => 'info',
   41: 			message  => 'No .pm files under lib/ -- nothing to check.',
   42: 		);
   43: 	}
   44: 
●45 → 45 → 76   45: 	for my $mod (@{$modules}) {
   46: 		# Try to read the module source; skip it with a carp if reading fails.
   47: 		my $content = eval { $ctx->slurp($mod) } // do { carp "Cannot slurp $mod: $@"; next };
   48: 
   49: 		# Quick check: does the file contain any POD at all?
   50: 		# A line beginning with '=' followed by a word character starts a POD block.
   51: 		unless ($content =~ /^=\w/m) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
   52: 			# No POD found -- offer to append a skeleton.
   53: 			push @findings, _f(
   54: 				severity => 'error',
   55: 				message  => "No POD found in $mod.",
   56: 				file     => $mod,
   57: 				fix      => _fix_scaffold_pod($ctx, $mod),
   58: 			);
   59: 			# No point running Pod::Checker on a file with no POD at all.
   60: 			next;
   61: 		}
   62: 
   63: 		# Validate the existing POD with Pod::Checker and collect any errors.
   64: 		for my $err (_check_pod($ctx->abs_path($mod))) {
   65: 			push @findings, _f(
   66: 				severity => 'error',
   67: 				message  => "POD error in $mod: $err->{message}",
   68: 				file     => $mod,
   69: 				# Only include a line number when Pod::Checker provided one.
   70: 				defined $err->{line} ? (line => $err->{line}) : (),
   71: 			);
   72: 		}
   73: 	}
   74: 
   75: 	# If we collected no error findings, all modules have valid POD.
●76 → 76 → 83   76: 	unless (@findings) {
  Mutants (Total: 1, Killed: 1, Survived: 0)
   77: 		push @findings, _f(
   78: 			severity => 'pass',
   79: 			message  => sprintf('%d module(s) checked -- all have valid POD.', scalar @{$modules}),
   80: 		);
   81: 	}
   82: 
   83: 	return @findings;
  Mutants (Total: 2, Killed: 2, Survived: 0)
   84: }
   85: 
   86: # ---------------------------------------------------------------------------
   87: # Private helpers
   88: # ---------------------------------------------------------------------------
   89: 
   90: # Purpose:    Create a Finding with check_name pre-filled to 'POD'.
   91: # Entry:      %args is a valid Finding constructor argument list.
   92: # Exit:       App::Project::Doctor::Finding object.
   93: # Side effects: None.
   94: sub _f {
   95: 	require App::Project::Doctor::Finding;
   96: 	return App::Project::Doctor::Finding->new(check_name => 'POD', @_);
  Mutants (Total: 2, Killed: 2, Survived: 0)
   97: }
   98: 
   99: # Purpose:    Run Pod::Checker on a single file and return a list of errors.
  100: # Entry:      $abs_path is the absolute path to the .pm file to check.
  101: # Exit:       List of hashrefs with 'message' string and optional 'line' int.
  102: # Side effects: Loads Pod::Checker if not already in memory; writes to an in-memory
  103: #               filehandle (no disk I/O).
  104: sub _check_pod {
●105 → 120 → 131  105: 	my $abs_path = shift;
  106: 	require Pod::Checker;
  107: 
  108: 	# Capture Pod::Checker's diagnostic output into a scalar instead of STDERR.
  109: 	my $captured = '';
  110: 	open my $out_fh, '>', \$captured;
  111: 	my $checker = Pod::Checker->new;
  112: 	$checker->parse_from_file($abs_path, $out_fh);
  113: 	close $out_fh;
  114: 
  115: 	# If Pod::Checker reported no errors, return an empty list immediately.
  116: 	return () if ($checker->num_errors // 0) == 0;
  Mutants (Total: 1, Killed: 1, Survived: 0)
  117: 
  118: 	# Parse the captured text output to extract individual error messages.
  119: 	my @errors;
  120: 	for my $line (split /\n/, $captured) {
  121: 		# Skip blank lines in the checker output.
  122: 		next unless $line =~ /\S/;
  123: 		# Try to extract the line number from the Pod::Checker message.
  124: 		my ($lineno) = $line =~ /line\s+(\d+)/i;
  125: 		push @errors, {
  126: 			message => $line,
  127: 			# Only include 'line' in the hashref when we actually found one.
  128: 			defined $lineno ? (line => $lineno) : (),
  129: 		};
  130: 	}
  131: 	return @errors;
  Mutants (Total: 2, Killed: 2, Survived: 0)
  132: }
  133: 
  134: # Purpose:    Return a coderef that rewrites a module file with a POD skeleton.
  135: # Entry:      $ctx is the Context; $rel_path is the module path relative to root.
  136: # Exit:       Coderef ($ctx) -> void; rewrites the module file with POD appended.
  137: # Side effects: Modifies the module file on disk when the coderef is called.
  138: sub _fix_scaffold_pod {
  139: 	my ($ctx, $rel_path) = @_;
  140: 	# Return the fix as a closure so it runs only when the user accepts it.
  141: 	return sub {
  Mutants (Total: 2, Killed: 2, Survived: 0)
  142: 		# Protect caller's $@ from autodie's internal eval inside open().
  143: 		local $@;
  144: 		my $abs = $ctx->abs_path($rel_path);
  145: 		# Convert the relative file path to a Perl package name.
  146: 		# e.g. lib/My/Module.pm -> My::Module
  147: 		(my $pkg = $rel_path) =~ s{^lib/}{}; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{};
  148: 
  149: 		# Read the existing file so we can rewrite it (not just append).
  150: 		open my $rfh, '<', $abs;
  151: 		my $content = do { local $/; <$rfh> };
  152: 		close $rfh;
  153: 
  154: 		# Remove any trailing `1;` so the rewritten file has exactly one.
  155: 		# Without this, the original `1;` and the skeleton's `1;` would both appear.
  156: 		$content =~ s/\s*\n?1;\s*\z//s;
  157: 
  158: 		# Write the existing content back followed by the POD skeleton.
  159: 		open my $wfh, '>', $abs;
  160: 		print {$wfh} $content, <<"END_POD";
  161: 
  162: 1;
  163: 
  164: __END__
  165: 
  166: =head1 NAME
  167: 
  168: $pkg - (description goes here)
  169: 
  170: =head1 SYNOPSIS
  171: 
  172:   use $pkg;
  173: 
  174: =head1 DESCRIPTION
  175: 
  176: (description goes here)
  177: 
  178: =head1 AUTHOR
  179: 
  180: Nigel Horne C<< <njh\@nigelhorne.com> >>
  181: 
  182: =head1 LICENSE
  183: 
  184: Copyright (C) 2026 Nigel Horne.
  185: This library is free software; you can redistribute it and/or modify
  186: it under the same terms as Perl itself.
  187: 
  188: =cut
  189: END_POD
  190: 		close $wfh;
  191: 	};
  192: }
  193: 
  194: 1;
  195: 
  196: __END__
  197: 
  198: =head1 NAME
  199: 
  200: App::Project::Doctor::Check::Pod - Check POD presence and validity in all modules
  201: 
  202: =head1 DESCRIPTION
  203: 
  204: Uses L<Pod::Checker> to validate every C<.pm> under C<lib/>.  Modules with no
  205: POD at all get a fixable finding that appends a minimal skeleton.
  206: 
  207: =head3 MESSAGES
  208: 
  209:   Code | Trigger                  | Resolution
  210:   -----|--------------------------|-----------------------------------------------
  211:   P001 | No POD in a .pm file     | Fix appends a skeleton; fill in by hand
  212:   P002 | Pod::Checker error       | Correct the malformed POD
  213: 
  214: =head3 FORMAL SPECIFICATION
  215: 
  216:   check : Context -> [Finding]
  217:   check ctx ==
  218:     concat [ check_one m | m <- lib_modules ctx ]
  219:     where check_one m ==
  220:             (if no_pod m then [error+fix] else [])
  221:             ++ pod_errors m
  222: 
  223: =head1 AUTHOR
  224: 
  225: Nigel Horne C<< <njh@nigelhorne.com> >>
  226: 
  227: =head1 LICENSE
  228: 
  229: Copyright (C) 2026 Nigel Horne.
  230: This library is free software; you can redistribute it and/or modify
  231: it under the same terms as Perl itself.
  232: 
  233: =cut