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