Skip to content
This repository
Fetching contributors…

Cannot retrieve contributors at this time

executable file 142 lines (98 sloc) 2.81 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
#!/usr/local/bin/perl

# Copyright 2001-2003, 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.30";

use Devel::Cover::DB 0.30;

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

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

sub get_options
{
    die "Bad option" unless
    GetOptions($Options, # Store the options in the Options hash.
               qw(
db=s
help|h!
indent=i
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 ($cover, $file) = @_;

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

    open F, $file or die "Can't open $file: $!\n";
    while (<F>)
    {
        $_ = substr $_, 0, 16;
        s/\s+//g;
        $_ = 0 if $_ eq "######";
        next if !length || /\D/;
        $cover->{$f}{statement}{$.} = [[[$_]]];
    }
    close F or die "Can't open $file: $!\n";
}

sub main
{
    get_options;

    my $cover = {};

    for my $file (@ARGV)
    {
        add_cover $cover, $file;
    }

    my $db = Devel::Cover::DB->new(cover => $cover);
    my $existing;
    eval { $existing = Devel::Cover::DB->new(db => $Options->{db})
               if $Options->{merge} };
    $db->merge($existing) if $existing;
    $db->indent($Options->{indent});
    $db->write($Options->{db});
}

main

__END__

=head1 NAME

gcov2perl - convert gcov files to Devel::Cover databases

=head1 SYNOPSIS

gcov2perl -h -i -v -db database -merge -indent 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
-merge - merge results with the current database
-indent - Data::Dumper indent level 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

Dvel::Cover

=head1 BUGS

Huh?

=head1 VERSION

Version 0.30 - 22nd December 2003

=head1 LICENCE

Copyright 2001-2003, 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
Something went wrong with that request. Please try again.