view release on metacpan or  search on metacpan

lib/App/ArchiveDevelCover.pm  view on Meta::CPAN

package App::ArchiveDevelCover;
use 5.010;
use Moose;
use MooseX::Types::Path::Class;
use DateTime;
use File::Copy;
use HTML::TableExtract;
use experimental qw(switch);

# ABSTRACT: Archive Devel::Cover reports
our $VERSION = '1.004'; # VERSION

with 'MooseX::Getopt';

has [qw(from to)] => (is=>'ro',isa=>'Path::Class::Dir',coerce=>1,required=>1,);
has 'project' => (is => 'ro', isa=>'Str', lazy_build=>1);
sub _build_project {
    my $self = shift;
    my @list = $self->from->parent->dir_list;
    return $list[-1] || 'unknown project';
}
has 'coverage_html' => (is=>'ro',isa=>'Path::Class::File',lazy_build=>1,traits=> ['NoGetopt']);
sub _build_coverage_html {
    my $self = shift;
    if (-e $self->from->file('coverage.html')) {
        return $self->from->file('coverage.html');
    }
    else {
        say "Cannot find 'coverage.html' in ".$self->from.'. Aborting';
        exit;
    }
}
has 'runtime' => (is=>'ro',isa=>'DateTime',lazy_build=>1,traits=> ['NoGetopt'],);
sub _build_runtime {
    my $self = shift;
    return DateTime->from_epoch(epoch=>$self->coverage_html->stat->mtime);
}
has 'archive_html' => (is=>'ro',isa=>'Path::Class::File',lazy_build=>1,traits=> ['NoGetopt']);
sub _build_archive_html {
    my $self = shift;
    unless (-e $self->to->file('index.html')) {
        my $tpl = $self->_archive_template;
        my $fh = $self->to->file('index.html')->openw;
        print $fh $tpl;
        close $fh;
    }
    return $self->to->file('index.html');
}
has 'archive_db' => (is=>'ro',isa=>'Path::Class::File',lazy_build=>1,traits=> ['NoGetopt']);
sub _build_archive_db {
    my $self = shift;
    return $self->to->file('archive_db');
}
has 'previous_stats' => (is=>'ro',isa=>'ArrayRef',lazy_build=>1,traits=>['NoGetopt']);
sub _build_previous_stats {
    my $self = shift;
    if (-e $self->archive_db) {
        my $dbr = $self->archive_db->openr;
        my @data = <$dbr>; # probably better to just get last line...
        my @prev = split(/;/,$data[-1]);
        return \@prev;
    }
    else {
        return [undef,0,0,0];
    }
}
has 'diff_html' => (is=>'ro',isa=>'Path::Class::File',lazy_build=>1,traits=> ['NoGetopt']);
sub _build_diff_html {
    my $self = shift;
    return $self->to->subdir($self->runtime->iso8601)->file('diff.html');
}

sub run {
    my $self = shift;
    $self->archive;
    $self->generate_diff;
    $self->update_index;
}

sub archive {
    my $self = shift;

    my $from = $self->from;
    my $target = $self->to->subdir($self->runtime->iso8601);

    if (-e $target) {
        say "This coverage report has already been archived.";
        exit;
    }

    $target->mkpath;
    my $target_string = $target->stringify;

    while (my $f = $from->next) {
        next unless $f=~/\.(html|css)$/;
        copy($f->stringify,$target_string) || die "Cannot copy $from to $target_string: $!";
    }

    say "archived coverage reports at $target_string";
}

sub update_index {
    my $self = shift;

    my $te = HTML::TableExtract->new( headers => [qw(stm sub total)] );
    $te->parse(scalar $self->coverage_html->slurp);
    my $rows =$te->rows;
    my $last_row = $rows->[-1];

    $self->update_archive_html($last_row);
    $self->update_archive_db($last_row);
}

sub update_archive_html {