File Coverage

File:blib/lib/App/Project/Doctor/Fixer.pm
Coverage:99.1%

linestmtbrancondsubtimecode
1package 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
21our $VERSION = '0.02';
22
23# ---------------------------------------------------------------------------
24# Constructor
25# ---------------------------------------------------------------------------
26
27sub 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
74sub 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.
94sub _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.
107sub _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.
152sub _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
1721;
173