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


line stmt bran cond sub pod time code
1             package Fennec::Collector;
2 139     139   810 use strict;
  139         205  
  139         4522  
3 139     139   669 use warnings;
  139         243  
  139         3529  
4              
5 139     139   629 use Carp qw/confess/;
  139         1191  
  139         7436  
6 139     139   2580 use Fennec::Util qw/accessors require_module/;
  139         261  
  139         832  
7 139     139   275509 use File::Temp qw/tempfile/;
  139         4493440  
  139         147132  
8              
9             accessors qw/test_count test_failed debug_data/;
10              
11 0     0 1 0 sub ok { confess "Must override ok" }
12 0     0 1 0 sub diag { confess "Must override diag" }
13 0     0 1 0 sub end_pid { confess "Must override end_pid" }
14 0     0 1 0 sub collect { confess "Must override collect" }
15              
16 0     0 1 0 sub init { }
17              
18             sub new {
19 139     139 1 368 my $class = shift;
20 139         322 my %params = @_;
21 139         549 my $self = bless \%params, $class;
22              
23 139         1392 $self->debug_data([]);
24 139         1342 $self->init;
25              
26 139         7656 return $self;
27             }
28              
29             sub inc_test_count {
30 3326     3326 1 4793 my $self = shift;
31 3326   100     34054 my $count = $self->test_count || 0;
32 3326         11203 $self->test_count( $count + 1 );
33             }
34              
35             sub inc_test_failed {
36 0     0 1 0 my $self = shift;
37 0   0     0 my $count = $self->test_failed || 0;
38 0         0 $self->test_failed( $count + 1 );
39             }
40              
41             sub debug {
42 0     0 0 0 my $self = shift;
43 0         0 my ($msg) = @_;
44 0         0 my ($action, $data) = $msg =~ m/^ ?# ?FENNEC_DEBUG_(MOCK|BLOCK|CUSTOM):(.*)$/;
45              
46 0         0 my $set = { ACTION => $action };
47              
48 0         0 for my $field (split "\0", $data) {
49 0         0 my ($key, $val) = $field =~ m/([^:]+):(.*)/;
50 0         0 $set->{lc($key)} = $val;
51             }
52              
53 0         0 push @{$self->debug_data} => $set;
  0         0  
54             }
55              
56             sub finish {
57 22     22 1 95 my $self = shift;
58 22 50       65 return unless @{$self->debug_data};
  22         263  
59 0   0       my @data = sort { return $a->{sec} <=> $b->{sec} || $a->{msec} <=> $b->{msec} }
  0            
60 0           @{ $self->debug_data };
61              
62 0           my $index = 0;
63 0           my $map = { $$ => $index++ };
64              
65 0           my @out;
66              
67 0           for my $item (@data) {
68 0 0         $map->{$item->{pid}} = $index++ unless defined $map->{$item->{pid}};
69 0           my $idx = $map->{$item->{pid}};
70 0 0         if ($item->{ACTION} eq 'MOCK') {
    0          
71 0           push @out => [ $idx, "MOCK $item->{class} => ($item->{overrides})" ];
72             }
73             elsif ($item->{ACTION} eq 'BLOCK') {
74 0           push @out => [ $idx, "BLOCK $item->{start_line}\->$item->{end_line} $item->{type}: $item->{name} ($item->{state})" ];
75             }
76             else {
77 0           push @out => [ $idx, "CUSTOM: $item->{message}" ];
78             }
79             }
80              
81 0           my @pids = sort { $map->{$a} <=> $map->{$b} } keys %$map;
  0            
82 0           my ($fh, $filename) = tempfile( CLEANUP => 0 );
83              
84 0           print $fh join "," => @pids;
85 0           print $fh "\n";
86 0           for my $row (@out) {
87 0           print $fh " ," x $row->[0];
88 0           print $fh $row->[1];
89 0           print $fh ", " x ($index - $row->[0]);
90 0           print $fh "\n";
91             }
92              
93 0           close($fh);
94              
95 0           print "# See $filename for process debugging\n";
96 0           print "# Try column -s, -t < '$filename' | less -#2 -S\n";
97             }
98              
99             1;
100              
101             __END__