Dist::Joseki::Command::smoke - run smoke tests for your distribution

    # dist smoke

package Dist::Joseki::Command::smoke;
use strict;
use warnings;
use Cwd 'abs_path';
use Config 'myconfig';
use Dist::Joseki;
use Dist::Joseki::Find;
use File::Basename;
use File::Spec;
use File::Find;
use Template;
use Test::TAP::HTMLMatrix;
use Test::TAP::Model::Visual;
use YAML qw/LoadFile DumpFile/;
our $VERSION = '0.01';
use base 'Dist::Joseki::Cmd::Multiplexable';
__PACKAGE__->mk_hash_accessors(qw(dist_errors));

sub options {
    my ($self, $app, $cmd_config) = @_;
    return (
        $self->SUPER::options($app, $cmd_config),
        [ 'cover|c',  'also run coverage tests', ],
        [ 'resume|r', 'skip tests if there is a smoke.html already', ],
        [   'summary|s=s',
            'location of summary file',
            {   default => $cmd_config->{summary} || sprintf('%s/smoke.html',
                    (Dist::Joseki::Find->new->projroot)[0]),
            },
        ],
    );
}

sub run_smoke_tests {
    my $self                = shift;
    my $smoke_html_filename = 'smoke.html';
    my $smoke_yaml_filename = 'smoke.yaml';
    if (-e 'BUILD.SKIP') {
        warn "Skipping build because of BUILD.SKIP\n";
        return;
    }
    if ($self->opt_has_value('resume') && -e $smoke_html_filename) {
        warn "Skipping tests because --resume is given and smoke.html exists\n";
        return;
    }
    my $dist = Dist::Joseki->get_dist_type;
    $dist->ACTION_default;

    # Run smoke tests. Assumes that 'make' has already been run.
    my $meta = LoadFile('META.yml') or die "can't load META.yml\n";
    my $distname = $meta->{name};
    local $ENV{HARNESS_VERBOSE} = 1;
    my $model = Test::TAP::Model::Visual->new_with_tests(glob("t/*.t"));
    open my $fh, '>', $smoke_html_filename
      or die "can't open $smoke_html_filename for writing: $!\n";
    my $v = Test::TAP::HTMLMatrix->new($model, $distname);
    $v->has_inline_css(1);
    print $fh "$v";
    close $fh or die "can't close $smoke_html_filename: $!\n";

    # force scalar context so localtime() outputs readable string
    my $start_time = localtime($model->{meat}{start_time});
    my $end_time   = localtime($model->{meat}{end_time});
    my %summary    = (
        distname   => $distname,
        start_time => $start_time,
        end_time   => $end_time,
    );
    for (
        qw(percentage seen todo skipped passed
        failed unexpectedly_succeeded ratio)
      ) {
        my $method = "total_$_";
        $summary{$_} = $model->$method;
    }
    DumpFile($smoke_yaml_filename, \%summary);

    # Don't distclean so the generated test files (t/embedded) remain: They
    # are referenced from smoke.html pages.
}

sub run_coverage_tests {
    my $self = shift;
    return unless $self->opt_has_value('cover');
    if (-e 'BUILD.SKIP') {
        warn "Skipping coverage tests because of BUILD.SKIP\n";
        return;
    }
    if (-e 'COVER.SKIP') {
        warn "Skipping coverage tests because of COVER.SKIP\n";
        return;
    }

    # Run coverage tests. Assumes that 'make' has already been run.
    $self->safe_system('cover -delete');
    $self->safe_system(
        'HARNESS_PERL_SWITCHES=-MDevel::Cover=-ignore,^inc/ make test');
    $self->safe_system('cover');
}

sub create_summary {
    my $self        = shift;
    my $summary_dir = abs_path(dirname($self->opt('summary')));
    my @smoke;
    find(
        sub {
            return unless -f && $_ eq 'smoke.yaml';
            return if -e 'BUILD.SKIP';
            my $summary = LoadFile($_);
            unless ($summary->{distname}) {
                warn "$File::Find::name defines no distname\n";
                return;
            }

            # assume the summary_dir path is above all of the @basedir paths
            (my $rel_dir = $File::Find::dir) =~ s!^$summary_dir/!!;
            $summary->{link} = "$rel_dir/smoke.html";
            my $tee = 'smoketee.txt';
            if (-e $tee) {
                $summary->{rawlink} = "$rel_dir/$tee";
                my $raw = do { local (@ARGV, $/) = $tee; <> };
                $summary->{rawalert}++
                  if $raw =~ /Use of uninitialized value/
                      || $raw =~ / at .* line \d+/
                      || $raw =~ /Failed test /
                      || $raw =~ /Looks like you failed/
                      || $raw =~
                      /Looks like you planned \d+ tests but ran \d+ extra/
                      || $raw =~ /No tests run!/;
            }
            my $coverage_html = "$File::Find::dir/cover_db/coverage.html";
            if (-e $coverage_html) {
                $summary->{coverage_link} = "$rel_dir/cover_db/coverage.html";
                open my $fh, '<', $coverage_html
                  or die "can't open $coverage_html: $!\n";
                my $html = do { local $/; <$fh> };
                close $fh or die "can't close $coverage_html: $!\n";

                # crude but effective
                ($summary->{coverage_total}) =
                  $html =~ m!">(\d+\.\d+)</td></tr>\D+$!s;
            }
            $summary->{coverage_total} = sprintf "%.2f",
              defined $summary->{coverage_total}
              ? $summary->{coverage_total}
              : 0;
            push @smoke => $summary;
        },
        Dist::Joseki::Find->new->projroot
    );
    @smoke =
      map  { $_->[0] }
      sort { $a->[1] cmp $b->[1] }
      map  { [ $_, $_->{distname} ] } @smoke;
    my $template = $self->get_template;
    my $tt       = Template->new;
    $tt->process(
        \$template,
        {   smoke  => \@smoke,
            errors => scalar($self->dist_errors),
            config => myconfig(),
        },
        $self->opt('summary')
    ) || die $tt->error;
}

