File Coverage

blib/lib/Lazy/Util.pm
Criterion Covered Total %
statement 112 113 99.1
branch 27 28 96.4
condition 5 9 55.5
subroutine 27 27 100.0
pod 13 13 100.0
total 184 190 96.8


line stmt bran cond sub pod time code
1 1     1   14813 use strict;
  1         3  
  1         30  
2 1     1   9 use warnings;
  1         3  
  1         66  
3              
4             package Lazy::Util;
5             $Lazy::Util::VERSION = '0.003';
6             #ABSTRACT: Perl utilities for lazy evaluation
7              
8              
9 1     1   7 use Carp qw/ croak /;
  1         2  
  1         74  
10 1     1   6 use Exporter qw/ import /;
  1         1  
  1         25  
11 1     1   291 use Lazy::Iterator;
  1         2  
  1         24  
12 1     1   5 use Scalar::Util qw/ blessed /;
  1         2  
  1         42  
13              
14 1     1   5 use constant SCALAR_DEFER => eval { require Scalar::Defer; 1 };
  1         2  
  1         2  
  1         1102  
  0         0  
15              
16             our @EXPORT_OK = qw/
17             l_concat l_first l_grep l_map l_until g_count g_first g_join g_last g_max
18             g_min g_prod g_sum
19             /;
20              
21             our %EXPORT_TAGS = (all => [@EXPORT_OK],);
22              
23 86 100   86   422 sub _isa { defined blessed $_[0] and $_[0]->isa($_[1]); }
24              
25              
26             sub l_concat {
27 28     28 1 101 my (@vals) = grep defined, @_;
28              
29 28 100   8   123 return Lazy::Iterator->new(sub {undef}) if @vals == 0;
  8         18  
30              
31 20 50 66     58 return $vals[0] if @vals == 1 and _isa($vals[0], 'Lazy::Iterator');
32              
33             return Lazy::Iterator->new(
34             sub {
35 98     98   210 while (@vals) {
36              
37             # if it's a Scalar::Defer or a CODE reference, coerce into a
38             # Lazy::Iterator object
39 84 100 33     454 $vals[0] = Lazy::Iterator->new($vals[0])
      66        
40             if SCALAR_DEFER && _isa($vals[0], 0)
41             or ref $vals[0] eq 'CODE';
42              
43             # if by this point it's not a Lazy::Iterator object, simply return it
44             # and remove from @vals
45 84 100       168 return shift @vals if not _isa($vals[0], 'Lazy::Iterator');
46              
47             # ->get the next value from the Lazy::Iterator object and return it if
48             # it's defined
49 4 100       11 if (defined(my $get = $vals[0]->get())) { return $get; }
  3         7  
50 1         6 else { shift @vals; }
51             }
52 15         31 return undef;
53             }
54 20         110 );
55             }
56              
57              
58             sub l_first {
59 1     1 1 5 my ($n, @vals) = @_;
60              
61 1         4 my $vals = l_concat @vals;
62              
63             return Lazy::Iterator->new(
64             sub {
65 4 100   4   14 return $vals->get() if $n-- > 0;
66 1         3 return undef;
67             }
68 1         5 );
69             }
70              
71              
72             sub l_grep (&@) {
73 1     1 1 4 my ($grep, @vals) = @_;
74              
75 1         5 my $vals = l_concat @vals;
76              
77             return Lazy::Iterator->new(
78             sub {
79 3     3   9 while (defined(my $get = $vals->get())) {
80 5         9 for ($get) {
81 5 100       9 if ($grep->($get)) { return $get }
  2         10  
82             }
83             }
84              
85 1         2 return undef;
86             }
87 1         7 );
88             }
89              
90              
91             sub l_map (&@) {
92 4     4 1 12 my ($map, @vals) = @_;
93              
94 4         11 my $vals = l_concat @vals;
95              
96 4         7 my @subvals = ();
97             return Lazy::Iterator->new(
98             sub {
99 18 100   18   46 return shift @subvals if @subvals;
100              
101 17         48 while (not @subvals) {
102 30         110 my $get = $vals->get();
103 30 100       69 return undef if not defined $get;
104              
105 26         60 @subvals = $map->($get) for $get;
106             }
107              
108 13         87 return shift @subvals;
109             }
110 4         18 );
111             }
112              
113              
114             sub l_until (&@) {
115 2     2 1 11 my ($until, @vals) = @_;
116              
117 2         6 my $vals = l_concat @vals;
118              
119 2         4 my $found = 0;
120             return Lazy::Iterator->new(
121             sub {
122 9 100   9   23 return undef if $found;
123              
124 7         22 my $get = $vals->get();
125 7         22 $found = $until->($get) for $get;
126              
127 7         31 return $get;
128             }
129 2         12 );
130             }
131              
132              
133             sub g_count {
134 2     2 1 7 my (@vals) = @_;
135              
136 2         6 my $vals = l_concat @vals;
137              
138 2         14 my $n = 0;
139 2         11 while (defined $vals->get()) { $n++; }
  4         11  
140              
141 2         25 return $n;
142             }
143              
144              
145             sub g_first {
146 2     2 1 5 my (@vals) = @_;
147              
148 2         6 my $vals = l_concat @vals;
149              
150 2         6 return $vals->get();
151             }
152              
153              
154             sub g_join {
155 3     3 1 10 my ($sep, @vals) = @_;
156              
157 3         9 my $vals = l_concat @vals;
158              
159 3         9 my $ret = $vals->get();
160 3         8 while (defined(my $get = $vals->get())) { $ret .= $sep . $get; }
  2         7  
161              
162 3         20 return $ret;
163             }
164              
165              
166             sub g_last {
167 2     2 1 6 my @vals = @_;
168              
169 2         7 my $vals = l_concat @vals;
170              
171 2         4 my $ret = undef;
172 2         6 while (defined(my $get = $vals->get())) { $ret = $get; }
  3         23  
173              
174 2         13 return $ret;
175             }
176              
177              
178             sub g_max {
179 2     2 1 7 my @vals = @_;
180              
181 2         6 my $vals = l_concat @vals;
182              
183 2         8 my $ret = $vals->get();
184 2 100       8 while (defined(my $get = $vals->get())) { $ret = $get if $get > $ret; }
  6         20  
185              
186 2         14 return $ret;
187             }
188              
189              
190             sub g_min {
191 2     2 1 6 my @vals = @_;
192              
193 2         6 my $vals = l_concat @vals;
194              
195 2         8 my $ret = $vals->get();
196 2 100       25 while (defined(my $get = $vals->get())) { $ret = $get if $get < $ret; }
  7         29  
197              
198 2         15 return $ret;
199             }
200              
201              
202             sub g_prod {
203 3     3 1 10 my @vals = @_;
204              
205 3         9 my $vals = l_concat @vals;
206              
207 3         8 my $ret = 1;
208 3         9 while (defined(my $get = $vals->get())) {
209 7         10 $ret *= $get;
210 7 100       28 return 0 if $ret == 0;
211             }
212              
213 2         15 return $ret;
214             }
215              
216              
217             sub g_sum {
218 2     2 1 8 my @vals = @_;
219              
220 2         7 my $vals = l_concat @vals;
221              
222 2         4 my $ret = 0;
223 2         6 while (defined(my $get = $vals->get())) { $ret += $get; }
  3         7  
224              
225 2         23 return $ret;
226             }
227              
228             1;
229              
230             __END__