view release on metacpan or  search on metacpan

bin/test-generator-index  view on Meta::CPAN

			delete $commit_times{$full_sha};
		} else {
			$commit_messages{$full_sha} = $message if $message;
		}
	}
}

# Build short-to-full SHA mapping so filename SHAs of any
# length can be resolved to their full commit SHA.
# We use //= so that if two commits share a prefix (unlikely
# but possible), the first one wins rather than silently
# overwriting with a later one
my %sha_lookup;
for my $full (keys %commit_messages) {
	# Index every prefix from 7 chars up to the full SHA length
	# so that history filenames with any abbreviation length match
	for my $len (7 .. length($full)) {
		my $prefix = substr($full, 0, $len);
		$sha_lookup{$prefix} //= $full;
	}
}

# Collect data points from non-merge commits
my @data_points_with_time;
my $processed_count = 0;

foreach my $file (reverse sort @history_files) {
	last if $processed_count >= $config{max_points};

	my $json = $historical_cache{$file};
	next unless $json->{summary};

	# Extract the commit SHA from the history filename.
	# SHA length varies (7+ chars) as Git increases abbreviation
	# length automatically when the repository grows — so we match
	# any run of hex characters rather than a fixed 7-character width
	my ($sha) = $file =~ /-([0-9a-f]+)\.json$/i;

	# Skip files that don't match the expected naming pattern
	# e.g. YYYY-MM-DD-SHA.json — $sha will be undef otherwise
	next unless defined $sha;

	# Resolve the short filename SHA to a full SHA first,
	# then check the full SHA in %commit_messages
	my $full_sha = $sha_lookup{$sha};
	next unless defined $full_sha;
	next unless $commit_messages{$full_sha}; # skip merge commits

	# Compute average across our own files only
	my ($sum, $count) = (0, 0);
	for my $f (keys %{ $json->{summary} }) {
		next if $f eq 'Total';
		next if $f =~ /^\//;
		next unless $f =~ /^(?:lib|blib|bin)\//;	# only own project files
		$sum += $json->{summary}{$f}{total}{percentage} // 0;
		$count++;
	}
	next unless $count;

	# Use full SHA for lookups and URL
	my $timestamp = $commit_times{$full_sha} // strftime('%Y-%m-%dT%H:%M:%S', localtime((stat($file))->mtime));

	# Git log returns format like: "2024-01-15 14:30:45 -0500" or "2024-01-15 14:30:45 +0000"
	# We need ISO 8601 format: "2024-01-15T14:30:45-05:00"

	# 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 = $sum / $count;
	my $color = 'gray';	# Will be set properly after sorting
	my $url = "https://github.com/$config{github_user}/$config{github_repo}/commit/$full_sha";
	my $comment = $commit_messages{$full_sha};

	# Store with timestamp for sorting
	push @data_points_with_time, {
		timestamp => $timestamp,
		pct => $pct,
		url => $url,
		comment => $comment
	};

	$processed_count++;
}

# Sort by timestamp to ensure chronological order
@data_points_with_time = sort { $a->{timestamp} cmp $b->{timestamp} } @data_points_with_time;

# Now calculate deltas and create JavaScript data points
my @data_points;
my $prev_pct;

foreach my $point (@data_points_with_time) {
	my $delta = defined $prev_pct ? sprintf('%.1f', $point->{pct} - $prev_pct) : 0;
	$prev_pct = $point->{pct};

	my $color = $delta > 0 ? 'green' : $delta < 0 ? 'red' : 'gray';

	my $comment = js_escape($point->{comment});
	push @data_points, qq{{ x: "$point->{timestamp}", y: $point->{pct}, delta: $delta, url: "$point->{url}", label: "$point->{timestamp}", pointBackgroundColor: "$color", comment: "$comment" }};
}

