gcov2perl

#!/usr/bin/perl

# Copyright 2001-2005, Paul Johnson (pjcj@cpan.org)

# This software is free.  It is licensed under the same terms as Perl itself.

# The latest version of this software should be available from my homepage:
# http://www.pjcj.net

require 5.6.1;

use strict;
use warnings;

our $VERSION = "0.53";

use Devel::Cover::DB 0.53;

use Getopt::Long;
use Pod::Usage;

my $Options =
{
    db     => "cover_db",
    merge  => 1,
};

sub get_options
{
    die "Bad option" unless
    GetOptions($Options,                # Store the options in the Options hash.
               qw(
                   db=s
                   help|h!
                   info|i!
                   merge!
                   version|v!
                 ));
    print "$0 version $VERSION\n" and exit 0 if $Options->{version};
    pod2usage(-exitval => 0, -verbose => 0)  if $Options->{help};
    pod2usage(-exitval => 0, -verbose => 2)  if $Options->{info};
}

sub add_cover
{
    my ($file) = @_;

    my $f = $file;
    $f =~ s/.gcov$//;

    my %run;
    $run{collected} = ["statement"];
    my $structure = Devel::Cover::DB::Structure->new;
    $structure->add_criteria("statement");
    $structure->add_digest($f, \%run);

    open F, $file or die "Can't open $file: $!\n";
    while (<F>)
    {
        next unless my ($count, $line) = /(.{9}):\s*(\d+):/;
        $count =~ s/\s+//g;
        next if $count eq "-";
        $count = 0 if $count eq "#####";

        # print "$f:$line - $count\n";
        push @{$run{count}{$f}{statement}}, $count;
        $structure->add_statement($f, $line);
    }
    close F or die "Can't close $file: $!\n";

    my $run   = time . ".$$." . sprintf "%05d", rand 2 ** 16;
    my $db    = $Options->{db};
    my $cover = Devel::Cover::DB->new
    (
        base      => $db,
        runs      => { $run => \%run },
        structure => $structure,
    );

    $db .= "/runs";
    mkdir $db unless -d $db;
    $db .= "/$run";

    $cover->{db} = $db;

    print STDOUT __PACKAGE__, ": Writing coverage database to $db\n";
    $cover->write;
}

sub main
{
    get_options;
    add_cover $_ for @ARGV;
}

main

__END__

=head1 NAME

gcov2perl - convert gcov files to Devel::Cover databases

=head1 SYNOPSIS

 gcov2perl -h -i -v -db database gcov_files

=head1 DESCRIPTION

Convert gcov files to Devel::Cover databases.

=head1 OPTIONS

The following command line options are supported:

 -db database    - specify the database to use

 -h -help        - show help
 -i -info        - show documentation
 -v -version     - show version

=head1 EXIT STATUS

The following exit values are returned:

 0   All files converted successfully
 >0  An error occurred.

=head1 SEE ALSO

 Devel::Cover

=head1 BUGS

Huh?

=head1 VERSION

Version 0.53 - 17th April 2005

=head1 LICENCE

Copyright 2001-2005, Paul Johnson (pjcj@cpan.org)

This software is free.  It is licensed under the same terms as Perl itself.

The latest version of this software should be available from my homepage:
http://www.pjcj.net

=cut