File Coverage

blib/lib/Iterator/Flex/Zip.pm
Criterion Covered Total %
statement 152 157 96.8
branch 54 72 75.0
condition 9 23 39.1
subroutine 21 21 100.0
pod 1 2 50.0
total 237 275 86.1


line stmt bran cond sub pod time code
1             package Iterator::Flex::Zip;
2              
3             # ABSTRACT: Zip Iterator Class
4              
5 3     3   297099 use v5.28;
  3         13  
6 3     3   18 use strict;
  3         7  
  3         84  
7 3     3   14 use warnings;
  3         11  
  3         216  
8 3     3   635 use experimental 'signatures', 'declared_refs';
  3         1983  
  3         27  
9              
10             our $VERSION = '0.33';
11              
12 3     3   1674 use Iterator::Flex::Factory 'to_iterator';
  3         11  
  3         287  
13 3     3   32 use Iterator::Flex::Utils qw[ THROW STATE EXHAUSTION :IterAttrs :IterStates throw_failure ];
  3         7  
  3         852  
14 3     3   22 use Ref::Util 'is_ref', 'is_hashref', 'is_blessed_ref';
  3         9  
  3         253  
15 3     3   21 use List::Util 'first';
  3         6  
  3         267  
16              
17 3     3   20 use parent 'Iterator::Flex::Base';
  3         7  
  3         29  
18              
19 3     3   443 use constant { map { $_ => lc } qw( ON_EXHAUSTION TRUNCATE THROW INSERT ) };
  3         7  
  3         8  
  12         612  