if(scalar(@data_points)) {
	push @html, <<'HTML';
<div style="display: flex; justify-content: space-between; align-items: center; margin-bottom: 1em;">
	<div>
		<h2>Coverage Trend</h2>
		<label>
			<input type="checkbox" id="toggleTrend" checked>
			Show regression trend
		</label>
		<div>
		</div>
	</div>
	<div id="zoomControls" style="margin-top:8px;">
		<input type="button" value="Refresh" onClick="refresh(this)">

bin/test-generator-index  view on Meta::CPAN

			push @html, sprintf(
				qq{<tr class="%s"><td>%s</td><td>%s</td><td>%s</td><td>%s</td><td>%s</td>
				<td><a href="%s" target="_blank">View</a></td></tr>},
				$row_class,
				$date,
				$os,
				$perl,
				$reporter,
				$new_html,
				$url
			);
		}

		push @html, '</tbody></table>';
	} else {
		# @fail_reports is empty
		push @html, "<p>No <A HREF=\"https://fast2-matrix.cpantesters.org/?dist=$dist_name+$version\">CPAN Testers</A> failures reported for $dist_name $version</p>";
	}
} elsif($res->{status} == 404) {	# 404 means no fail reports
	push @html, "<p>No CPAN Testers failures reported for $dist_name $version.</p>";
} else {
	my $reason = $res->{status} == $HTTP_CONNECTION_FAILED
		? 'CPAN Testers API temporarily unreachable'
		: "$res->{status} $res->{reason}";
	push @html, "<p><em>CPAN Testers data unavailable: $reason. "
		. "Check <a href=\"$cpan_api\">$cpan_api</a> manually.</em></p>";
}

# Output the Mutation Overview
if($mutation_db) {
	my $lcsaj_hits;

	if($config{lcsaj_hits_file} && -f $config{lcsaj_hits_file}) {
		open my $lfh, '<', $config{lcsaj_hits_file};
		$lcsaj_hits = decode_json(do { local $/; <$lfh> });
		close $lfh;
	}

	my $files = _group_by_file($mutation_db);

	push @html, @{_mutation_index($mutation_db, $files, $cover_db, $config{lcsaj_root}, $lcsaj_hits)};

	# Pre-sort files worst-first so navigation order matches index order
	my @sorted_files = sort { _file_score($files->{$a}) <=> _file_score($files->{$b}) || $a cmp $b } keys %$files;

	for my $i (0 .. $#sorted_files) {
		my $file = $sorted_files[$i];

		# Only assign previous if this is NOT the first file
		my $prev = $i > 0 ? $sorted_files[$i - 1] : undef;

		# Only assign next if this is NOT the last file
		my $next = $i < $#sorted_files ? $sorted_files[$i + 1] : undef;

		_mutant_file_report($config{mutation_output_dir}, $file, $files->{$file}, $prev, $next, $cover_db, $config{lcsaj_root}, $lcsaj_hits);
	}
}

my $timestamp = 'Unknown';
if(my $stat = stat($config{cover_db})) {
	$timestamp = strftime('%Y-%m-%d %H:%M:%S', localtime($stat->mtime));
}

push @html, <<"HTML";
<footer>
	<p>Project: <a href="https://github.com/$config{github_user}/$config{github_repo}">$config{github_repo}</a></p>
	<p><em>Last updated: $timestamp - <a href="$commit_url">commit <code>$short_sha</code></a></em></p>
</footer>

</body>
</html>
HTML

# Write to index.html
print "Writing output to $config{output}\n" if($config{verbose});
write_file($config{output}, join("\n", @html));

# Generate mutant test stubs only if --generate_mutant_tests=dir was given.
# This is opt-in to avoid surprising existing pipelines with new files.
if($mutation_db && $mutant_test_dir) {
	_generate_mutant_tests($mutation_db, $cover_db, $mutant_test_dir, $generate_test);
}

# Generate fuzz schema augmentations from surviving mutants
# if --generate_fuzz was passed on the command line
if($mutation_db && $generate_fuzz) {
	_generate_fuzz_schemas($mutation_db);
}

# --------------------------------------------------
# run_git
#
# Purpose:    Execute a git command safely and return
#             its stdout, or undef on failure.
#
# Entry:      @cmd - list of git subcommand and args
#             to pass directly to git.
#
# Exit:       Returns the chomped stdout string on
#             success, or undef if the command exits
#             non-zero.
#
# Side effects: Forks a child process. Discards stderr.
#
# Notes:      Uses IPC::Run3 to capture output without
#             a shell, avoiding injection risks from
#             user-supplied filenames.
# --------------------------------------------------
sub run_git {
	my @cmd = @_;
	my ($out, $err);
	run3 ['git', @cmd], \undef, \$out, \$err;
	return unless $? == 0;
	chomp $out;
	return $out;
}

# --------------------------------------------------
# js_escape
#