Coverage works great as part on continuous integration, until a new file is
added and the unit tests are blissfully ignorant of the new file's existence.
In the past with other coverage tools we would scan the source tree and do some
mock operation to get the coverage tool to become aware of the source file.
Sometimes it is a bit messy, sometimes not. I think this one falls into the a
little bit messy, because we had to go the internals of Devel::Cover::DB and
reproduce how Cover.pm uses it.
Below is the script we are using. It provides the minimum functionality
required, showing the file as 0% covered.
Does anyone have better suggestions?
-Jason Pyeron
#!/usr/bin/perl -w
use Time::HiRes qw(time);
use Data::Dumper;
use File::Find;
use Cwd;
print "load\n";
use Devel::Cover::DB;
my $dbpath="cover_db";
my $db = Devel::Cover::DB->new(db => $dbpath);
my $timeStart=time;
my $runKey="$timeStart.$$";
my %known;
print "ingest\n";
find({ wanted => \&process_coverfile, no_chdir => 1 }, "$dbpath/runs/");
find({ wanted => \&process_coverfile, no_chdir => 1 }, "$dbpath/digests");
find({ wanted => \&process_coverfile, no_chdir => 1 }, "$dbpath/structure/");
sub process_coverfile
{
if (-f $_)
{
my $x=$db->read($_);
foreach my $run ($x->runs)
{
my $h=$run->{digests};
foreach my $file (keys %$h)
{
if ( ! exists $known{$file} )
{
$known{$file}=$run->{digests}{$file};
}
}
}
}
}
print scalar keys %known, " known covered file(s) found\n";
print "preprocess\n";
my %toadd;
find({ wanted => \&process_file, no_chdir => 1 }, "scripts");
sub process_file
{
if (-f $_)
{
if ( ! exists $known{$_} )
{
$toadd{$_}=Devel::Cover::DB::Structure->digest($_);
}
}
}
print scalar keys %toadd, " uncovered file(s) found and hashed\n";
print "process\n";
if (scalar keys %toadd == 0)
{
print "no files to process\n";
exit;
}
print "run: $runKey\n";
$db->{runs}{$runKey}{"OS"}=$^O;
$db->{runs}{$runKey}{"collected"}=["branch","condition","pod","statement","subroutine","time"];
$db->{runs}{$runKey}{"dir"}=Cwd::abs_path();
$db->{runs}{$runKey}{"vec"}={};
$db->{runs}{$runKey}{"start"}=$timeStart;
$db->{runs}{$runKey}{"run"}=$0;
$_=$^V;
s/v//;
$db->{runs}{$runKey}{"perl"}=$_;
my $s=$db->{structure}=Devel::Cover::DB::Structure->new;
foreach my $file (keys %toadd)
{
$db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"branch"}=undef;
$db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"condition"}=undef;
$db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"pod"}=undef;
$db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"subroutine"}=undef;
$db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"time"}=undef;
$db->{structure}->{f}{$file}{start}{-1}{"__COVER__"}[0]{"statement"}=0;
$db->{structure}->{f}{$file}{file}=$file;
$db->{structure}->{f}{$file}{digest}=$toadd{$file};
$db->{structure}->{f}{$file}{statement}=[1];
$db->{runs}{$runKey}{"count"}{$file}{'statement'}=[0];
$db->{runs}{$runKey}{"digests"}{$file}=$toadd{$file};
}
$db->{runs}{$runKey}{"finish"}=time;
print "saving\n";
$db->write("$dbpath/runs/$runKey");
--
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
- -
- Jason Pyeron PD Inc. http://www.pdinc.us -
- Principal Consultant 10 West 24th Street #100 -
- +1 (443) 269-1555 x333 Baltimore, Maryland 21218 -
- -
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