20              
21 3     3   22 use namespace::clean;
  3         7  
  3         28  
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66              
67              
68              
69              
70              
71              
72              
73              
74              
75              
76              
77              
78              
79              
80              
81              
82              
83              
84              
85              
86              
87              
88              
89              
90              
91              
92              
93              
94 13     13 1 15 sub new ( $class, @args ) {
  13         17  
  13         21  
  13         14  
95 13 100       31 my $pars = is_hashref( $args[-1] ) ? pop @args : {};
96              
97 13 50       29 throw_failure( parameter => 'not enough parameters' )
98             unless @args;
99              
100 13         19 my @iterators;
101             my @keys;
102              
103             # distinguish between ( key => iterator, key =>iterator ) and ( iterator, iterator );
104 13 100       24 if ( is_ref( $args[0] ) ) {
105 8         14 @iterators = @args;
106             }
107             else {
108 5 50       13 throw_failure( parameter => 'expected an even number of arguments' )
109             if @args % 2;
110              
111 5         9 while ( @args ) {
112 15         16 push @keys, shift @args;
113 15         23 push @iterators, shift @args;
114             }
115             }
116              
117             ## no critic (AmbiguousNames)
118 13         15 my ( @set, @insert );
119              
120 13         44 my %attr = (
121             keys => \@keys,
122             depends => \@iterators,
123             set => \@set,
124             insert => \@insert,
125             value => [],
126             );
127              
128 13 100       34 if ( defined( my $on_exhaustion = delete $pars->{ +ON_EXHAUSTION } ) ) {
129              
130 8 100 33     25 if ( is_hashref( $on_exhaustion ) ) {
    50          
131 6         12 my @ekeys = keys $on_exhaustion->%*;
132              
133 6         7 my %idx;
134 6         21 @idx{ 0 .. $#iterators } = 0 .. $#iterators;
135 6 100       33 @idx{@keys} = 0 .. $#iterators
136             if @keys;
137              
138 6         10 my @iset = @idx{@ekeys};
139              
140             throw_failure( parameter => ON_EXHAUSTION . ' illegal iterator label or index' )
141 6 50   10   23 if defined first { !defined } @iset;
  10         17  
142              
143 6         21 @set[@iset] = ( !!1 ) x @iset;
144 6         12 @insert[@iset] = $on_exhaustion->@{@ekeys};
145              
146 6         9 $attr{set} = \@set;
147 6         8 $attr{insert} = \@insert;
148 6         14 $attr{ +ON_EXHAUSTION } = INSERT;
149             }
150 4     4   9 elsif ( is_ref( $on_exhaustion ) or !first { $on_exhaustion eq $_ } TRUNCATE, THROW ) {
151 0         0 throw_failure( parameter => ON_EXHAUSTION . ": unexpected value: $on_exhaustion" );
152             }
153             else {
154 2         3 $attr{ +ON_EXHAUSTION } = $on_exhaustion;
155             }
156             }
157             else {
158 5         10 $attr{ +ON_EXHAUSTION } = TRUNCATE;
159             }
160              
161 13         50 $class->SUPER::new( \%attr, $pars );
162             }
163              
164              
165             ## no critic (ExcessComplexity)
166 13     13 0 13 sub construct ( $class, $state ) {
  13         16  
  13         15  
  13         12  
167 13 50       40 throw_failure( parameter => q{state must be a HASH reference} )
168             unless is_hashref( $state );
169              
170 13   50     27 $state->{value} //= [];
171              
172             ## no critic (AmbiguousNames)
173             my ( \@depends, \@keys, \@value, \@insert, \@set, $on_exhaustion, $thaw )
174 13         17 = @{$state}{qw[ depends keys value insert set on_exhaustion thaw ]};
  13         70  
175              
176             # transform into iterators if required.
177              
178             my @iterators
179 13         22 = map { to_iterator( $_, { ( +EXHAUSTION ) => THROW } ) } @depends;
  38         107  
180              
181 13 50 66     40 throw_failure( parameter => q{number of keys not equal to number of iterators} )
182             if @keys && @keys != @iterators;
183              
184 13 50       17 @value = map { $_->current } @iterators
  0         0  
185             if $thaw;
186              
187 13         21 my $self;
188             my $iterator_state;
189             my %params = (
190              
191             ( +_NAME ) => 'izip',
192              
193             ( +_SELF ) => \$self,
194              
195             ( +STATE ) => \$iterator_state,
196              
197              
198             ( +CURRENT ) => sub {
199 2 100   2   8 return undef if !@value;
200 1 50       2 return $self->signal_exhaustion if $iterator_state eq IterState_EXHAUSTED;
201 1 50       3 if ( @keys ) {
202 0         0 my %value;
203 0         0 @value{@keys} = @value;
204 0         0 return \%value;
205             }
206             else {
207 1         4 return [@value];
208             }
209             },
210              
211 3     3   6 ( +RESET ) => sub { @value = () },
212       1     ( +REWIND ) => sub { },
213 13         95 ( +_DEPENDS ) => \@iterators,
214             );
215              
216 13 100       34 if ( $on_exhaustion eq TRUNCATE ) {
    100          
    50          
217              
218             $params{ +NEXT } = sub {
219 26 50   26   51 return $self->signal_exhaustion if $iterator_state == IterState_EXHAUSTED;
220              
221 26         28 my @nvalue;
222              
223             eval {
224 26         37 @nvalue = map { $_->() } @iterators;
  65         177  
225 21         39 1;
226 26 100       32 } or do {
227 5 50 33     265 die $@
228             unless is_blessed_ref( $@ )
229             && $@->isa( 'Iterator::Flex::Failure::Exhausted' );
230 5         13 return $self->signal_exhaustion;
231             };
232              
233 21         34 @value = @nvalue;
234              
235 21 100       29 if ( @keys ) {
236 6         5 my %value;
237 6         13 @value{@keys} = @value;
238 6         9 return \%value;
239             }
240             else {
241 15         53 return [@value];
242             }
243 5         28 };
244             }
245              
246             elsif ( $on_exhaustion eq THROW ) {
247              
248             $params{ +NEXT } = sub {
249 8 50   8   11 return $self->signal_exhaustion if $iterator_state == IterState_EXHAUSTED;
250              
251 8         9 my @nvalue;
252              
253 8         9 my $idx = -1;
254             eval {
255             ## no critic (ComplexMappings)
256 8         8 @nvalue = map { $idx++; $_->() } @iterators;
  20         17  
  20         25  
257 6         8 1;
258 8 100       10 } or do {
259 2 50 33     59 die $@
260             unless is_blessed_ref( $@ )
261             && $@->isa( 'Iterator::Flex::Failure::Exhausted' );
262              
263             # if all of the iterators have been exhausted,
264             # then we're ok. Otherwise, find out which ones
265             # are
266              
267 2         4 my @exhausted = ( $idx );
268 2         4 while ( ++$idx < @iterators ) {
269 4 100       5 if ( !eval { $iterators[$idx]->(); 1 } ) {
  4         9  
  2         4  
270 2 50 33     41 die $@
271             unless is_blessed_ref( $@ )
272             && $@->isa( 'Iterator::Flex::Failure::Exhausted' );
273 2         5 push @exhausted, $idx;
274             }
275             }
276 2 50       4 return $self->signal_exhaustion
277             if @exhausted == @iterators;
278              
279 2 100       4 @exhausted = @keys[@exhausted]
280             if @keys;
281              
282 2         6 throw_failure( Truncated => \@exhausted );
283             };
284              
285 6         22 @value = @nvalue;
286              
287 6 100       10 if ( @keys ) {
288 3         3 my %value;
289 3         8 @value{@keys} = @value;
290 3         7 return \%value;
291             }
292             else {
293 3         6 return [@value];
294             }
295 2         7 };
296             }
297              
298             elsif ( $on_exhaustion eq INSERT ) {
299              
300 6         15 my @exhausted = ( !!0 ) x @iterators;
301 6         7 my $nexhausted = 0;
302              
303             $params{ +NEXT } = sub {
304 28 50 33 28   64 return $self->signal_exhaustion
305             if $iterator_state == IterState_EXHAUSTED
306             || $nexhausted == @iterators;
307              
308 28         29 my @nvalue;
309              
310 28         40 for my $idx ( 0 .. $#iterators ) {
311              
312 80         66 my $value;
313              
314 80 100       90 if ( $exhausted[$idx] ) {
315 4         8 $value = $insert[$idx];
316             }
317             else {
318 76 100       73 eval { $value = $iterators[$idx]->(); 1 } or do {
  76         97  
  62         75  
319 14 50 33     339 die $@
320             unless is_blessed_ref( $@ )
321             && $@->isa( 'Iterator::Flex::Failure::Exhausted' );
322              
323             # if insert value not provided for this iterator,
324             # abort
325 14 100       31 return $self->signal_exhaustion if !$set[$idx];
326              
327 8         8 $nexhausted++;
328 8         10 $exhausted[$idx] = !!1;
329 8         10 $value = $insert[$idx];
330             }
331             }
332              
333 74         111 push @nvalue, $value;
334             }
335              
336 22         32 @value = @nvalue;
337              
338 22 100       29 if ( @keys ) {
339 11         10 my %value;
340 11         20 @value{@keys} = @value;
341 11         20 return \%value;
342             }
343             else {
344 11         21 return [@value];
345             }
346 6         32 };
347             }
348              
349              
350 13         48 return \%params;
351             }
352              
353             __PACKAGE__->_add_roles( qw[
354             State::Closure
355             Next::ClosedSelf
356             Current::Closure
357             Reset::Closure
358             Rewind::Closure
359             ] );
360              
361             1;
362              
363             #
364             # This file is part of Iterator-Flex
365             #
366             # This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
367             #
368             # This is free software, licensed under:
369             #
370             # The GNU General Public License, Version 3, June 2007
371             #
372              
373             __END__