view release on metacpan or  search on metacpan

lib/App/Project/Doctor/Report.pm  view on Meta::CPAN

sub render_text {
	my ($self, %opts) = @_;
	# verbose mode adds per-finding detail lines under each check summary.
	my $verbose = $opts{verbose} // 0;

	# Group findings by check name while preserving the insertion order of
	# the first finding seen for each check.  This keeps the output stable.
	my (%by_check, @order);
	for my $f ($self->all_findings) {
		my $name = $f->check_name;
		unless (exists $by_check{$name}) {
			# First time we see this check name -- record its position.
			push @order, $name;
			$by_check{$name} = [];
		}
		push @{ $by_check{$name} }, $f;
	}

	# Build the output one line at a time and join at the end.
	my @lines;
	for my $name (@order) {
		my @group = @{ $by_check{$name} };
		# Choose the worst severity in this group to pick the icon.
		my $sev   = _worst_severity(\@group);
		my $icon  = $ICON{$sev};    # Severity is always valid; no fallback needed.

		# Use the first non-pass finding as the summary line for mixed groups.
		my ($lead) = grep { $_->severity ne 'pass' } @group;
		my $summary = $lead ? $lead->message : $group[0]->message;

		# Format: icon  check-name (padded)  summary message
		push @lines, sprintf('  %-4s  %-*s  %s', $icon, $LABEL_WIDTH, $name, $summary);

		if ($verbose) {
			# In verbose mode, print each non-pass finding with its detail.
			for my $f (@group) {
				# Skip pass findings in verbose mode -- they have no useful detail.
				next if $f->severity eq 'pass';
				push @lines, sprintf('        -> %s', $f->message);
				# Only print the detail line when there is something to show.
				push @lines, sprintf('           %s', $f->detail) if $f->detail;
			}
		}
	}

	# Print a one-line summary of error/warning counts below the check table.
	my $ec = scalar($self->errors);
	my $wc = scalar($self->warnings);
	push @lines, '';    # Blank line before the summary.
	push @lines, $ec || $wc
		? join(' - ', ($ec ? "$ec error(s)" : ()), ($wc ? "$wc warning(s)" : ()))
		: 'No errors or warnings.';

	# If there are fixable findings, show them and hint that the user can apply them.
	my @fixable = $self->fixable;
	if (@fixable) {
		push @lines, '';
		push @lines, 'Suggested fixes:';
		my $i = 0;
		# Number each fix starting at 1 for the interactive prompt that follows.
		push @lines, sprintf('  [%d] %s', ++$i, $_->message) for @fixable;
		push @lines, '';
		push @lines, 'Would you like me to apply them? [Y/n]';
	}

	# Join with newlines and add a trailing newline for clean shell output.
	return join("\n", @lines) . "\n";
}

=head2 render_json

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

=cut

sub render_json {
	my $self = shift;
	# JSON::MaybeXS is loaded lazily so it is only required when --format=json.
	require JSON::MaybeXS;
	# canonical => 1 sorts keys so the output is diff-friendly.
	return JSON::MaybeXS->new(utf8 => 1, pretty => 1, canonical => 1)
	                    ->encode([ map { $_->to_hash } $self->all_findings ]);
}

=head2 render_tap

Returns a TAP-format string for CI pipeline consumption.

=cut

sub render_tap {
	my $self     = shift;
	my @findings = $self->all_findings;
	# TAP header declares how many tests will follow.
	my @lines    = ('1..' . scalar @findings);
	my $n        = 0;
	for my $f (@findings) {
		$n++;
		# pass and info severities are "ok"; error and warning are "not ok".
		my $ok = $f->severity =~ /^(?:pass|info)$/ ? 'ok' : 'not ok';
		push @lines, sprintf('%s %d - [%s] %s', $ok, $n, $f->check_name, $f->message);
	}
	return join("\n", @lines) . "\n";
}

# ---------------------------------------------------------------------------
# Private helpers
# ---------------------------------------------------------------------------

# Purpose:    Find the most severe severity string in a group of findings.
# Entry:      $group is a non-empty arrayref of Finding objects.
# Exit:       String -- one of 'error', 'warning', 'info', 'pass'.
# Side effects: None.
sub _worst_severity {
	my $group = shift;
	# Sort by numeric rank (descending) and take the first (= highest) value.
	return (sort { $SEV_RANK{$b} <=> $SEV_RANK{$a} } map { $_->severity } @{$group})[0];
}

1;