File Coverage

blib/lib/Object/Iterate.pm
Criterion Covered Total %
statement 52 52 100.0
branch 12 16 75.0
condition n/a
subroutine 10 10 100.0
pod 3 3 100.0
total 77 81 95.0


line stmt bran cond sub pod time code
1             package Object::Iterate;
2 9     9   478157 use v5.20;
  9         83  
3              
4 9     9   40 use strict;
  9         17  
  9         183  
5 9     9   37 use warnings;
  9         13  
  9         235  
6 9     9   40 no warnings;
  9         14  
  9         383  
7              
8             =encoding utf8
9              
10             =head1 NAME
11              
12             Object::Iterate - iterators for objects that know the next element
13              
14             =head1 SYNOPSIS
15              
16             use Object::Iterate qw(iterate igrep imap);
17              
18             iterate {...} $object;
19              
20             my @filtered = igrep {...} $object;
21              
22             my @transformed = imap {...} $object;
23              
24             =head1 DESCRIPTION
25              
26             This module provides control structures to iterate through the
27             elements of an object that cannot be represented as list of items all
28             at once. Objects can represent a virtual collection that is beyond
29             the reaches of foreach, map, and grep because they cannot turn
30             themselves into a list.
31              
32             If the object can return a next element, it can use this module.
33             Iterate assumes that the object responds to C<__next__> with the next
34             element, and to C<__more__> with TRUE or FALSE if more elements remain
35             to be processed. The C<__init__> method is called before the first
36             iteration (if it exists), and is silently skipped otherwise. The
37             control structure continues until the C<__more__> method returns FALSE
38             (which does not mean that it visited all of the elements but that the
39             object has decided to stop iterating). At the end of all iterations
40             (when C<__more__> returns false), C calls
41             C<__final__> if it exists, and skips it otherwise.
42              
43             Each control structure sets C<$_> to the current element, just like
44             foreach, map, and grep.
45              
46             =head2 Mutable method names
47              
48             You do not really have to use the C<__next__>, C<__more__>,
49             C<__init__>, or C<__final__> names. They are just the defaults which
50             stores in the package variables C<$Next>, C<$More>,
51             C<$Init>, and C<$Final> respectively. This module does not export
52             these variables, so you need to use the full package specification to
53             change them (I C<$Object::Iterate::Next>). If your object does
54             not have the specified methods, the functions will die. You may want
55             to wrap them in eval blocks.
56              
57             Since this module uses package variables to storethese methods names,
58             the method names apply to every use of the functions no matter the
59             object. You might want to local()-ise the variables for different
60             objects.
61              
62             Before any control structure does its job, it checks the object to see
63             if it can respond to these two methods, whatever you decide to call
64             them, so your object must know that it can respond to these methods.
65             AUTOLOADed methods cannot work since the module cannot know if they
66             exist.
67              
68             =cut
69              
70 9     9   50 use Carp qw(croak);
  9         13  
  9         401  
71 9     9   54 use Exporter qw(import);
  9         27  
  9         4532  
