File Coverage

blib/lib/Fennec/Collector.pm

Criterion	Covered	Total	%
statement	27	70	38.5
branch	1	8	12.5
condition	2	7	28.5
subroutine	8	15	53.3
pod	9	10	90.0
total	47	110	42.7

package Fennec::Collector;
use strict;
use warnings;

use Carp qw/confess/;
use Fennec::Util qw/accessors require_module/;
use File::Temp qw/tempfile/;

accessors qw/test_count test_failed debug_data/;

sub ok      { confess "Must override ok" }
sub diag    { confess "Must override diag" }
sub end_pid { confess "Must override end_pid" }
sub collect { confess "Must override collect" }

sub init   { }

sub new {
    my $class  = shift;
    my %params = @_;
    my $self   = bless \%params, $class;

    $self->debug_data([]);
    $self->init;

    return $self;
}

sub inc_test_count {
    my $self = shift;
    my $count = $self->test_count || 0;
    $self->test_count( $count + 1 );
}

sub inc_test_failed {
    my $self = shift;
    my $count = $self->test_failed || 0;
    $self->test_failed( $count + 1 );
}

sub debug {
    my $self = shift;
    my ($msg) = @_;
    my ($action, $data) = $msg =~ m/^ ?# ?FENNEC_DEBUG_(MOCK|BLOCK|CUSTOM):(.*)$/;

    my $set = { ACTION => $action };

    for my $field (split "\0", $data) {
        my ($key, $val) = $field =~ m/([^:]+):(.*)/;
        $set->{lc($key)} = $val;
    }

    push @{$self->debug_data} => $set;
}

sub finish {
    my $self = shift;
    return unless @{$self->debug_data};
    my @data = sort { return $a->{sec} <=> $b->{sec} || $a->{msec} <=> $b->{msec} }
        @{ $self->debug_data };

    my $index = 0;
    my $map = { $$ => $index++ };

    my @out;

    for my $item (@data) {
        $map->{$item->{pid}} = $index++ unless defined $map->{$item->{pid}};
        my $idx = $map->{$item->{pid}};
        if ($item->{ACTION} eq 'MOCK') {
            push @out => [ $idx, "MOCK $item->{class} => ($item->{overrides})" ];
        }
        elsif ($item->{ACTION} eq 'BLOCK') {
            push @out => [ $idx, "BLOCK $item->{start_line}\->$item->{end_line} $item->{type}: $item->{name} ($item->{state})" ];
        }
        else {
            push @out => [ $idx, "CUSTOM: $item->{message}" ];
        }
    }

    my @pids = sort { $map->{$a} <=> $map->{$b} } keys %$map;
    my ($fh, $filename) = tempfile( CLEANUP => 0 );

    print $fh join "," => @pids;
    print $fh "\n";
    for my $row (@out) {
        print $fh " ," x $row->[0];
        print $fh $row->[1];
        print $fh ", " x ($index - $row->[0]);
        print $fh "\n";
    }

    close($fh);

    print "# See $filename for process debugging\n";
    print "# Try column -s, -t < '$filename' | less -#2 -S\n";
}

1;

__END__