File Coverage

blib/lib/Test/Count.pm
Criterion Covered Total %
statement 55 56 98.2
branch 19 22 86.3
condition 2 3 66.6
subroutine 9 9 100.0
pod 1 1 100.0
total 86 91 94.5


line stmt bran cond sub pod time code
1             package Test::Count;
2             $Test::Count::VERSION = '0.1105';
3 3     3   81875 use warnings;
  3         15  
  3         95  
4 3     3   15 use strict;
  3         4  
  3         60  
5              
6 3     3   436 use parent 'Test::Count::Base';
  3         277  
  3         17  
7              
8 3     3   1391 use Test::Count::Parser ();
  3         10  
  3         1866  
9              
10             sub _in_fh
11             {
12 39     39   67 my $self = shift;
13 39 100       108 if (@_)
14             {
15 13         38 $self->{'_in_fh'} = shift;
16             }
17 39         1057 return $self->{'_in_fh'};
18             }
19              
20             sub _assert_prefix_regex
21             {
22 26     26   51 my $self = shift;
23 26 100       80 if (@_)
24             {
25 13         27 $self->{'_assert_prefix_regex'} = shift;
26             }
27 26         63 return $self->{'_assert_prefix_regex'};
28             }
29              
30             sub _filename
31             {
32 19     19   41 my $self = shift;
33 19 100       67 if (@_)
34             {
35 3         8 $self->{'_filename'} = shift;
36             }
37 19         212 return $self->{'_filename'};
38             }
39              
40             sub _init
41             {
42 13     13   31 my $self = shift;
43 13         25 my $args = shift;
44              
45 13         22 my $in;
46              
47 13 100       47 if ( exists( $args->{'filename'} ) )
48             {
49 3         11 $self->_filename( $args->{'filename'} );
50 3 50       50 open $in, "<:raw", $self->_filename()
51             or die "Could not open '" . $self->_filename() . "' - $!.";
52             }
53             else
54             {
55 10         23 $in = $args->{'input_fh'};
56             }
57              
58 13         58 $self->_in_fh($in);
59 13 100       33 if ( exists( $args->{'assert_prefix_regex'} ) )
60             {
61 1         5 my $re = $args->{'assert_prefix_regex'};
62 1 50       6 $self->_assert_prefix_regex( ( ref($re) eq "" ) ? qr{$re} : $re );
63             }
64             else
65             {
66 12         75 $self->_assert_prefix_regex(qr{# TEST});
67             }
68              
69 13         35 return 0;
70             }
71              
72              
73             sub process
74             {
75 13     13 1 45 my $self = shift;
76 13         26 my $args = shift;
77              
78 13   66     95 my $parser = $args->{parser} || Test::Count::Parser->new();
79              
80 13         73 $parser->_push_current_filename( $self->_filename );
81              
82 13         53 my $assert_re = $self->_assert_prefix_regex();
83              
84 13         49 my @file_lines = readline( $self->_in_fh() );
85 13         3671 close( $self->_in_fh() );
86              
87 13         136 foreach my $idx ( 0 .. $#file_lines )
88             {
89 453         205727 my $line = $file_lines[$idx];
90              
91 453         635 chomp($line);
92 453 100       2529 if ( $line =~ /${assert_re}:(.*)$/ )
    100          
93             {
94 28         199 $parser->update_assignments(
95             {
96             'text' => $1,
97             }
98             );
99             }
100              
101             # The \s* is to handle trailing whitespace properly.
102             elsif ( $line =~ /${assert_re}((?:[+*].*)?)\s*$/ )
103             {
104 40         121 my $s = $1;
105 40 100       271 $parser->update_count(
106             {
107             'text' => ( ( $s eq "" ) ? 1 : substr( $s, 1 ) ),
108             }
109             );
110             }
111             }
112 13         92 $parser->_pop_current_filenames();
113 13 50       21 if ( @{ $parser->_parser->{filter_mults} } != 1 )
  13         44  
114             {
115 0         0 die "Unbalanced FILTER() and ENDFILTER().";
116             }
117              
118 13         74 return { 'tests_count' => $parser->get_count(), 'lines' => \@file_lines, };
119             }
120              
121              
122             1; # End of Test::Count
123              
124             __END__