File Coverage

blib/lib/Spreadsheet/Compare/Reader/FIX.pm
Criterion Covered Total %
statement 136 146 93.1
branch 40 64 62.5
condition 15 24 62.5
subroutine 11 14 78.5
pod 2 3 66.6
total 204 251 81.2


line stmt bran cond sub pod time code
1             package Spreadsheet::Compare::Reader::FIX;
2              
3 2     2   1784 use Mojo::Base 'Spreadsheet::Compare::Reader', -signatures;
  2         5  
  2         18  
4 2     2   522 use Spreadsheet::Compare::Common;
  2         5  
  2         13  
5 2     2   16 use Spreadsheet::Compare::Record;
  2         5  
  2         26  
6              
7             #<<<
8             use Spreadsheet::Compare::Config {
9 0         0 files => sub {[]},
10 2         39 has_lines => 1,
11             record_format => undef,
12             rootdir => '.',
13             skip_before_head => 0,
14             skip_after_head => 0,
15             strip_ws => 0,
16 2     2   266 }, make_attributes => 1;
  2         6  
17              
18             has filename => undef, ro => 1;
19             has filehandle => undef, ro => 1;
20             has _chunk_data => sub { {} }, ro => 1;
21             #>>>
22              
23             my( $trace, $debug );
24              
25              
26 16     16 0 25 sub init ($self, @args) {
  16         23  
  16         26  
  16         19  
27 16         46 $self->{__ro__can_chunk} = 1;
28 16         49 return $self->SUPER::init(@args);
29             }
30              
31              
32 8     8 1 12 sub setup ($self) {
  8         15  
  8         10  
33              
34 8         25 ( $trace, $debug ) = get_log_settings();
35              
36 8   50     83 my $proot = path( $self->rootdir // '.' );
37 8         369 my $fn = path($self->files->[ $self->index ]);
38 8 50       244 my $pfull = $self->{__ro__filename} = $fn->is_absolute ? $fn : $proot->child($fn);
39              
40 8         646 INFO "opening input file >>$pfull<<";
41 8         107 $self->{__ro__filehandle} = $pfull->openr_raw;
42              
43 8         1168 $self->{_read_size} = length( pack( $self->record_format, '' ) );
44              
45 8   50     87 $self->_read_record( undef, 'skip' ) for 1 .. $self->skip_before_head // 0;
46              
47 8         122 $self->_set_header;
48              
49 8   50     28 $self->_read_record( undef, 'skip' ) for 1 .. $self->skip_after_head // 0;
50              
51 8 100       73 $self->_chunk_records() if $self->chunker;
52              
53 8         22 $self->{_sln} = 0;
54              
55 8         42 return $self;
56             }
57              
58              
59 4     4   24 sub _chunk_records ($self) {
  4         10  
  4         5  
60 4 50       13 $debug and DEBUG "chunking side $self->{index}";
61 4         10 my $skipper = $self->skipper;
62 4         22 while ( my $rec = $self->_read_record ) {
63 16 50 33     55 next if $skipper and $skipper->($rec);
64 16         82 my $cname = $self->chunker->($rec);
65 16   50     43 my $cdata = $self->_chunk_data->{$cname} //= [];
66 16         134 push @$cdata, delete( $rec->{__INFO__} );
67             }
68              
69 4 50   0   11 $debug and DEBUG "found chunks:", sub { Dump( [ sort keys $self->_chunk_data->%* ] ) };
  0         0  
70              
71 4         14 my $fh = $self->filehandle;
72 4         43 seek( $fh, 0, 0 );
73 4         12 return $self;
74             }
75              
76              
77 20     20 1 31 sub fetch ( $self, $size ) {
  20         37  
  20         37  
  20         29  
78              
79 20         55 my $result = $self->result;
80 20         97 my $fn = $self->filename;
81 20         68 my $count = 0;
82              
83 20 100       53 if ( $self->chunker ) {
84 16         79 my $cdata = $self->_chunk_data;
85 16         95 my $cname = ( sort keys %$cdata )[0];
86 16         35 my $chunk = delete $cdata->{$cname};
87 16 100       41 $self->{__ro__exhausted} = 1 unless keys %$cdata;
88 16 50       42 $debug and DEBUG "Fetching data for chunk $cname";
89 16         33 for my $rec_info (@$chunk) {
90 16 50       36 if ( my $rec = $self->_read_record($rec_info) ) {
91 16         29 push @$result, $rec;
92 16         55 $count++;
93             }
94             }
95             }
96             else {
97 4 50       21 $debug and DEBUG "fetching max $size records";
98              
99 4         8 my $i = 0;
100 4         12 my $fh = $self->filehandle;
101 4         41 my $skipper = $self->skipper;
102 4         25 while ( ++$i <= $size ) {
103 20         49 my $rec = $self->_read_record();
104 20 100       52 unless ($rec) {
105 4 50       9 $debug and DEBUG "EOF for '$fn'";
106 4         11 $self->{__ro__exhausted} = 1;
107 4         8 last;
108             }
109 16 50 33     52 next if $skipper and $skipper->($rec);
110 16         78 push @$result, $rec;
111 16         50 $count++;
112             }
113              
114 4 50       13 if ( $size == ~0 ) {
115 4         21 @$result = sort { $a->id cmp $b->id } @$result;
  16         93  
116             }
117             }
118              
119 20 50       73 $debug and DEBUG "fetched $count records";
120              
121 20         49 return $count;
122             }
123              
124              
125 8     8   13 sub _set_header ($self) {
  8         16  
  8         13  
126 8         23 my $fh = $self->filehandle;
127 8         43 my $start_pos = tell($fh);
128              
129 8         29 my $rec = $self->_read_record;
130              
131 8 50   0   61 $debug and DEBUG "setting header from record:", sub { Dump($rec) };
  0         0  
132 8 50       30 if ( $self->has_header ) {
133 0         0 $self->{__ro__header} = $rec;
134             }
135             else {
136 8         56 $self->{__ro__header} = [ 0 .. $#$rec ];
137 8         102 seek( $fh, $start_pos, 0 );
138             }
139 8         38 return $self;
140             }
141              
142              
143 64     64   99 sub _read_record ( $self, $rec_info = undef, $skip = undef ) {
  64         119  
  64         109  
  64         96  
  64         83  
144              
145 64         145 my $fh = $self->filehandle;
146 64         284 my $fn = $self->filename;
147              
148 64         351 my $line;
149             my $pos;
150 64         0 my $len;
151 64         0 my $sln;
152 64         0 my $rcount;
153 64 100       126 if ($rec_info) {
154 16         216 seek( $fh, $rec_info->{pos}, 0 );
155 16         175 $rcount = read( $fh, $line, $rec_info->{len} );
156 16 50       47 LOGDIE "Error reading data from '$fn', $!" unless defined $rcount;
157 16         30 $sln = $rec_info->{sln};
158             }
159             else {
160 48         92 $pos = tell($fh);
161 48 50       96 if ( $self->has_lines ) {
162 48         1754 $line = <$fh>;
163 48 100       137 $rcount = length($line) if defined $line;
164 48 50 66     289 LOGDIE "Error reading data from '$fn', $!"
165             if not eof($fh)
166             and not defined $rcount;
167             }
168             else {
169 0         0 $rcount = read( $fh, $line, $self->{_read_size} );
170 0 0       0 LOGDIE "Error reading data from '$fn', $!" unless defined $rcount;
171             }
172 48         107 $len = length($line);
173 48         109 $sln = ++$self->{_sln};
174             }
175              
176 64   100     172 $self->{read_bytes} += $rcount // 0;
177 64 50       152 return if $skip;
178              
179 64   100     139 $line //= '';
180 64         105 chomp($line);
181 64 100       283 return unless $line =~ /\w/;
182              
183 56 50       109 $trace and TRACE "got line >>$line<<";
184              
185 56         164 my @rec = unpack( $self->record_format, $line );
186              
187 56 50       471 if ( $self->strip_ws ) {
188 0         0 do { s/^\s+//; s/\s+$// }
  0         0  
189 0         0 for @rec;
190             }
191              
192             # when we are reading the header return the arrayref
193 56 100       346 return \@rec unless $self->header;
194              
195             # else construct record
196 48 50   0   212 $trace and TRACE "record array: ", sub { Dump( \@rec ) };
  0         0  
197 48         193 my $robj = Spreadsheet::Compare::Record->new(
198             rec => \@rec,
199             reader => $self,
200             );
201 48 50       112 $trace and TRACE "record id: ", $robj->id;
202              
203             #<<<
204             $robj->{__INFO__} = {
205 48 100 100     106 pos => $pos,
206             len => $len,
207             sln => $sln,
208             } if $self->chunker and not $rec_info;
209             #>>>
210              
211 48         381 return $robj;
212             }
213              
214              
215 8     8   6623 sub DESTROY ( $self, @ ) {
  8         16  
  8         11  
216 8 50       24 close( $self->filehandle ) if $self->filehandle;
217 8         230 return;
218             }
219              
220              
221             1;
222              
223              
224             =head1 NAME
225              
226             Spreadsheet::Compare::Reader::FIX - Fixed-Width File Adapter for Spreadsheet::Compare
227              
228             =head1 DESCRIPTION
229              
230             This module provides a fetch interface for reading records from files with fixed width columns.
231              
232             =head1 ATTRIBUTES
233              
234             L<Spreadsheet::Compare::Reader::FIX> implements the following attributes.
235              
236             =head2 filehandle
237              
238             (B<readonly>) The filehandle for L</filename>.
239              
240             =head2 filename
241              
242             (B<readonly>) The filename of the used input file for this reader. Use L</files> for
243             filename specification.
244              
245             =head2 files
246              
247             possible values: <list of exactly 2 files>
248             default: undef
249              
250             Example:
251              
252             files:
253             - ./left_dir/data.fix
254             - ./right_dir/data.fix
255              
256             Relative filenames will be interpreted releative to L</rootdir>
257              
258             =head2 has_lines
259              
260             possible values: <bool>
261             default: 0
262              
263             Indicate that the input file has newline characters at the end of each record.
264              
265             =head2 record_format
266              
267             possible values: <perl unpack string>
268             default: ''
269              
270             Example:
271              
272             record_format: 'A3A5A25A31A20A20A3A1A8A8'
273              
274             A perl unpack string to split the record into a list of values.
275              
276             =head2 rootdir
277              
278             Set by L<Spreadsheet::Compare> during reader initialisation.
279             Same as L<Spreadsheet::Compare/rootdir>.
280              
281             =head2 skip_after_head
282              
283             possible values: <integer>
284             default: 0
285              
286             Number of lines to skip after reading the header line.
287              
288             =head2 skip_before_head
289              
290             possible values: <integer>
291             default: 0
292              
293             Number of lines to skip at the beginning of the files before reading the
294             header line.
295              
296              
297             =head1 METHODS
298              
299             L<Spreadsheet::Compare::Reader::FIX> inherits or overwrites all methods from L<Spreadsheet::Compare::Reader>.
300              
301             =cut