vim-umbrella/examples/perl/umbrella.pl

#!/usr/bin/perl

require 5.6.1;

use strict;
use warnings;

use Devel::Cover::DB;
use Config;
use File::Spec;
use File::Find ();
use File::Path;
use Getopt::Long;

my $Options = 
{
    add_uncoverable_point => [],
    annotation => [],
    coverage => [],
    delete => undef,
    gcov => $Config{gccversion},
    ignore => [],
    ignore_re => [],
    launch => 0,
    make => $Config{make},
    report => "",
    report_c0 => 75,
    report_c1 => 90,
    report_c2 => 100,
    select => [],
    select_re => [],
    summary => 1,
    uncoverable_file => [".uncoverable", glob("~/.uncoverable")],
};

sub main
{
    my $dbname = File::Spec->rel2abs("cover_db");
    die "Can't open database $dbname\n"
        if !-d $dbname;

    $Options->{outputdir} = File::Spec->rel2abs($dbname);
    mkpath($Options->{outputdir}) unless -d $Options->{outputdir};

    my $db = Devel::Cover::DB->new
    (
        db => $dbname,
        uncoverable_file => $Options->{uncoverable_file}, 
    );

    $db = $db->merge_runs;
    $db->add_uncoverable($Options->{add_uncoverable_point});
    $db->delete_uncoverable($Options->{delete_uncoverable_point});
    $db->clean_uncoverable
        if $Options->{clean_uncoverable_points};
    $db->calculate_summary(map { $_ => 1 } @{$Options->{coverage}});

    my $lines = "";
    
    # Loop through the coverage and output for each file.
    for my $file (sort keys %{$db->{summary}})
    {
        my $line = "$file;";

        my $numbers = "";
        for my $n (sort keys %{$db->cover->{$file}->{statement}})
        {
            my $hits = $db->cover->{$file}->{statement}->{$n}->[0]->[0];
            my $errs = $db->cover->{$file}->{statement}->{$n}->[0]->[1];
            
            if ($hits > 0 && length($errs // '') == 0)
            {
                $numbers .= $n . ",";
            }
        }
        
        chop($numbers);
        $line .= $numbers . ";";
    
        $numbers = "";
        for my $n (sort keys %{$db->cover->{$file}->{statement}})
        {
            my $hits = $db->cover->{$file}->{statement}->{$n}->[0]->[0];
            my $errs = $db->cover->{$file}->{statement}->{$n}->[0]->[1];

            if ($hits > 0 && length($errs // '') > 0)
            {
                $numbers .= $n . ",";
            }
        }

        chop($numbers);
        $line .= $numbers . ";";

        $numbers = "";
        for my $n (sort keys %{$db->cover->{$file}->{statement}})
        {
            my $hits = $db->cover->{$file}->{statement}->{$n}->[0]->[0];
            my $errs = $db->cover->{$file}->{statement}->{$n}->[0]->[1];

            if ($hits == 0 && length($errs // '') == 0)
            {
                $numbers .= $n . ",";
            }
        }

        chop($numbers);
        $line .= $numbers . ";";
        $lines .= $line . "\n";
        print $lines;
    }

    # Write to our coverage file.
    open(MYFILE, ">.umbrella-coverage");
    print MYFILE $lines;
    close(MYFILE);
}

main