Devel::Cover::DB::Digests - store digests for Devel::Cover::DB


Devel-Cover documentation Contained in the Devel-Cover distribution.

Index


Code Index:

NAME

Top

Devel::Cover::DB::Digests - store digests for Devel::Cover::DB

SYNOPSIS

Top

 use Devel::Cover::DB::Digests;
 my $digests = Devel::Cover::DB::Digests->new(db => $DB);
 $digests->read;
 $digests->write;

DESCRIPTION

Top

This module stores digests for Devel::Cover::DB.

SEE ALSO

Top

 Devel::Cover

METHODS

Top

new

 my $digests = Devel::Cover::DB::Digests->new(db => $DB);

Contructs the digests object.

read

 $digests->read;

Read the digests from the DB.

write

 $digests->write;

Write the digests to the DB.

BUGS

Top

Huh?

VERSION

Top

Version 0.78 - 17th May 2011

LICENCE

Top

Copyright 2001-2011, 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


Devel-Cover documentation Contained in the Devel-Cover distribution.

# Copyright 2011, 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

package Devel::Cover::DB::Digests;

use strict;
use warnings;

our $VERSION = "0.78";

use Devel::Cover::DB::Structure 0.78;
use Devel::Cover::DB::IO        0.78;

my $File = "digests";

sub new
{
    my $class = shift;
    my $self  =
    {
        digests => {},
        @_
    };

    die "No db specified" unless $self->{db};
    $self->{file} = "$self->{db}/$File";

    bless $self, $class;
    $self->read;
    $self
}

sub read
{
    my $self = shift;
    my $io = Devel::Cover::DB::IO->new;
    $self->{digests} = $io->read($self->{file}) if -e $self->{file};
    $self
}

sub write
{
    my $self = shift;
    my $io = Devel::Cover::DB::IO->new;
    $io->write($self->{digests}, $self->{file});
    $self
}

sub get
{
    my $self = shift;
    my ($digest) = @_;
    $self->{digests}{$digest}
}

sub set
{
    my $self = shift;
    my ($file, $digest) = @_;
    $self->{digests}{$digest} = $file;
}

sub canonical_file
{
    my $self = shift;
    my ($file) = @_;

    my $cfile = $file;
    my $digest = Devel::Cover::DB::Structure->digest($file);
    if ($digest)
    {
        my $dfile = $self->get($digest);
        if ($dfile && $dfile ne $file)
        {
            warn "Devel::Cover: Adding coverage for $file to $dfile\n"
                unless $Devel::Cover::Silent;
            $cfile = $dfile;
        }
        else
        {
            $self->set($file, $digest);
        }
    }

    # warn "[$file] => [$cfile]\n";

    $cfile
}

1

__END__