| File: | blib/lib/App/Project/Doctor/Fixer.pm |
| Coverage: | 99.1% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 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 | 5 5 5 | 4683 6 61 | use strict; | |||
| 9 | 5 5 5 | 10 3 139 | use warnings; | |||
| 10 | 5 5 5 | 10 2 24 | use autodie qw(:all); | |||
| 11 | ||||||
| 12 | # croak dies at the caller's location; carp warns there. | |||||
| 13 | 5 5 5 | 10397 2 157 | use Carp qw(croak carp); | |||
| 14 | # Params::Get normalises @_ into a hashref before validate_strict sees it. | |||||
| 15 | 5 5 5 | 7 3 81 | use Params::Get; | |||
| 16 | # validate_strict enforces parameter schemas and throws immediately on failure. | |||||
| 17 | 5 5 5 | 10 3 68 | use Params::Validate::Strict qw(validate_strict); | |||
| 18 | # blessed() checks whether a reference is a blessed object. | |||||
| 19 | 5 5 5 | 7 4 2181 | use Scalar::Util qw(blessed); | |||
| 20 | ||||||
| 21 | our $VERSION = '0.02'; | |||||
| 22 | ||||||
| 23 | # --------------------------------------------------------------------------- | |||||
| 24 | # Constructor | |||||
| 25 | # --------------------------------------------------------------------------- | |||||
| 26 | ||||||
| 27 | sub new { | |||||
| 28 | 51 | 2623 | 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 | 51 | 172 | 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 | 44 | 4319 | unless $args->{report}->isa('App::Project::Doctor::Report'); | |||
| 45 | croak 'context must be an App::Project::Doctor::Context' | |||||
| 46 | 43 | 81 | unless $args->{context}->isa('App::Project::Doctor::Context'); | |||
| 47 | ||||||
| 48 | # Store the validated args and return the new Fixer object. | |||||
| 49 | 42 | 49 | return bless $args, $class; | |||
| 50 | } | |||||
| 51 | ||||||
| 52 | # --------------------------------------------------------------------------- | |||||
| 53 | # Accessors (read-only after construction) | |||||
| 54 | # --------------------------------------------------------------------------- | |||||
| 55 | ||||||
| 56 | # The Report whose fixable findings will be presented to the user. | |||||
| 57 | 47 | 300 | sub report { $_[0]->{report} } | |||
| 58 | # The Context passed to each fix coderef so it can find files. | |||||
| 59 | 40 | 51 | sub context { $_[0]->{context} } | |||
| 60 | # When true, all fixes are applied immediately without user prompting. | |||||
| 61 | 44 | 271 | sub non_interactive { $_[0]->{non_interactive} } | |||
| 62 | ||||||
| 63 | # --------------------------------------------------------------------------- | |||||
| 64 | # Public interface | |||||
| 65 | # --------------------------------------------------------------------------- | |||||
| 66 | ||||||
| 67 - 72 | =head2 run Presents fixable findings, prompts (or auto-applies in non-interactive mode), and calls each selected C<fix> coderef. Returns the count of fixes applied. =cut | |||||
| 73 | ||||||
| 74 | sub run { | |||||
| 75 | 46 | 3079 | my $self = shift; | |||
| 76 | # Collect only the findings that have an associated fix coderef. | |||||
| 77 | 46 | 54 | my @fixable = $self->report->fixable; | |||
| 78 | # Nothing to do if no fixable findings were found. | |||||
| 79 | 46 | 58 | return 0 unless @fixable; | |||
| 80 | # Choose the right mode: silent auto-apply vs. interactive prompt. | |||||
| 81 | 42 | 45 | return $self->non_interactive | |||
| 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 | 35 | 27 | my $fixable = shift; | |||
| 96 | 35 | 130 | print "\nSuggested fixes:\n"; | |||
| 97 | # Number each finding starting at 1 so the user can reference them by number. | |||||
| 98 | 35 | 28 | my $i = 0; | |||
| 99 | 35 35 | 24 65 | printf " [%d] %s\n", ++$i, $_->message for @{$fixable}; | |||
| 100 | 35 | 25 | 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 | 35 | 36 | my ($self, $fixable) = @_; | |||
| 109 | ||||||
| 110 | # Show the numbered list so the user knows what choices are available. | |||||
| 111 | 35 | 75 | _print_fix_list($fixable); | |||
| 112 | 35 | 51 | 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 | 35 | 59 | my $answer = <STDIN>; | |||
| 116 | 35 | 49 | return 0 unless defined $answer; | |||
| 117 | 32 | 28 | chomp $answer; # Remove the trailing newline before comparing. | |||
| 118 | ||||||
| 119 | # Empty input or "yes" means apply everything. | |||||
| 120 | 32 | 86 | return $self->_apply_all($fixable) | |||
| 121 | if $answer eq '' || $answer =~ /^y(?:es)?$/i; | |||||
| 122 | ||||||
| 123 | # Explicit "no" -- tell the user we skipped and return. | |||||
| 124 | 22 | 61 | if ($answer =~ /^n(?:o)?$/i) { | |||
| 125 | 10 | 18 | print "No fixes applied.\n"; | |||
| 126 | 10 | 23 | return 0; | |||
| 127 | } | |||||
| 128 | ||||||
| 129 | # A comma/space-separated list of numbers selects individual fixes. | |||||
| 130 | 12 | 30 | if ($answer =~ /^[\d,\s]+$/) { | |||
| 131 | 8 8 | 7 7 | my $max = scalar @{$fixable}; # The highest valid index. | |||
| 132 | 8 | 11 | my %seen; | |||
| 133 | # Parse the numbers, clamp to valid range, and deduplicate. | |||||
| 134 | 12 | 44 | my @indices = grep { $_ >= 1 && $_ <= $max && !$seen{$_}++ } | |||
| 135 | 8 12 | 20 16 | map { int($_) } | |||
| 136 | split /[\s,]+/, $answer; | |||||
| 137 | # Convert 1-based user indices to 0-based array indices. | |||||
| 138 | 8 8 | 33 10 | my @selected = map { $fixable->[$_ - 1] } @indices; | |||
| 139 | 8 | 14 | return $self->_apply_all(\@selected); | |||
| 140 | } | |||||
| 141 | ||||||
| 142 | # Anything else is unrecognised; be explicit rather than guessing. | |||||
| 143 | 4 | 8 | print "Unrecognised input -- no fixes applied.\n"; | |||
| 144 | 4 | 18 | return 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 | 25 | 25 | my ($self, $fixable) = @_; | |||
| 154 | 25 | 17 | my $count = 0; | |||
| 155 | 25 25 | 41 25 | for my $f (@{$fixable}) { | |||
| 156 | # Wrap the fix in eval so a single failure doesn't abort all remaining fixes. | |||||
| 157 | 39 39 36 | 684 38 80 | my $ok = eval { $f->fix->($self->context); 1 }; | |||
| 158 | 39 | 43 | if ($ok) { | |||
| 159 | # Print confirmation so the user can see what changed. | |||||
| 160 | 36 | 34 | printf " Applied: %s\n", $f->message; | |||
| 161 | 36 | 37 | $count++; | |||
| 162 | } else { | |||||
| 163 | # Report the failure but continue with the next fix. | |||||
| 164 | 3 | 5 | carp "Fix failed for '" . $f->message . "': $@"; | |||
| 165 | } | |||||
| 166 | } | |||||
| 167 | # Summary line always prints, even when count is 0. | |||||
| 168 | 25 | 45 | printf "\n%d fix(es) applied.\n", $count; | |||
| 169 | 25 | 68 | return $count; | |||
| 170 | } | |||||
| 171 | ||||||
| 172 | 1; | |||||
| 173 | ||||||