sub run {
    my $self = shift;
    $self->SUPER::run(@_);
    $self->create_summary;
}

sub run_single {
    my $self = shift;
    $self->SUPER::run_single(@_);
    $self->assert_is_dist_base_dir;
    $self->run_smoke_tests;
    $self->run_coverage_tests;

    # create summary here as well as in run() so if we're iterating over all
    # dists we can watch the summary grow
    $self->create_summary;
}

sub handle_dist_error {
    my ($self, $dist, $error) = @_;

    # we maintain a hash of lists, so get a reference and manipulate it
    # directly
    my $dist_errors = $self->dist_errors;
    push @{ $dist_errors->{$dist} } => $error;
}
sub get_template {
    <<'EOTEMPLATE' }
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN"
    "http://www.w3.org/TR/REC-html40/strict.dtd">
<html>
<head>
<title>Smoke Test Result Summary</title>

<script type="text/javascript" src="sorttable.js"></script>
<style type="text/css">
<!--

body {
    font-family: Verdana, Arial, Helvetica, Tahoma;
    font-size: small;
    background-color: #EFEFEF;
}

a { color: #000066; text-decoration: none; font-style: italic; }

table {
    border-collapse: collapse;
}

th, td {
    border: 1px solid #444444;
    font-weight: bold;
    font-size: 1em;
    color: black;
    text-align: center;
    vertical-align: middle;
    background-color: #efefef;
    padding: 5px;
}

td.allfail {
    background-color: #ff6450;
}

td.allpass {
    background-color: #00ff00;
}

td.partial {
    background-color: #fffb50;
}

p.disterrorhead {
    font-weight: bold;
}

li.disterror {
    color: red;
}

-->
</style>

</head>
<body>
<h1>Smoke Test Result Summary</h1>

<table class="sortable" id="summary">
    <tr>
        <th id="0">Distribution</th>
        <th id="1">raw</th>
        <th id="2">coverage</th>
        <th id="3">tests</th>
        <th id="4">ok</th>
        <th id="5">fail</th>
        <th id="6">todo</th>
        <th id="7">skip</th>
        <th id="8">unexp.<BR>success</th>
        <th id="9">total</th>
        <th id="10">time</th>
    </tr>

[% FOR dist = smoke;
    IF dist.ratio == 0;
        tdclass = "allfail";
    ELSIF dist.ratio == 1;
        tdclass = "allpass";
    ELSE;
        tdclass = "partial";
    END;
%]
    <tr>
        <td>
            <a href="[% dist.link %]">[% dist.distname %]</a>
        </td>



        [% IF dist.rawlink %]

            [%
                IF dist.rawalert;
                    rawtdclass = "allfail";
                    rawtext    = "warn";
                ELSE;
                    rawtdclass = "allpass";
                    rawtext    = "ok";
                END;
            %]

            <td class="[% rawtdclass %]">
                <a href="[% dist.rawlink %]">[% rawtext %]</a>
            </td>
        [% ELSE %]
            <td class="allfail">MISSING</td>
        [% END %]



        [%
            IF dist.coverage_total + 0 == 0;
                covertdclass = "allfail";
            ELSIF dist.coverage_total + 0 == 100;
                covertdclass = "allpass";
            ELSE;
                covertdclass = "partial";
            END;
        %]

        <td class="[% covertdclass %]">
            [% IF dist.coverage_link %]
                <a href="[% dist.coverage_link %]">
            [% END %]
                    [% dist.coverage_total %]%
            [% IF dist.coverage_link %]
                </a>
            [% END %]
        </td>

        <td class="[% tdclass %]">[% dist.seen %]</td>
        <td class="[% tdclass %]">[% dist.passed %]</td>
        <td class="[% tdclass %]">[% dist.failed %]</td>
        <td class="[% tdclass %]">[% dist.todo %]</td>
        <td class="[% tdclass %]">[% dist.skipped %]</td>
        <td class="[% tdclass %]">[% dist.unexpectedly_succeeded %]</td>
        <td class="[% tdclass %]">[% dist.percentage %]</td>
        <td class="[% tdclass %]">[% dist.end_time %]</td>
    </tr>
[% END %]
</table>

[% IF errors.size > 0 %]
    <h2>Errors</h2>

    <p>There were problems.</p>

    [% FOREACH dist IN errors.keys.sort %]
        <p class="disterrorhead">[% dist %]</p>

        <ul>
        [% FOREACH error IN errors.$dist %]
            <li class="disterror">[% error %]</li>
        [% END %]
        </ul>
    [% END %]
[% END %]

<h2>Config</h2>

<pre>
<code>
[% config %]
</code>
</pre>

</body>
</html>
EOTEMPLATE

sub hook_in_dist_loop_begin {
    my ($self, $dist) = @_;
    $self->SUPER::hook_in_dist_loop_begin($dist);
    $self->print_header($dist);
}
1;
__END__