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.25";
4              
5 43     43   1475480 use strict;
  43         309  
  43         880  
6 43     43   156 use warnings;
  43         62  
  43         866  
7              
8 43     43   1909 use Test::More;
  43         178833  
  43         205  
9 43     43   22082 use App::RecordStream::InputStream;
  43         157  
  43         1252  
10 43     43   215 use App::RecordStream::OutputStream;
  43         59  
  43         718  
11 43     43   154 use Carp qw(croak);
  43         66  
  43         37659  
12              
13             sub import {
14 43     43   350 my $class = shift;
15              
16 43         13394 require App::RecordStream::OptionalRequire;
17 43         101 local $App::RecordStream::OptionalRequire::PRINT_WARNING = 0;
18              
19 43         2328 for my $op (@_) {
20 4 50       29 croak "invalid package name: '$op'"
21             unless $op =~ /^[a-z0-9_]+$/;
22 4 50       197 if (not eval "require App::RecordStream::Operation::$op; 1;") {
23 4 50       19 if ($@ =~ /Please install missing modules/) {
24 4         19 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 356 my $class = shift;
34 159         600 my %args = @_;
35              
36             my $this = {
37             INPUT => create_stream($args{'input'}),
38             OUTPUT => create_stream($args{'output'}),
39             OPERATION => $args{'operation'},
40 159         446 KEEPER => $args{'keeper'},
41             };
42              
43 159         465 bless $this, $class;
44              
45 159         331 return $this;
46             }
47              
48             sub create_stream {
49 318     318 0 475 my $input = shift;
50              
51 318 100       699 return undef unless ( $input );
52 256 100       553 return $input if ( ref($input) eq 'ARRAY' );
53              
54 235 50       1521 if ( UNIVERSAL::isa($input, 'App::RecordStream::InputStream') ) {
55 0         0 return $input;
56             }
57              
58 235 50 66     921 if ( (not ($input =~ m/\n/m)) && -e $input ) {
59 0         0 return App::RecordStream::InputStream->new(FILE => $input);
60             }
61              
62 235         740 return App::RecordStream::InputStream->new(STRING => $input);
63             }
64              
65             sub matches {
66 158     158 0 217 my $this = shift;
67 158   50     513 my $name = shift || 'unnamed';
68              
69 158         377 my $op = $this->{'OPERATION'};
70 158         315 my $input = $this->{'INPUT'};
71              
72 158 100 100     439 if ( $op->wants_input() && $input ) {
73 139 100       467 if ( ref($input) eq 'ARRAY' ) {
74 21         76 my ($t, @v) = @$input;
75 21 100       45 if ( $t eq 'LINES' ) {
    50          
76 16         31 for my $l (@v) {
77 64 50       185 if ( ! $op->accept_line($l) ) {
78 0         0 last;
79             }
80             }
81             }
82             elsif ( $t eq 'FILES' ) {
83 5         40 local @ARGV = @v;
84 5         266 while(my $l = <>) {
85 22         79 App::RecordStream::Operation::set_current_filename($ARGV);
86 22         65 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         347 App::RecordStream::Operation::set_current_filename($input->get_filename());
98 118         375 while ( my $r = $input->get_record() ) {
99 792 100       1513 if ( ! $op->accept_record($r) ) {
100 4         7 last;
101             }
102             }
103             }
104             }
105 156         588 $op->finish();
106              
107 154         241 my $output = $this->{'OUTPUT'};
108 154         364 my $results = $this->{'KEEPER'}->get_records();
109 154         222 my $i = 0;
110              
111             #ok(0, "DIE");
112 154         214 my @output_records;
113 154 100       333 if ( $output ) {
114 117         281 while ( my $record = $output->get_record() ) {
115 423         932 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         1037 my ($level_to_testfile, $file) = (0, (caller(0))[1]);
122 154   66     846 while (defined $file and $file !~ /\.t$/) {
123 185         471 $level_to_testfile++;
124 185         1326 $file = (caller($level_to_testfile))[1];
125             }
126              
127 154         373 local $Test::Builder::Level = $Test::Builder::Level + $level_to_testfile + 1;
128              
129 154         220 my $is_ok = 1;
130 154         329 for my $record (@$results) {
131 423 50       81373 $is_ok = 0 if ( ! ok(UNIVERSAL::isa($record, 'App::RecordStream::Record'), "Record is a App::RecordStream::Record") );
132             }
133              
134 154 50       28755 $is_ok = 0 if ( ! is_deeply($results, \@output_records, "Records match: $name") );
135              
136 154 50       148293 $is_ok = 0 if ( ! ok($this->{'KEEPER'}->has_called_finish(), "Has called finish: $name") );
137              
138 154 50       36801 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         653 return $is_ok;
150             }
151              
152             sub do_match {
153 121     121 0 6421 my $class = shift;
154 121         220 my $operation_name = shift;
155 121         181 my $args = shift;
156 121         188 my $input = shift;
157 121         177 my $output = shift;
158              
159 121         255 my $operation_class = "App::RecordStream::Operation::$operation_name";
160 121         599 my $keeper = App::RecordStream::Test::OperationHelper::Keeper->new();
161 121         751 my $op = $operation_class->new($args, $keeper);
162              
163 121 100 100     445 if ( $op->wants_input() && @$args ) {
164 5 50       13 if ( $input ) {
165 0         0 fail("Both extra args [" . join(", ", @$args) . "] and input provided?");
166             }
167             else {
168 5         13 $input = ['FILES', @$args];
169             }
170             }
171              
172 121         455 ok($op, "Operation initialization");
173              
174 121         39686 my $helper = $class->new(
175             operation => $op,
176             keeper => $keeper,
177             input => $input,
178             output => $output,
179             );
180              
181 121         355 $helper->matches();
182              
183 117         665 return $helper;
184             }
185              
186             sub test_output {
187 37     37 0 7636 my $class = shift;
188 37         65 my $operation_name = shift;
189 37         54 my $args = shift;
190 37         48 my $input = shift;
191 37         48 my $output = shift;
192              
193 37         84 my $operation_class = "App::RecordStream::Operation::$operation_name";
194 37         161 my $keeper = App::RecordStream::Test::OperationHelper::Keeper->new();
195 37         203 my $op = $operation_class->new($args, $keeper);
196              
197 37         110 ok($op, "Object initialization");
198              
199 37         10104 my $helper = __PACKAGE__->new(
200             operation => $op,
201             keeper => $keeper,
202             input => $input,
203             output => '',
204             );
205              
206 37         105 $helper->matches();
207              
208 37         55 is(join ('', map { "$_\n" } @{$keeper->get_lines()}), $output, "Output matches expected");
  452         777  
  37         80  
209             }
210              
211              
212             package App::RecordStream::Test::OperationHelper::Keeper;
213              
214 43     43   285 use base qw(App::RecordStream::Stream::Base);
  43         62  
  43         10094  
215              
216             sub new {
217 159     159   456 my $class = shift;
218 159         426 my $this = { RECORDS => [], LINES => [] };
219 159         284 bless $this, $class;
220 159         275 return $this;
221             }
222              
223             sub accept_record {
224 426     426   590 my $this = shift;
225 426         478 my $record = shift;
226              
227 426         485 push @{$this->{'RECORDS'}}, $record;
  426         862  
228              
229 426         1417 return 1;
230             }
231              
232             sub get_records {
233 154     154   215 my $this = shift;
234 154         241 return $this->{'RECORDS'};
235             }
236              
237             sub accept_line {
238 458     458   491 my $this = shift;
239 458         437 my $line = shift;
240              
241 458         537 push @{$this->{'LINES'}}, $line;
  458         746  
242              
243 458         996 return 1;
244             }
245              
246             sub get_lines {
247 38     38   56 my $this = shift;
248 38         81 return $this->{'LINES'};
249             }
250              
251             sub has_called_finish {
252 154     154   286 my $this = shift;
253 154         515 return $this->{'CALLED_FINISH'};
254             }
255              
256             sub finish {
257 155     155   231 my $this = shift;
258 155         316 $this->{'CALLED_FINISH'} = 1;
259             }
260              
261             1;