TER1 (Statement): 100.00%
TER2 (Branch): 100.00%
TER3 (LCSAJ): 100.0% (3/3)
Approximate LCSAJ segments: 21
● Covered — this LCSAJ path was executed during testing.
● Not covered — this LCSAJ path was never executed. These are the paths to focus on.
Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows:
start → end → jump
Uncovered paths show [NOT COVERED] in the tooltip.
1: package App::Project::Doctor::Fixer; 2: 3: # The Fixer presents a numbered menu of auto-fixable findings, reads the 4: # user's answer from STDIN, and calls each selected fix coderef with the 5: # current Context. In non-interactive mode (--fix flag) it applies all 6: # fixes immediately without prompting. 7: 8: use strict; 9: use warnings; 10: use autodie qw(:all); 11: 12: # croak dies at the caller's location; carp warns there. 13: use Carp qw(croak carp); 14: # Params::Get normalises @_ into a hashref before validate_strict sees it. 15: use Params::Get; 16: # validate_strict enforces parameter schemas and throws immediately on failure. 17: use Params::Validate::Strict qw(validate_strict); 18: # blessed() checks whether a reference is a blessed object. 19: use Scalar::Util qw(blessed); 20: 21: our $VERSION = '0.02'; 22: 23: # --------------------------------------------------------------------------- 24: # Constructor 25: # --------------------------------------------------------------------------- 26: 27: sub new { 28: my $class = shift; 29: 30: # validate_strict with type => 'object' guarantees that report and context 31: # are blessed references before we reach the isa() checks below. 32: # The redundant blessed() call was removed; isa() alone is sufficient. 33: my $args = validate_strict( 34: schema => { 35: report => { type => 'object' }, 36: context => { type => 'object' }, 37: non_interactive => { type => 'scalar', optional => 1, default => 0 }, 38: }, 39: args => Params::Get::get_params(undef, \@_) || {}, 40: ); 41: 42: # isa() confirms the exact class; validate_strict only checked 'blessed'. 43: croak 'report must be an App::Project::Doctor::Report' 44: unless $args->{report}->isa('App::Project::Doctor::Report'); 45: croak 'context must be an App::Project::Doctor::Context' 46: unless $args->{context}->isa('App::Project::Doctor::Context'); 47: 48: # Store the validated args and return the new Fixer object. 49: return bless $args, $class;Mutants (Total: 2, Killed: 2, Survived: 0)
50: } 51: 52: # --------------------------------------------------------------------------- 53: # Accessors (read-only after construction) 54: # --------------------------------------------------------------------------- 55: 56: # The Report whose fixable findings will be presented to the user. 57: sub report { $_[0]->{report} } 58: # The Context passed to each fix coderef so it can find files. 59: sub context { $_[0]->{context} } 60: # When true, all fixes are applied immediately without user prompting. 61: sub non_interactive { $_[0]->{non_interactive} } 62: 63: # --------------------------------------------------------------------------- 64: # Public interface 65: # --------------------------------------------------------------------------- 66: 67: =head2 run 68: 69: Presents fixable findings, prompts (or auto-applies in non-interactive mode), 70: and calls each selected C<fix> coderef. Returns the count of fixes applied. 71: 72: =cut 73: 74: sub run { 75: my $self = shift; 76: # Collect only the findings that have an associated fix coderef. 77: my @fixable = $self->report->fixable; 78: # Nothing to do if no fixable findings were found. 79: return 0 unless @fixable;
Mutants (Total: 2, Killed: 2, Survived: 0)
80: # Choose the right mode: silent auto-apply vs. interactive prompt. 81: return $self->non_interactive
Mutants (Total: 2, Killed: 2, Survived: 0)
82: ? $self->_apply_all(\@fixable) 83: : $self->_interactive_loop(\@fixable); 84: } 85: 86: # --------------------------------------------------------------------------- 87: # Private helpers 88: # --------------------------------------------------------------------------- 89: 90: # Purpose: Print a numbered list of fixes to STDOUT. 91: # Entry: $fixable is a non-empty arrayref of Finding objects. 92: # Exit: Returns nothing; side-effect is printed output only. 93: # Side effects: Writes to STDOUT. 94: sub _print_fix_list { 95: my $fixable = shift; 96: print "\nSuggested fixes:\n"; 97: # Number each finding starting at 1 so the user can reference them by number. 98: my $i = 0; 99: printf " [%d] %s\n", ++$i, $_->message for @{$fixable}; 100: return; 101: } 102: 103: # Purpose: Read the user's choice from STDIN and apply the selected fixes. 104: # Entry: $fixable is a non-empty arrayref of Finding objects. 105: # Exit: Integer count of fixes successfully applied. 106: # Side effects: Reads STDIN, writes STDOUT, may modify the filesystem via fix coderefs. 107: sub _interactive_loop { ●108 → 124 → 130 108: my ($self, $fixable) = @_; 109: 110: # Show the numbered list so the user knows what choices are available. 111: _print_fix_list($fixable); 112: print "\nWould you like me to apply them? [Y/n/1,3] "; 113: 114: # Read one line from the user; return 0 cleanly if STDIN is closed (e.g. in a pipe). 115: my $answer = <STDIN>; 116: return 0 unless defined $answer;
Mutants (Total: 2, Killed: 2, Survived: 0)
117: chomp $answer; # Remove the trailing newline before comparing. 118: 119: # Empty input or "yes" means apply everything. 120: return $self->_apply_all($fixable)
Mutants (Total: 2, Killed: 2, Survived: 0)
121: if $answer eq '' || $answer =~ /^y(?:es)?$/i; 122: 123: # Explicit "no" -- tell the user we skipped and return. 124: if ($answer =~ /^n(?:o)?$/i) {
Mutants (Total: 1, Killed: 1, Survived: 0)
125: print "No fixes applied.\n"; 126: return 0;
Mutants (Total: 2, Killed: 2, Survived: 0)
127: } 128: 129: # A comma/space-separated list of numbers selects individual fixes. ●130 → 130 → 143 130: if ($answer =~ /^[\d,\s]+$/) {
Mutants (Total: 1, Killed: 1, Survived: 0)
131: my $max = scalar @{$fixable}; # The highest valid index. 132: my %seen; 133: # Parse the numbers, clamp to valid range, and deduplicate. 134: my @indices = grep { $_ >= 1 && $_ <= $max && !$seen{$_}++ }
Mutants (Total: 6, Killed: 6, Survived: 0)
135: map { int($_) } 136: split /[\s,]+/, $answer; 137: # Convert 1-based user indices to 0-based array indices. 138: my @selected = map { $fixable->[$_ - 1] } @indices; 139: return $self->_apply_all(\@selected);
Mutants (Total: 2, Killed: 2, Survived: 0)
140: } 141: 142: # Anything else is unrecognised; be explicit rather than guessing. 143: print "Unrecognised input -- no fixes applied.\n"; 144: return 0;
Mutants (Total: 2, Killed: 2, Survived: 0)
145: } 146: 147: # Purpose: Call every fix coderef in the list and count the successes. 148: # Entry: $fixable is an arrayref of Finding objects (may be empty). 149: # Exit: Integer count of fixes that ran without throwing. 150: # Side effects: Calls fix coderefs (may create/modify files), writes to STDOUT on 151: # success, calls carp for each failing fix. 152: sub _apply_all { ●153 → 155 → 168 153: my ($self, $fixable) = @_; 154: my $count = 0; 155: for my $f (@{$fixable}) { 156: # Wrap the fix in eval so a single failure doesn't abort all remaining fixes. 157: my $ok = eval { $f->fix->($self->context); 1 }; 158: if ($ok) {
Mutants (Total: 1, Killed: 1, Survived: 0)
159: # Print confirmation so the user can see what changed. 160: printf " Applied: %s\n", $f->message; 161: $count++; 162: } else { 163: # Report the failure but continue with the next fix. 164: carp "Fix failed for '" . $f->message . "': $@"; 165: } 166: } 167: # Summary line always prints, even when count is 0. 168: printf "\n%d fix(es) applied.\n", $count; 169: return $count;
Mutants (Total: 2, Killed: 2, Survived: 0)
170: } 171: 172: 1; 173: 174: __END__ 175: 176: =head1 NAME 177: 178: App::Project::Doctor::Fixer - Interactive fix application loop 179: 180: =head1 VERSION 181: 182: 0.02 183: 184: =head1 SYNOPSIS 185: 186: use App::Project::Doctor::Fixer; 187: 188: my $fixer = App::Project::Doctor::Fixer->new( 189: report => $report, 190: context => $ctx, 191: ); 192: my $count = $fixer->run; 193: 194: =head1 DESCRIPTION 195: 196: Presents fixable findings from a report, reads the user's choice from STDIN 197: (C<Y> all, C<n> none, or C<1,3> index list), and calls each selected 198: finding's C<fix> coderef with the current context. 199: 200: Set C<non_interactive =E<gt> 1> to apply all fixes without prompting 201: (C<--fix> mode). 202: 203: =head1 CONSTRUCTOR 204: 205: =head2 new( %args ) 206: 207: =head3 API SPECIFICATION 208: 209: =head4 Input 210: 211: report : App::Project::Doctor::Report required (blessed, isa Report) 212: context : App::Project::Doctor::Context required (blessed, isa Context) 213: non_interactive : Bool default 0 214: 215: =head4 Output 216: 217: Blessed hashref of type C<App::Project::Doctor::Fixer>. 218: 219: =head1 ACCESSORS 220: 221: C<report>, C<context>, C<non_interactive> -- read-only. 222: 223: =head1 METHODS 224: 225: =head2 run 226: 227: =head3 API SPECIFICATION 228: 229: =head4 Input 230: 231: None. 232: 233: =head4 Output 234: 235: Integer -- number of fixes successfully applied. 236: 237: =head3 MESSAGES 238: 239: Code | Trigger | Resolution 240: -----|-----------------------|--------------------------------------- 241: F001 | A fix coderef throws | Fix skipped; error logged via carp 242: 243: =head3 FORMAL SPECIFICATION 244: 245: run : Fixer -> N 246: run fixer == 247: let fixable = { f in findings (report fixer) | is_fixable f } 248: in if non_interactive fixer 249: then apply_all fixable 250: else apply_chosen fixable (prompt fixable) 251: 252: =head1 LIMITATIONS 253: 254: Reads from STDIN; use C<non_interactive =E<gt> 1> in automated pipelines. 255: 256: Encapsulation of C<_interactive_loop>, C<_apply_all>, and C<_print_fix_list> 257: is enforced by convention only; a future migration to C<Sub::Private> in 258: enforce mode is tracked as a TODO. 259: 260: =head1 AUTHOR 261: 262: Nigel Horne C<< <njh@nigelhorne.com> >> 263: 264: =head1 LICENSE 265: 266: Copyright (C) 2026 Nigel Horne. 267: This library is free software; you can redistribute it and/or modify 268: it under the same terms as Perl itself. 269: 270: =cut