72             our @EXPORT_OK = qw(iterate igrep imap);
73             our %EXPORT_TAGS = (
74             all => \@EXPORT_OK,
75             );
76              
77             our $VERSION = '1.144';
78              
79             our $Next = '__next__';
80             our $More = '__more__';
81             our $Init = '__init__';
82             our $Final = '__final__';
83              
84             sub _check_object {
85             croak( "iterate object has no $Next() method" )
86 12 100   12   1041 unless eval { $_[0]->can( $Next ) };
  12         512  
87             croak( "iterate object has no $More() method" )
88 7 50       13 unless eval { $_[0]->can( $More ) };
  7         37  
89              
90 7 100       10 $_[0]->$Init() if eval { $_[0]->can( $Init ) };
  7         70  
91              
92 7         21 return 1;
93             }
94              
95             =over 4
96              
97             =item iterate BLOCK, OBJECT
98              
99             Applies BLOCK to each item returned by C<< OBJECT->__next__ >>.
100              
101             iterate { print "$_\n" } $object;
102              
103             This is the same thing as using a while loop, but C
104             stays out of your way.
105              
106             while( $object->__more__ )
107             {
108             local $_ = $object->__next__;
109             ...BLOCK...
110             }
111              
112             =cut
113              
114             sub iterate :prototype(&$) {
115 1     1 1 547 my $sub = shift;
116 1         2 my $object = shift;
117              
118 1         3 _check_object( $object );
119              
120 1         9 while( $object->$More() ) {
121 6         52 local $_;
122 6         12 $_ = $object->$Next();
123 6         18 $sub->();
124             }
125              
126 1 50       11 $object->$Final() if $object->can( $Final );
127             }
128              
129             =item igrep BLOCK, OBJECT
130              
131             Applies BLOCK to each item returned by C<< OBJECT->__next__ >>, and
132             returns all of the elements for which the BLOCK returns TRUE.
133              
134             my $output = igrep { print "$_\n" } $object;
135              
136             This is a grep for something that cannot be represented as a
137             list at one time.
138              
139             while( $object->__more__ ) {
140             local $_ = $object->__next__;
141             push @output, $_ if ...BLOCK...;
142             }
143              
144             =cut
145              
146             sub igrep :prototype(&$) {
147 1     1 1 509 my $sub = shift;
148 1         2 my $object = shift;
149              
150 1         3 _check_object( $object );
151              
152 1         2 my @output = ();
153              
154 1         4 while( $object->$More() ) {
155 6         7 local $_;
156 6         10 $_ = $object->$Next();
157 6 100       8 push @output, $_ if $sub->();
158             }
159              
160 1 50       5 $object->$Final() if $object->can( $Final );
161              
162 1 50       5 wantarray ? @output : scalar @output;
163             }
164              
165             =item imap BLOCK, OBJECT
166              
167             Applies BLOCK to each item returned by C<< OBJECT->__next__ >>, and
168             returns the combined lists that BLOCK returns for each of the
169             elements.
170              
171             my @output = imap { print "$_\n" } $object;
172              
173             This is a map for something that cannot be represented as a
174             list at one time.
175              
176             while( $object->$More )
177             {
178             local $_ = $object->__next__;
179              
180             push @output, ...BLOCK...;
181             }
182              
183             =cut
184              
185             sub imap :prototype(&$) {
186 4     4 1 1352 my $sub = shift;
187 4         7 my $object = shift;
188              
189 4         14 _check_object( $object );
190              
191 4         7 my @output = ();
192              
193 4         33 while( $object->$More ) {
194 31         145 local $_;
195 31         46 $_ = $object->$Next;
196 31         70 push @output, $sub->();
197             }
198              
199 4 100       31 $object->$Final if $object->can( $Final );
200              
201 4         17 @output;
202             }
203              
204             =back
205              
206             =head1 ERROR MESSAGES
207              
208             =over 4
209              
210             =item iterate object has no C<__more__()> method at script line N
211              
212             You need to provide the method to let C determine if
213             more elements are available. You don't have to call it C<__more__> if
214             you change the value of C<$Object::Iterate::More>.
215              
216             =item iterate object has no C<__next__()> method at script line N
217              
218             You need to provide the method to let Object::Iterate fetch the next
219             element. You don't have to call it C<__next__> if you change the
220             value of C<$Object::Iterate::Next>.
221              
222             =back
223              
224             =head1 SOURCE AVAILABILITY
225              
226             This module is on Github:
227              
228             http://github.com/briandfoy/Object-Iterate
229              
230             =head1 TO DO
231              
232             * let the methods discover the method names per object.
233              
234             =head1 CREDITS
235              
236             Thanks to Slaven Rezic for adding C<__init__> support
237              
238             =head1 AUTHOR
239              
240             brian d foy, C<< >>.
241              
242             =head1 COPYRIGHT AND LICENSE
243              
244             Copyright © 2002-2021, brian d foy . All rights reserved.
245              
246             This program is free software; you can redistribute it and/or modify
247             it under the terms of the Artistic License 2.0.
248              
249             =cut
250              
251             1;