You probably know how to use
Devel::Cover, or even
Coveralls as part of your
Travis CI. I wanted to see how the coverage of my tests changes in time for each coverage type: that's something you can't get from the mentioned module and services easily.
CPANCover shows it for released versions, but I wanted a more granular report.
I've written a program that does it. At the end, it creates a PNG graph that shows how each coverage type changed with each commit. It also modifies the HTML pages generated by cover so you can navigate between commits by clicking on the arrows.
If you use git as your version control system, your distribution stores code in the lib/ directory, and tests are located in `t/`, you can try the following code without modification (tested on Linux only). It checks for its dependencies, but if you want to be prepared, here's the list:
Comments welcome. If you want to modify the code to handle SVN or CVS, use other tools to create the graph or track changes in different directories, we should probably start a GitHub project.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
use HTML::TableExtract;
use Time::Piece;
use XML::XSH2;
sub startup_check {
die 'Not a git repository' unless -d '.git';
die 'Devel::Cover not installed properly' unless qx{ which cover }
+;
die 'gnuplot not found' unless qx{ which gnuplot };
die "Repository not clean. Maybe stash the changes?" unless git_re
+ady();
}
sub shell {
my $status = system @_;
die "@_: $status" if $status;
}
sub git_ready {
open my $GIT, '-|', qw{ git status --porcelain } or die $!;
my $ready = 1;
while (<$GIT>) {
$ready = 0;
}
return $ready
}
sub git_branch {
open my $GIT, '-|', qw{ git branch } or die $!;
my $branch;
while (<$GIT>) {
$branch = "$1", last if /^\* (.*)/
}
close $GIT or die $!;
return $branch
}
my @columns = qw( file stmt bran cond sub pod time total );
sub extract_coverage {
my ($commit, $n, $total) = @_;
open my $HTML, '<', "cover_db.$n/coverage.html" or die $!;
my $te = 'HTML::TableExtract'
->new(headers => [ @columns ]);
my $html = do { local $/ ; <$HTML> };
my $tables = $te->parse($html);
for my $row ($tables->rows) {
next unless 'Total' eq $row->[0];
$total->{ $commit->{id} }
= { date => $commit->{date},
map { $columns[$_] => $row->[$_] } 1 .. $#columns
};
}
}
sub add_navigation {
my ($n, $max, $commit) = @_;
{ package XML::XSH2::Map;
our $n = $n;
our $date = $commit->{date};
our $max = $max;
}
xsh << '__XSH__';
open { "cover_db.$n/coverage.html" } ;
register-namespace h http://www.w3.org/1999/xhtml ;
rm //h:a[@id = 'coverage-history-previous'
or @id = 'coverage-history-next'] ;
$date_header = //h:td[text() = 'Report Date:'] ;
if ($date_header) {
set $date_header/text() 'Commit Date:' ;
set $date_header/following-sibling::h:td[1]/text() $date ;
}
if (0 != $n) {
$prev := insert element a append //h:body ;
set $prev/@id 'coverage-history-previous' ;
set $prev/text() { "\x{2190}" } ;
set $prev/@href concat('../cover_db.', $n - 1, '/coverage.
+html') ;
insert text ' ' after $prev ;
}
if ($max != $n) {
$next := insert element a append //h:body ;
set $next/@id 'coverage-history-next' ;
set $next/text() { "\x{2192}" } ;
set $next/@href concat('../cover_db.', $n + 1, '/coverage.
+html');
}
save :f { "cover_db.$n/coverage.new" } ;
__XSH__
rename "cover_db.$n/coverage.new", "cover_db.$n/coverage.html" or
+die $!;
}
sub graph_data {
my ($total) = @_;
for my $id (keys %$total) {
my $date = $total->{$id}{date};
my $tz = substr $date, -5, 5, q();
my $tp = 'Time::Piece'->strptime($date, '%a %b %d %H:%M:%S %Y
+');
my ($sign, $hours, $minutes) = $tz =~ /([-+])(\d\d)(\d\d)/;
$tp -= "${sign}1" * $minutes * 60 + $hours * 60 * 60;
$total->{$id}{UTC} = $tp->datetime;
}
open my $OUT, '>', 'coverages.data' or die $!;
for my $id ( sort { $total->{$a}{UTC} cmp $total->{$b}{UTC} }
keys %$total
){
my $commit = $total->{$id};
say {$OUT} join "\t", map 'n/a' eq $_ ? q() : $_,
@$commit{qw{ UTC sub stmt cond bran
+}};
}
close $OUT or die $!;
}
sub draw {
my ($output) = @_;
open my $GP, '|-', 'gnuplot' or die $!;
print {$GP} << '__GNUPLOT__';
set term png tiny
set output "coverages.png"
set key outside
set xdata time
set timefmt '%Y-%m-%dT%H:%M:%S'
plot "coverages.data" u 1:2 w lines t "subs", \
"" u 1:3 w lines t "statements", \
"" u 1:4 w lines t "conditions", \
"" u 1:5 w lines t "branches"
__GNUPLOT__
close $GP or die $!;
}
sub get_commits {
my (@commits, %current);
open my $LOG, '-|', qw{ git log --stat } or die $!;
while (<$LOG>) {
if (/^commit (.*)/) {
if (delete $current{keep}) {
unshift @commits, { %current };
}
%current = ( id => "$1" );
} elsif (/^Date:\s+(.*)/) {
$current{date} = "$1";
} elsif (m=^ (?:lib|t)/=) {
$current{keep} = 1;
}
}
close $LOG or die $!;
return \@commits
}
sub make_or_build {
my ($makefile) = grep -f, qw( Makefile.PL Build.PL );
shell('perl', $makefile);
}
sub get_total {
my ($commits) = @_;
my %total;
for my $idx (reverse 0 .. $#$commits) {
my $commit = $commits->[$idx];
my $id = $commit->{id};
say STDERR @$commits - $idx, '/', scalar @$commits;
if (! -d "cover_db.$idx") {
shell(qw{ git checkout }, $id);
make_or_build();
system qw{ cover -test };
rename 'cover_db', "cover_db.$idx" or die $!;
}
add_navigation($idx, $#$commits, $commit);
extract_coverage($commit, $idx, \%total);
}
return \%total
}
sub good_bye {
print << "__EOF__"
Done.
coverage.png created.
file://$ENV{PWD}/cover_db.0/coverage.html
__EOF__
}
sub main {
startup_check();
my $commits = get_commits();
my $branch = git_branch();
my $total = get_total($commits);
shell(qw{ git checkout }, $branch);
graph_data($total);
draw();
good_bye();
}
main();
If you have lots of commits, the first run can take some time. The next run will only process the commits that haven't been processed, yet, if you don't delete the created directories.
Update: Added CPANCover.
($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
