CGI-Lingua
view release on metacpan or search on metacpan
scripts/generate_index.pl view on Meta::CPAN
Readonly my $max_points => 10; # Only display the last 10 commits in the coverage trend graph
# Read and decode coverage data
my $json_text = read_file($cover_db);
my $data = decode_json($json_text);
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 > 80 ? 'brightgreen' : $coverage_pct > 50 ? '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
eval {
$prev_data = decode_json(read_file($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;
}
}
my $commit_sha = `git rev-parse HEAD`;
chomp $commit_sha;
my $github_base = "https://github.com/nigelhorne/CGI-Lingua/blob/$commit_sha/";
# Add rows
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 < 70;
my $badge_class = $total >= 90 ? 'badge-good'
: $total >= 70 ? 'badge-warn'
: 'badge-bad';
my $tooltip = $total >= 90 ? 'Excellent coverage'
: $total >= 70 ? '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
# There's probably some duplication of code here
my @file_history;
my @history_files = sort <coverage_history/*.json>;
my %history;
for my $file (@history_files) {
my $json = eval { decode_json(read_file($file)) };
next unless $json;
$history{$file} = $json;
}
for my $hist_file (sort @history_files) {
my $json = eval { decode_json(read_file($hist_file)) };
next unless $json && $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>\n},
$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>\n},
$class,
$total_info->{statement}{percentage} // 0,
$total_info->{branch}{percentage} // 0,
$total_info->{condition}{percentage} // 0,
$total_info->{subroutine}{percentage} // 0,
$total_pct
);
}
my $timestamp = 'Unknown';
if (my $stat = stat($cover_db)) {
$timestamp = strftime('%Y-%m-%d %H:%M:%S', localtime($stat->mtime));
}
Readonly my $commit_url => "https://github.com/nigelhorne/CGI-Lingua/commit/$commit_sha";
scripts/generate_index.pl view on Meta::CPAN
push @html, '</tbody></table>';
# Parse historical snapshots
my @history_files = bsd_glob("coverage_history/*.json");
my @trend_points;
foreach my $file (sort @history_files) {
my $json = eval { decode_json(read_file($file)) };
next unless $json && $json->{summary}{Total};
my $pct = $json->{summary}{Total}{total}{percentage} // 0;
my ($date) = $file =~ /(\d{4}-\d{2}-\d{2})/;
push @trend_points, { date => $date, coverage => sprintf('%.1f', $pct) };
}
# Inject chart if we have data
my %commit_times;
open(my $log, '-|', 'git log --all --pretty=format:"%H %h %ci"') or die "Can't run git log: $!";
while (<$log>) {
chomp;
my ($full_sha, $short_sha, $datetime) = split ' ', $_, 3;
scripts/generate_index.pl view on Meta::CPAN
next unless $json && $json->{summary}{Total};
my ($sha) = $file =~ /-(\w{7})\.json$/;
next unless $commit_messages{$sha}; # Skip merge commits
my $timestamp = $commit_times{$sha} // strftime('%Y-%m-%dT%H:%M:%S', localtime((stat($file))->mtime));
$timestamp =~ s/ /T/;
$timestamp =~ s/\s+([+-]\d{2}):?(\d{2})$/$1:$2/; # Fix space before timezone
$timestamp =~ s/ //g; # Remove any remaining spaces
my $pct = $json->{summary}{Total}{total}{percentage} // 0;
my $color = 'gray'; # Will be set properly after sorting
my $url = "https://github.com/nigelhorne/CGI-Lingua/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
scripts/generate_index.pl view on Meta::CPAN
// Determine ascending/descending toggle logic
const prevCol = table.getAttribute("data-sort-col");
const prevOrder = table.getAttribute("data-sort-order") || "desc";
const asc = (prevCol != n) ? true : (prevOrder === "desc");
normalRows.sort((a, b) => {
let x = (a.cells[n] && a.cells[n].innerText) ? a.cells[n].innerText.trim() : "";
let y = (b.cells[n] && b.cells[n].innerText) ? b.cells[n].innerText.trim() : "";
if (isNumeric) {
// Remove non-number characters (arrows, percent signs, bullets, etc.)
x = parseFloat(x.replace(/[^0-9.\-+eE]/g, '')) || 0;
y = parseFloat(y.replace(/[^0-9.\-+eE]/g, '')) || 0;
} else {
// Text compare (case-insensitive)
x = x.toLowerCase();
y = y.toLowerCase();
}
if (x < y) return asc ? -1 : 1;
if (x > y) return asc ? 1 : -1;
( run in 2.922 seconds using v1.01-cache-2.11-cpan-5837b0d9d2c )