File Coverage

blib/lib/App/RecordStream/Test/OperationHelper.pm
Criterion Covered Total %
statement 130 143 90.9
branch 29 42 69.0
condition 11 14 78.5
subroutine 20 20 100.0
pod 0 5 0.0
total 190 224 84.8


line stmt bran cond sub pod time code
1             package App::RecordStream::Test::OperationHelper;
2              
3             our $VERSION = "4.0.23";
4              
5 43     43   518795 use strict;
  43         114  
  43         1206  
6 43     43   237 use warnings;
  43         102  
  43         1136  
7              
8 43     43   2358 use Test::More;
  43         55197  
  43         241  
9 43     43   25646 use App::RecordStream::InputStream;
  43         153  
  43         1387  
10 43     43   354 use App::RecordStream::OutputStream;
  43         99  
  43         964  
11 43     43   227 use Carp qw(croak);
  43         99  
  43         42636  
12              
13             sub import {
14 43     43   451 my $class = shift;
15              
16 43         15851 require App::RecordStream::OptionalRequire;
17 43         150 local $App::RecordStream::OptionalRequire::PRINT_WARNING = 0;
18              
19 43         2607 for my $op (@_) {
20 4 50       33 croak "invalid package name: '$op'"
21             unless $op =~ /^[a-z0-9_]+$/;
22 4 50       239 if (not eval "require App::RecordStream::Operation::$op; 1;") {
23 4 50       24 if ($@ =~ /Please install missing modules/) {
24 4         25 plan skip_all => "Missing deps for operation $op";
25             } else {
26 0         0 die $@;
27             }
28             }
29             }
30             }
31              
32             sub new {
33 159     159 0 591 my $class = shift;
34 159         813 my %args = @_;
35              
36             my $this = {
37             INPUT => create_stream($args{'input'}),
38             OUTPUT => create_stream($args{'output'}),
39             OPERATION => $args{'operation'},
40 159         654 KEEPER => $args{'keeper'},
41             };
42              
43 159         591 bless $this, $class;
44              
45 159         451 return $this;
46             }
47              
48             sub create_stream {
49 318     318 0 649 my $input = shift;
50              
51 318 100       1043 return undef unless ( $input );
52 256 100       900 return $input if ( ref($input) eq 'ARRAY' );
53              
54 235 50       2069 if ( UNIVERSAL::isa($input, 'App::RecordStream::InputStream') ) {
55 0         0 return $input;
56             }
57              
58 235 50 66     1230 if ( (not ($input =~ m/\n/m)) && -e $input ) {
59 0         0 return App::RecordStream::InputStream->new(FILE => $input);
60             }
61              
62 235         979 return App::RecordStream::InputStream->new(STRING => $input);
63             }
64              
65             sub matches {
66 158     158 0 331 my $this = shift;
67 158   50     782 my $name = shift || 'unnamed';
68              
69 158         464 my $op = $this->{'OPERATION'};
70 158         335 my $input = $this->{'INPUT'};
71              
72 158 100 100     620 if ( $op->wants_input() && $input ) {
73 139 100       461 if ( ref($input) eq 'ARRAY' ) {
74 21         76 my ($t, @v) = @$input;
75 21 100       71 if ( $t eq 'LINES' ) {
    50          
76 16         39 for my $l (@v) {
77 64 50       198 if ( ! $op->accept_line($l) ) {
78 0         0 last;
79             }
80             }
81             }
82             elsif ( $t eq 'FILES' ) {
83 5         51 local @ARGV = @v;
84 5         312 while(my $l = <>) {
85 22         90 App::RecordStream::Operation::set_current_filename($ARGV);
86 22         42 chomp $l;
87 22 50       79 if ( ! $op->accept_line($l) ) {
88 0         0 last;
89             }
90             }
91             }
92             else {
93 0         0 die;
94             }
95             }
96             else {
97 118         472 App::RecordStream::Operation::set_current_filename($input->get_filename());
98 118         411 while ( my $r = $input->get_record() ) {
99 792 100       2275 if ( ! $op->accept_record($r) ) {
100 4         10 last;
101             }
102             }
103             }
104             }
105 156         787 $op->finish();
106              
107 154         356 my $output = $this->{'OUTPUT'};
108 154         524 my $results = $this->{'KEEPER'}->get_records();
109 154         310 my $i = 0;
110              
111             #ok(0, "DIE");
112 154         293 my @output_records;
113 154 100       762 if ( $output ) {
114 117         396 while ( my $record = $output->get_record() ) {
115 423         1311 push @output_records, $record;
116             }
117             }
118              
119             # Find the call level of the originating test file for better diagnostic
120             # reporting if we fail tests below
121 154         1359 my ($level_to_testfile, $file) = (0, (caller(0))[1]);
122 154   66     1112 while (defined $file and $file !~ /\.t$/) {
123 185         344 $level_to_testfile++;
124 185         1744 $file = (caller($level_to_testfile))[1];
125             }
126              
127 154         423 local $Test::Builder::Level = $Test::Builder::Level + $level_to_testfile + 1;
128              
129 154         325 my $is_ok = 1;
130 154         385 for my $record (@$results) {
131 423 50       125900 $is_ok = 0 if ( ! ok(UNIVERSAL::isa($record, 'App::RecordStream::Record'), "Record is a App::RecordStream::Record") );
132             }
133              
134 154 50       44637 $is_ok = 0 if ( ! is_deeply($results, \@output_records, "Records match: $name") );
135              
136 154 50       275782 $is_ok = 0 if ( ! ok($this->{'KEEPER'}->has_called_finish(), "Has called finish: $name") );
137              
138 154 50       58406 if ( ! $is_ok ) {
139 0         0 warn "Expected and output differed!\nExpected:\n";
140 0         0 for my $record (@output_records) {
141 0         0 print STDERR App::RecordStream::OutputStream::hashref_string($record) . "\n";
142             }
143 0         0 warn "Output from module:\n";
144 0         0 for my $record (@$results) {
145 0         0 print STDERR App::RecordStream::OutputStream::hashref_string($record) . "\n";
146             }
147             }
148              
149 154         1796 return $is_ok;
150             }
151              
152             sub do_match {
153 121     121 0 7599 my $class = shift;
154 121         265 my $operation_name = shift;
155 121         239 my $args = shift;
156 121         245 my $input = shift;
157 121         241 my $output = shift;
158              
159 121         338 my $operation_class = "App::RecordStream::Operation::$operation_name";
160 121         761 my $keeper = App::RecordStream::Test::OperationHelper::Keeper->new();
161 121         943 my $op = $operation_class->new($args, $keeper);
162              
163 121 100 100     573 if ( $op->wants_input() && @$args ) {
164 5 50       17 if ( $input ) {
165 0         0 fail("Both extra args [" . join(", ", @$args) . "] and input provided?");
166             }
167             else {
168 5         17 $input = ['FILES', @$args];
169             }
170             }
171              
172 121         571 ok($op, "Operation initialization");
173              
174 121         58924 my $helper = $class->new(
175             operation => $op,
176             keeper => $keeper,
177             input => $input,
178             output => $output,
179             );
180              
181 121         420 $helper->matches();
182              
183 117         956 return $helper;
184             }
185              
186             sub test_output {
187 37     37 0 11122 my $class = shift;
188 37         86 my $operation_name = shift;
189 37         76 my $args = shift;
190 37         78 my $input = shift;
191 37         69 my $output = shift;
192              
193 37         106 my $operation_class = "App::RecordStream::Operation::$operation_name";
194 37         235 my $keeper = App::RecordStream::Test::OperationHelper::Keeper->new();
195 37         293 my $op = $operation_class->new($args, $keeper);
196              
197 37         166 ok($op, "Object initialization");
198              
199 37         15800 my $helper = __PACKAGE__->new(
200             operation => $op,
201             keeper => $keeper,
202             input => $input,
203             output => '',
204             );
205              
206 37         158 $helper->matches();
207              
208 37         79 is(join ('', map { "$_\n" } @{$keeper->get_lines()}), $output, "Output matches expected");
  452         1084  
  37         128  
209             }
210              
211              
212             package App::RecordStream::Test::OperationHelper::Keeper;
213              
214 43     43   360 use base qw(App::RecordStream::Stream::Base);
  43         113  
  43         10880  
215              
216             sub new {
217 159     159   507 my $class = shift;
218 159         568 my $this = { RECORDS => [], LINES => [] };
219 159         423 bless $this, $class;
220 159         401 return $this;
221             }
222              
223             sub accept_record {
224 426     426   833 my $this = shift;
225 426         700 my $record = shift;
226              
227 426         731 push @{$this->{'RECORDS'}}, $record;
  426         1120  
228              
229 426         1753 return 1;
230             }
231              
232             sub get_records {
233 154     154   312 my $this = shift;
234 154         339 return $this->{'RECORDS'};
235             }
236              
237             sub accept_line {
238 458     458   734 my $this = shift;
239 458         704 my $line = shift;
240              
241 458         733 push @{$this->{'LINES'}}, $line;
  458         1053  
242              
243 458         1447 return 1;
244             }
245              
246             sub get_lines {
247 38     38   83 my $this = shift;
248 38         119 return $this->{'LINES'};
249             }
250              
251             sub has_called_finish {
252 154     154   351 my $this = shift;
253 154         835 return $this->{'CALLED_FINISH'};
254             }
255              
256             sub finish {
257 155     155   315 my $this = shift;
258 155         414 $this->{'CALLED_FINISH'} = 1;
259             }
260              
261             1;