File Coverage

File:blib/lib/App/Project/Doctor/Report.pm
Coverage:100.0%

linestmtbrancondsubtimecode
1package App::Project::Doctor::Report;
2
3# A Report aggregates all Finding objects produced by check plugins and
4# renders them as human-readable text, machine-readable JSON, or TAP output
5# for CI pipelines.  It also tracks the overall pass/fail exit code.
6
7
5
5
5
5
4656
4
63
use strict;
8
5
5
5
5
8
4
147
use warnings;
9
5
5
5
5
9
5
16
use autodie qw(:all);
10
11# croak dies at the caller's location; carp warns there.
12
5
5
5
5
10543
5
164
use Carp qw(croak carp);
13# Readonly prevents accidental mutation of constants after they are defined.
14
5
5
5
5
8
5
99
use Readonly;
15# blessed() lets us confirm that add_findings() received real Finding objects.
16
5
5
5
5
10
5
91
use Scalar::Util qw(blessed);
17# validate_strict enforces parameter schemas; not used by new() (takes no args).
18
5
5
5
5
10
3
3073
use Params::Validate::Strict qw(validate_strict);
19
20our $VERSION = '0.02';
21
22# ---------------------------------------------------------------------------
23# Constants
24# ---------------------------------------------------------------------------
25
26# The icons shown at the start of each text-report line, keyed by severity.
27Readonly::Hash my %ICON => (
28        pass    => '[v]',    # Healthy -- no action needed
29        error   => '[X]',    # Broken -- must be fixed
30        warning => '[!]',    # Suspicious -- should be reviewed
31        info    => '[i]',    # Informational -- no action needed
32);
33
34# Numeric rank used to pick the "worst" severity in a group of findings.
35# Higher number = more severe; error is always the worst.
36Readonly::Hash my %SEV_RANK => (error => 3, warning => 2, info => 1, pass => 0);
37
38# The column width reserved for the check name in the text report.
39# Chosen to accommodate the longest default check name ('CpanReadiness' = 13 chars).
40Readonly::Scalar my $LABEL_WIDTH => 18;
41
42# ---------------------------------------------------------------------------
43# Constructor
44# ---------------------------------------------------------------------------
45
46sub new {
47        # Report takes no constructor arguments; start with an empty findings list.
48
126
126
73905
        my ($class, %args) = @_;
49
126
203
        return bless { _findings => [] }, $class;
50}
51
52# ---------------------------------------------------------------------------
53# Mutator
54# ---------------------------------------------------------------------------
55
56 - 61
=head2 add_findings( @findings )

Appends one or more L<App::Project::Doctor::Finding> objects.
Croaks on non-Finding arguments.

=cut
62
63sub add_findings {
64
140
140
1794
        my ($self, @findings) = @_;
65
140
130
        for my $f (@findings) {
66                # Validate each element to catch bugs where a check returns a string
67                # or undef instead of a real Finding object.
68
197
100
100
513
                croak 'Expected an App::Project::Doctor::Finding'
69                        unless blessed($f) && $f->isa('App::Project::Doctor::Finding');
70
186
186
131
190
                push @{ $self->{_findings} }, $f;
71        }
72        # Return $self so callers can chain: $report->add_findings(...)->render_text.
73
129
131
        return $self;
74}
75
76# ---------------------------------------------------------------------------
77# Accessors / filters
78# ---------------------------------------------------------------------------
79
80# Return every finding in insertion order (used by render_* methods).
81
50
50
50
1657
78
sub all_findings { @{ $_[0]->{_findings} } }
82# Return only the findings with severity 'error'.
83
64
114
64
64
50
99
81
sub errors       { grep { $_->severity eq 'error'   } @{ $_[0]->{_findings} } }
84# Return only the findings with severity 'warning'.
85
43
77
43
43
33
66
46
sub warnings     { grep { $_->severity eq 'warning' } @{ $_[0]->{_findings} } }
86# Return only the findings with severity 'pass'.
87
3
17
3
3
4
14
6
sub passes       { grep { $_->severity eq 'pass'    } @{ $_[0]->{_findings} } }
88# Return only the findings that carry an automated fix coderef.
89
77
125
77
77
50
133
94
sub fixable      { grep { $_->is_fixable             } @{ $_[0]->{_findings} } }
90
91# has_errors returns 1/0 (not just truthy) for type-safe callers.
92
29
100
29
36
sub has_errors   { (scalar($_[0]->errors)   > 0) ? 1 : 0 }
93
10
100
10
14
sub has_warnings { (scalar($_[0]->warnings) > 0) ? 1 : 0 }
94
95 - 99
=head2 exit_code

Returns 0 (clean) or 1 (errors present).

=cut
100
101# The process should exit 1 if any finding is an error, 0 otherwise.
102
16
100
16
30
sub exit_code { $_[0]->has_errors ? 1 : 0 }
103
104# ---------------------------------------------------------------------------
105# Rendering
106# ---------------------------------------------------------------------------
107
108 - 112
=head2 render_text( %opts )

Returns the full text report.  Accepted options: C<verbose> (bool).

