CGI-Lingua
view release on metacpan or search on metacpan
scripts/generate_index.pl view on Meta::CPAN
my $MAX_REPORTS_PER_GRADE = 20; # safety rail
my $ENABLE_DEP_ANALYSIS = 1;
# Read and decode coverage data
my $data = eval { decode_json(read_file($config{cover_db})) };
my $coverage_pct = 0;
my $badge_color = 'red';
if(my $total_info = $data->{summary}{Total}) {
$coverage_pct = int($total_info->{total}{percentage} // 0);
$badge_color = $coverage_pct > $config{med_threshold} ? 'brightgreen' : $coverage_pct > $config{low_threshold} ? 'yellow' : 'red';
}
Readonly my $coverage_badge_url => "https://img.shields.io/badge/coverage-${coverage_pct}%25-${badge_color}";
# Start HTML
my @html; # build in array, join later
push @html, <<"HTML";
<!DOCTYPE html>
<html>
scripts/generate_index.pl view on Meta::CPAN
if (@history >= 1) {
my $prev_file = $history[-1]; # Most recent before current
$prev_data = $historical_cache{$prev_file};
}
my %deltas;
if ($prev_data) {
for my $file (keys %{$data->{summary}}) {
next if $file eq 'Total';
my $curr = $data->{summary}{$file}{total}{percentage} // 0;
my $prev = $prev_data->{summary}{$file}{total}{percentage} // 0;
my $delta = sprintf('%.1f', $curr - $prev);
$deltas{$file} = $delta;
}
}
# Check if we're in a git repository first
unless (run_git('rev-parse', '--git-dir')) {
die 'Error: Not in a git repository or git is not available';
}
scripts/generate_index.pl view on Meta::CPAN
for my $file (sort keys %{$data->{summary}}) {
next if $file eq 'Total';
my $info = $data->{summary}{$file};
my $html_file = $file;
$html_file =~ s|/|-|g;
$html_file =~ s|\.pm$|-pm|;
$html_file =~ s|\.pl$|-pl|;
$html_file .= '.html';
my $total = $info->{total}{percentage} // 0;
$total_files++;
$total_coverage += $total;
$low_coverage_count++ if $total < $config{low_threshold};
my $badge_class = $total >= $config{med_threshold} ? 'badge-good'
: $total >= $config{low_threshold} ? 'badge-warn'
: 'badge-bad';
my $tooltip = $total >= $config{med_threshold} ? 'Excellent coverage'
: $total >= $config{low_threshold} ? 'Moderate coverage'
scripts/generate_index.pl view on Meta::CPAN
my $badge_html = sprintf(
'<span class="coverage-badge %s" title="%s">%.1f%%</span>',
$badge_class, $tooltip, $total
);
my $delta_html = '';
if (exists $deltas{$file}) {
my $delta = $deltas{$file};
my $delta_class = $delta > 0 ? 'positive' : $delta < 0 ? 'negative' : 'neutral';
my $delta_icon = $delta > 0 ? '▲' : $delta < 0 ? '▼' : '●';
my $prev_pct = $prev_data->{summary}{$file}{total}{percentage} // 0;
$delta_html = sprintf(
'<td class="%s" title="Previous: %.1f%%">%s %.1f%%</td>',
$delta_class, $prev_pct, $delta_icon, abs($delta)
);
} else {
$delta_html = '<td class="neutral" title="No previous data">●</td>';
}
my $source_url = $github_base . $file;
my $has_coverage = (
defined $info->{statement}{percentage} ||
defined $info->{branch}{percentage} ||
defined $info->{condition}{percentage} ||
defined $info->{subroutine}{percentage}
);
my $source_link = $has_coverage
? sprintf('<a href="%s" class="icon-link" title="View source on GitHub">🔍</a>', $source_url)
: '<span class="disabled-icon" title="No coverage data">🔍</span>';
# Create the sparkline - limit to last N points like the main trend chart
my @file_history;
# Get the last max_points history files (same as trend chart)
my @limited_history = (scalar(@history_files) > $config{max_points})
? @history_files[-$config{max_points} .. -1]
: @history_files;
# Use the already-cached historical data
for my $hist_file (sort @limited_history) {
my $json = $historical_cache{$hist_file};
next unless $json; # Skip if not cached (shouldn't happen, but be safe)
if($json->{summary}{$file}) {
my $pct = $json->{summary}{$file}{total}{percentage} // 0;
push @file_history, sprintf('%.1f', $pct);
}
}
my $points_attr = join(',', @file_history);
push @html, sprintf(
qq{<tr class="%s"><td><a href="%s" title="View coverage line by line" target="_blank">%s</a> %s<canvas class="sparkline" width="80" height="20" data-points="$points_attr"></canvas></td><td>%.1f</td><td>%.1f</td><td>%.1f</td><td>%.1f</td><td>%s</td>...
$row_class, $html_file, $file, $source_link,
$info->{statement}{percentage} // 0,
$info->{branch}{percentage} // 0,
$info->{condition}{percentage} // 0,
$info->{subroutine}{percentage} // 0,
$badge_html,
$delta_html
);
}
# Summary row
my $avg_coverage = $total_files ? int($total_coverage / $total_files) : 0;
push @html, sprintf(
qq{<tr class="summary-row nosort"><td colspan="2"><strong>Summary</strong></td><td colspan="2">%d files</td><td colspan="3">Avg: %d%%, Low: %d</td></tr>},
$total_files, $avg_coverage, $low_coverage_count
);
# Add totals row
if (my $total_info = $data->{summary}{Total}) {
my $total_pct = $total_info->{total}{percentage} // 0;
my $class = $total_pct > 80 ? 'high' : $total_pct > 50 ? 'med' : 'low';
push @html, sprintf(
qq{<tr class="%s nosort"><td><strong>Total</strong></td><td>%.1f</td><td>%.1f</td><td>%.1f</td><td>%.1f</td><td colspan="2"><strong>%.1f</strong></td></tr>},
$class,
$total_info->{statement}{percentage} // 0,
$total_info->{branch}{percentage} // 0,
$total_info->{condition}{percentage} // 0,
$total_info->{subroutine}{percentage} // 0,
$total_pct
);
}
Readonly my $commit_url => "https://github.com/$config{github_user}/$config{github_repo}/commit/$commit_sha";
my $short_sha = substr($commit_sha, 0, 7);
push @html, '</tbody></table>';
# Parse historical snapshots
my @trend_points;
foreach my $file (sort @history_files) {
my $json = $historical_cache{$file};
next unless $json->{summary}{Total};
my $pct = $json->{summary}{Total}{total}{percentage} // 0;
my ($date) = $file =~ /(\d{4}-\d{2}-\d{2})/;
if(defined($date)) {
push @trend_points, { date => $date, coverage => sprintf('%.1f', $pct) };
}
}
# Inject chart if we have data
my %commit_times;
my $log_output = run_git('log', '--all', '--pretty=format:%H %h %ci');
if ($log_output) {
scripts/generate_index.pl view on Meta::CPAN
# Replace space between date and time with 'T'
$timestamp =~ s/^(\d{4}-\d{2}-\d{2}) (\d{2}:\d{2}:\d{2})/$1T$2/;
# Fix timezone format: convert "-0500" to "-05:00" or " -05:00" to "-05:00"
$timestamp =~ s/\s*([+-])(\d{2}):?(\d{2})$/$1$2:$3/;
# Remove any remaining spaces (safety cleanup)
$timestamp =~ s/\s+//g;
my $pct = $json->{summary}{Total}{total}{percentage} // 0;
my $color = 'gray'; # Will be set properly after sorting
my $url = "https://github.com/$config{github_user}/$config{github_repo}/commit/$sha";
my $comment = $commit_messages{$sha};
# Store with timestamp for sorting
push @data_points_with_time, {
timestamp => $timestamp,
pct => $pct,
url => $url,
comment => $comment
( run in 1.703 second using v1.01-cache-2.11-cpan-7fcb06a456a )