File Coverage

blib/lib/Object/Iterate.pm
Criterion Covered Total %
statement 49 49 100.0
branch 13 16 81.2
condition n/a
subroutine 10 10 100.0
pod 3 3 100.0
total 75 78 96.1


line stmt bran cond sub pod time code
1             package Object::Iterate;
2 10     10   1769793 use v5.20;
  10         40  
3              
4 10     10   89 use strict;
  10         73  
  10         304  
5 10     10   56 use warnings;
  10         38  
  10         613  
6 10     10   66 no warnings;
  10         37  
  10         660  
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             # Each iteration sets $_ to the thing that $object gives back
19              
20             my $final = iterate {...} $object;
21             my @filtered = igrep {...} $object;
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 a 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 the 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             C 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 store these method 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 10     10   68 use Carp qw(croak);
  10         43  
  10         760  
71 10     10   60 use Exporter qw(import);
  10         17  
  10         7316  
72             our @EXPORT_OK = qw(iterate igrep imap);
73             our %EXPORT_TAGS = (
74             all => \@EXPORT_OK,
75             );
76              
77             our $VERSION = '1.153';
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 16 100   16   4947 unless eval { $_[0]->can( $Next ) };
  16         721  
87             croak( "iterate object has no $More() method" )
88 11 50       23 unless eval { $_[0]->can( $More ) };
  11         48  
89              
90 11 100       56 $_[0]->$Init() if eval { $_[0]->can( $Init ) };
  11         75  
91              
92 11         34 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             local $_ = $object->__next__;
108             ...BLOCK...
109             }
110              
111             =cut
112              
113             sub iterate :prototype(&$) {
114 2     2 1 6824 my $sub = shift;
115 2         9 my $object = shift;
116              
117 2         7 _check_object( $object );
118              
119 2         7 while( $object->$More ) {
120 6         9 local $_ = $object->$Next;
121 6         7 $sub->();
122             }
123              
124 2 50       18 $object->$Final if $object->can( $Final );
125             }
126              
127             =item igrep BLOCK, OBJECT
128              
129             Applies BLOCK to each item returned by C<< OBJECT->__next__ >>, and
130             returns all of the elements for which the BLOCK returns TRUE.
131              
132             my @output = igrep { /abc/ } $object;
133              
134             This is a grep for something that cannot be represented as a
135             list at one time.
136              
137             my @output;
138             while( $object->__more__ ) {
139             local $_ = $object->__next__;
140             push @output, $_ if ...BLOCK...;
141             }
142              
143             =cut
144              
145             sub igrep :prototype(&$) {
146 3     3 1 7360 my $sub = shift;
147 3         15 my $object = shift;
148              
149 3         10 _check_object( $object );
150              
151 3         4 my @output;
152 3         11 while( $object->$More ) {
153 12         37 local $_ = $object->$Next;
154 12 100       25 push @output, $_ if $sub->();
155             }
156              
157 3 50       24 $object->$Final if $object->can( $Final );
158              
159 3 100       15 wantarray ? @output : scalar @output;
160             }
161              
162             =item imap BLOCK, OBJECT
163              
164             Applies BLOCK to each item returned by C<< OBJECT->__next__ >>, and
165             returns the combined lists that BLOCK returns for each of the
166             elements.
167              
168             my @output = imap { uc($_) } $object;
169              
170             This is a map for something that cannot be represented as a
171             list at one time.
172              
173             my @output;
174             while( $object->$More ) {
175             local $_ = $object->__next__;
176             push @output, ...BLOCK...;
177             }
178              
179             =cut
180              
181             sub imap :prototype(&$) {
182 6     6 1 362644 my $sub = shift;
183 6         14 my $object = shift;
184              
185 6         39 _check_object( $object );
186              
187 6         10 my @output;
188 6         25 while( $object->$More ) {
189 37         242 local $_ = $object->$Next;
190 37         119 push @output, $sub->();
191             }
192              
193 6 100       63 $object->$Final if $object->can( $Final );
194              
195 6         30 @output;
196             }
197              
198             =back
199              
200             =head1 ERROR MESSAGES
201              
202             =over 4
203              
204             =item iterate object has no C<__more__()> method at script line N
205              
206             You need to provide the method to let C determine if
207             more elements are available. You don't have to call it C<__more__> if
208             you change the value of C<$Object::Iterate::More>.
209              
210             =item iterate object has no C<__next__()> method at script line N
211              
212             You need to provide the method to let Object::Iterate fetch the next
213             element. You don't have to call it C<__next__> if you change the
214             value of C<$Object::Iterate::Next>.
215              
216             =back
217              
218             =head1 SOURCE AVAILABILITY
219              
220             This module is on GitHub:
221              
222             https://github.com/briandfoy/object-iterate
223              
224             =head1 TO DO
225              
226             =over 4
227              
228             =item * let the methods discover the method names per object.
229              
230             =back
231              
232             =head1 CREDITS
233              
234             Thanks to Slaven Rezic for adding C<__init__> support
235              
236             =head1 AUTHOR
237              
238             brian d foy, C<< >>.
239              
240             =head1 COPYRIGHT AND LICENSE
241              
242             Copyright © 2002-2026, brian d foy . All rights reserved.
243              
244             This program is free software; you can redistribute it and/or modify
245             it under the terms of the Artistic License 2.0.
246              
247             =cut
248              
249             1;