File Coverage

blib/lib/Test/Count/FileMutator.pm
Criterion Covered Total %
statement 52 62 83.8
branch 9 12 75.0
condition 1 3 33.3
subroutine 10 14 71.4
pod 4 4 100.0
total 76 95 80.0


line stmt bran cond sub pod time code
1             package Test::Count::FileMutator;
2             $Test::Count::FileMutator::VERSION = '0.1105';
3 1     1   85480 use warnings;
  1         10  
  1         32  
4 1     1   4 use strict;
  1         2  
  1         18  
5              
6 1     1   4 use parent 'Test::Count::Base';
  1         1  
  1         5  
7              
8 1     1   355 use Test::Count ();
  1         3  
  1         24  
9 1     1   507 use Test::Count::Lib ();
  1         2  
  1         467  
10              
11              
12             sub _counter
13             {
14 4     4   6 my $self = shift;
15 4 100       9 if (@_)
16             {
17 2         5 $self->{'_counter'} = shift;
18             }
19 4         9 return $self->{'_counter'};
20             }
21              
22             sub _filename
23             {
24 4     4   7 my $self = shift;
25 4 100       10 if (@_)
26             {
27 2         5 $self->{'_filename'} = shift;
28             }
29 4         262 return $self->{'_filename'};
30             }
31              
32             sub _plan_prefix_regex
33             {
34 4     4   8 my $self = shift;
35 4 100       13 if (@_)
36             {
37 2         7 $self->{'_plan_prefix_regex'} = shift;
38             }
39 4         8 return $self->{'_plan_prefix_regex'};
40             }
41              
42             sub _assert_prefix_regex
43             {
44 0     0   0 my $self = shift;
45 0 0       0 if (@_)
46             {
47 0         0 $self->{'_assert_prefix_regex'} = shift;
48             }
49 0         0 return $self->{'_assert_prefix_regex'};
50             }
51              
52              
53             sub _init
54             {
55 2     2   5 my $self = shift;
56 2         3 my $args = shift;
57              
58 2   33     17 $args->{plan_prefix_regex} ||= Test::Count::Lib::perl_plan_prefix_regex();
59              
60             # Remmed out because Test::Count handles it by itself.
61             # if (defined($args->{assert_prefix_regex}))
62             # {
63             # $self->_assert_prefix_regex($args->{assert_prefix_regex});
64             # }
65 2         7 $self->_plan_prefix_regex( $args->{plan_prefix_regex} );
66 2         8 $self->_filename( $args->{filename} );
67              
68 2         14 $self->_counter( Test::Count->new($args) );
69              
70 2         2 return 0;
71             }
72              
73              
74             sub modify
75             {
76 2     2 1 9 my $self = shift;
77              
78 2         6 my $ret = $self->_counter()->process();
79              
80 2         824 my $count = $ret->{tests_count};
81              
82 2         11 my $plan_re = $self->_plan_prefix_regex();
83              
84 2         4 my @lines = @{ $ret->{lines} };
  2         18  
85              
86 2 50       18 open my $out_fh, ">:raw", $self->_filename()
87             or die "Could not open file '"
88             . $self->_filename()
89             . "' for writing - $!.";
90             LINES_LOOP:
91 2         21 while ( my $l = shift(@lines) )
92             {
93 14 100       86 if ( $l =~ s{^($plan_re)\d+}{$1$count} )
94             {
95 2         4 print {$out_fh} $l;
  2         5  
96 2         6 last LINES_LOOP;
97             }
98             else
99             {
100 12         19 print {$out_fh} $l;
  12         110  
101             }
102             }
103 2         4 print {$out_fh} @lines;
  2         6  
104              
105 2         231 close($out_fh);
106 2         37 return 0;
107             }
108              
109              
110             sub update_assignments
111             {
112 0     0 1   my ( $self, $args ) = @_;
113              
114 0           return $self->_parser()->assignments( $args->{text} );
115             }
116              
117              
118             sub update_count
119             {
120 0     0 1   my ( $self, $args ) = @_;
121              
122 0           return $self->_parser()->update_count( $args->{text} );
123             }
124              
125              
126             sub get_count
127             {
128 0     0 1   my $self = shift;
129              
130 0           return $self->_parser()->{count};
131             }
132              
133              
134             1; # End of Test::Count::Parser
135              
136             __END__