=cut
113
114sub render_text {
115
28
28
46
        my ($self, %opts) = @_;
116        # verbose mode adds per-finding detail lines under each check summary.
117
28
100
50
        my $verbose = $opts{verbose} // 0;
118
119        # Group findings by check name while preserving the insertion order of
120        # the first finding seen for each check.  This keeps the output stable.
121
28
26
        my (%by_check, @order);
122
28
36
        for my $f ($self->all_findings) {
123
34
44
                my $name = $f->check_name;
124
34
100
42
                unless (exists $by_check{$name}) {
125                        # First time we see this check name -- record its position.
126
31
26
                        push @order, $name;
127
31
39
                        $by_check{$name} = [];
128                }
129
34
34
21
35
                push @{ $by_check{$name} }, $f;
130        }
131
132        # Build the output one line at a time and join at the end.
133
28
23
        my @lines;
134
28
27
        for my $name (@order) {
135
31
31
22
31
                my @group = @{ $by_check{$name} };
136                # Choose the worst severity in this group to pick the icon.
137
31
40
                my $sev   = _worst_severity(\@group);
138
31
70
                my $icon  = $ICON{$sev};    # Severity is always valid; no fallback needed.
139
140                # Use the first non-pass finding as the summary line for mixed groups.
141
31
34
84
32
                my ($lead) = grep { $_->severity ne 'pass' } @group;
142
31
100
63
                my $summary = $lead ? $lead->message : $group[0]->message;
143
144                # Format: icon  check-name (padded)  summary message
145
31
63
                push @lines, sprintf('  %-4s  %-*s  %s', $icon, $LABEL_WIDTH, $name, $summary);
146
147
31
100
46
                if ($verbose) {
148                        # In verbose mode, print each non-pass finding with its detail.
149
6
7
                        for my $f (@group) {
150                                # Skip pass findings in verbose mode -- they have no useful detail.
151
7
100
9
                                next if $f->severity eq 'pass';
152
6
9
                                push @lines, sprintf('        -> %s', $f->message);
153                                # Only print the detail line when there is something to show.
154
6
100
12
                                push @lines, sprintf('           %s', $f->detail) if $f->detail;
155                        }
156                }
157        }
158
159        # Print a one-line summary of error/warning counts below the check table.
160
28
33
        my $ec = scalar($self->errors);
161
28
36
        my $wc = scalar($self->warnings);
162
28
21
        push @lines, '';    # Blank line before the summary.
163
28
100
100
100
100
74
        push @lines, $ec || $wc
164                ? join(' - ', ($ec ? "$ec error(s)" : ()), ($wc ? "$wc warning(s)" : ()))
165                : 'No errors or warnings.';
166
167        # If there are fixable findings, show them and hint that the user can apply them.
168
28
36
        my @fixable = $self->fixable;
169
28
100
32
        if (@fixable) {
170
4
5
                push @lines, '';
171
4
5
                push @lines, 'Suggested fixes:';
172
4
3
                my $i = 0;
173                # Number each fix starting at 1 for the interactive prompt that follows.
174
4
8
                push @lines, sprintf('  [%d] %s', ++$i, $_->message) for @fixable;
175
4
2
                push @lines, '';
176
4
4
                push @lines, 'Would you like me to apply them? [Y/n]';
177        }
178
179        # Join with newlines and add a trailing newline for clean shell output.
180
28
83
        return join("\n", @lines) . "\n";
181}
182
183 - 187
=head2 render_json

Returns findings as a pretty-printed JSON string (requires L<JSON::MaybeXS>).

=cut
188
189sub render_json {
190
4
4
142
        my $self = shift;
191        # JSON::MaybeXS is loaded lazily so it is only required when --format=json.
192
4
12
        require JSON::MaybeXS;
193        # canonical => 1 sorts keys so the output is diff-friendly.
194        return JSON::MaybeXS->new(utf8 => 1, pretty => 1, canonical => 1)
195
4
3
75
8
                            ->encode([ map { $_->to_hash } $self->all_findings ]);
196}
197
198 - 202
=head2 render_tap

Returns a TAP-format string for CI pipeline consumption.

=cut
203
204sub render_tap {
205
4
4
7
        my $self     = shift;
206
4
6
        my @findings = $self->all_findings;
207        # TAP header declares how many tests will follow.
208
4
8
        my @lines    = ('1..' . scalar @findings);
209
4
6
        my $n        = 0;
210
4
5
        for my $f (@findings) {
211
10
8
                $n++;
212                # pass and info severities are "ok"; error and warning are "not ok".
213
10
100
10
                my $ok = $f->severity =~ /^(?:pass|info)$/ ? 'ok' : 'not ok';
214
10
12
                push @lines, sprintf('%s %d - [%s] %s', $ok, $n, $f->check_name, $f->message);
215        }
216
4
37
        return join("\n", @lines) . "\n";
217}
218
219# ---------------------------------------------------------------------------
220# Private helpers
221# ---------------------------------------------------------------------------
222
223# Purpose:    Find the most severe severity string in a group of findings.
224# Entry:      $group is a non-empty arrayref of Finding objects.
225# Exit:       String -- one of 'error', 'warning', 'info', 'pass'.
226# Side effects: None.
227sub _worst_severity {
228
35
35
335
        my $group = shift;
229        # Sort by numeric rank (descending) and take the first (= highest) value.
230
35
7
41
35
30
27
41
27
        return (sort { $SEV_RANK{$b} <=> $SEV_RANK{$a} } map { $_->severity } @{$group})[0];
231}
232
2331;
234