File Coverage

blib/lib/Iterator/Flex/Product.pm
Criterion Covered Total %
statement 105 106 99.0
branch 30 38 78.9
condition 4 5 80.0
subroutine 18 19 94.7
pod 1 2 50.0
total 158 170 92.9


line stmt bran cond sub pod time code
1             package Iterator::Flex::Product;
2              
3             # ABSTRACT: An iterator which produces a Cartesian product of iterators
4              
5 2     2   178098 use v5.28;
  2         4  
6 2     2   9 use strict;
  2         2  
  2         36  
7 2     2   9 use warnings;
  2         2  
  2         139  
8 2     2   628 use experimental qw( signatures declared_refs refaliasing );
  2         1261  
  2         10  
9              
10             our $VERSION = '0.34';
11              
12             use Iterator::Flex::Utils
13 2     2   1259 qw( RETURN STATE EXHAUSTION :IterAttrs :IterStates can_meth throw_failure );
  2         6  
  2         570  
14 2     2   918 use Iterator::Flex::Factory 'to_iterator';
  2         4  
  2         144  
15 2     2   14 use parent 'Iterator::Flex::Base';
  2         4  
  2         18  
16 2     2   154 use Ref::Util;
  2         2  
  2         183  
17 2     2   9 use List::Util;
  2         5  
  2         104  
18              
19 2     2   11 use namespace::clean;
  2         4  
  2         12  
20              
21              
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 6     6 1 9 sub new ( $class, @args ) {
  6         10  
  6         12  
  6         8  
64 6 50       19 my $pars = Ref::Util::is_hashref( $args[-1] ) ? pop @args : {};
65              
66 6 50       15 throw_failure( parameter => 'not enough parameters' )
67             unless @args;
68              
69 6         10 my @iterators;
70             my @keys;
71              
72             # distinguish between ( key => iterator, key =>iterator ) and ( iterator, iterator );
73 6 100       13 if ( Ref::Util::is_ref( $args[0] ) ) {
74 4         8 @iterators = @args;
75             }
76             else {
77 2 50       8 throw_failure( parameter => 'expected an even number of arguments' )
78             if @args % 2;
79              
80 2         5 while ( @args ) {
81 4         8 push @keys, shift @args;
82 4         10 push @iterators, shift @args;
83             }
84             }
85              
86 6         35 $class->SUPER::new( { keys => \@keys, depends => \@iterators, value => [] }, $pars );
87             }
88              
89 8     8 0 9 sub construct ( $class, $state ) { ## no critic (ExcessComplexity)
  8         8  
  8         8  
  8         6  
90 8 50       16 throw_failure( parameter => q{state must be a HASH reference} )
91             unless Ref::Util::is_hashref( $state );
92              
93 8   100     21 $state->{value} //= [];
94              
95             my ( \@depends, \@keys, \@value, $thaw )
96 8         25 = @{$state}{qw[ depends keys value thaw ]};
  8         36  
97              
98             # transform into iterators if required.
99             my @iterators
100 8         17 = map { to_iterator( $_, { ( +EXHAUSTION ) => RETURN } ) } @depends;
  16         54  
101              
102             # can only work if the iterators support a rewind method
103             throw_failure( parameter => q{all iterables must provide a rewind method} )
104 8 50   16   37 unless List::Util::all { defined can_meth( $_, 'rewind' ) } @iterators;
  16         28  
105              
106 8 50 66     34 throw_failure( parameter => q{number of keys not equal to number of iterators} )
107             if @keys && @keys != @iterators;
108              
109 8 100       12 @value = map { $_->current } @iterators
  4         11  
110             if $thaw;
111              
112             ## no critic ( AmbiguousNames )
113 8         13 my @set = ( 1 ) x @value;
114              
115 8         11 my @src = map { [ $_, $_->can( 'is_exhausted' ) ] } @iterators;
  16         34  
116              
117 8         11 my $self;
118             my $iterator_state;
119             my %params = (
120              
121             ( +_SELF ) => \$self,
122              
123             ( +STATE ) => \$iterator_state,
124              
125             ( +NEXT ) => sub {
126 44 100   44   69 return $self->signal_exhaustion if $iterator_state == IterState_EXHAUSTED;
127              
128             # first time through
129 33 100       43 if ( !@value ) {
130              
131 7         40 for my $src ( @src ) {
132 14         51 my ( $iter, $is_exhausted ) = $src->@*;
133 14         67 push @value, $iter->();
134              
135 14 50       23 return $self->signal_exhaustion
136             if $iter->$is_exhausted;
137             }
138              
139 7         15 @set = ( 1 ) x @value;
140             }
141              
142             else {
143 26         33 my ( $iter, $is_exhausted ) = $src[-1]->@*;
144              
145 26         34 $value[-1] = $iter->();
146 26 100       37 if ( $iter->$is_exhausted ) {
147 13         18 $set[-1] = 0;
148 13         109 my $idx = @src - 1;
149              
150 13         28 while ( --$idx >= 0 ) {
151 13         21 ( $iter, $is_exhausted ) = $src[$idx]->@*;
152 13         17 $value[$idx] = $iter->();
153 13 100       22 last unless $iter->$is_exhausted;
154 7         15 $set[$idx] = 0;
155             }
156              
157 13 100       28 return $self->signal_exhaustion
158             if !$set[0];
159              
160 6         10 while ( ++$idx < @src ) {
161 6         17 $src[$idx][0]->rewind;
162 6         10 $value[$idx] = $src[$idx][0]->();
163 6         11 $set[$idx] = 1;
164             }
165             }
166              
167             }
168 26 100       34 if ( @keys ) {
169 8         9 my %value;
170 8         17 @value{@keys} = @value;
171 8         18 return \%value;
172             }
173             else {
174 18         47 return [@value];
175             }
176             },
177              
178             ( +CURRENT ) => sub {
179 33 100   33   60 return undef if !@value;
180 27 100       56 return $self->signal_exhaustion if $iterator_state eq IterState_EXHAUSTED;
181 22 100       25 if ( @keys ) {
182 8         7 my %value;
183 8         12 @value{@keys} = @value;
184 8         14 return \%value;
185             }
186             else {
187 14         33 return [@value];
188             }
189             },
190              
191 0     0   0 ( +RESET ) => sub { @value = () },
192 1     1   2 ( +REWIND ) => sub { @value = () },
193 8         95 ( +_DEPENDS ) => \@iterators,
194             );
195              
196             # can only freeze if the iterators support a current method
197 8 50       19 if (
198 16     16   22 List::Util::all { defined can_meth( $_, 'current' ) }
199             @iterators
200             )
201             {
202              
203             $params{ +FREEZE } = sub {
204 2     2   7 return [ $class, { keys => \@keys } ];
205 8         18 };
206 8         20 $params{ +_ROLES } = ['Freeze'];
207             }
208              
209 8         18 $params{ +_NAME } = 'iproduct';
210 8         40 return \%params;
211             }
212              
213              
214             __PACKAGE__->_add_roles( qw[
215             State::Closure
216             Next::ClosedSelf
217             Current::Closure
218             Reset::Closure
219             Rewind::Closure
220             ] );
221              
222             1;
223              
224             #
225             # This file is part of Iterator-Flex
226             #
227             # This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
228             #
229             # This is free software, licensed under:
230             #
231             # The GNU General Public License, Version 3, June 2007
232             #
233              
234             __END__