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   557587 use v5.20;
  9         94  
3              
4 9     9   44 use strict;
  9         14  
  9         181  
5 9     9   37 use warnings;
  9         14  
  9         238  
6 9     9   39 no warnings;
  9         14  
  9         404  
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   54 use Carp qw(croak);
  9         17  
  9         431  
71 9     9   45 use Exporter qw(import);
  9         14  
  9         4798  
72             our @EXPORT_OK = qw(iterate igrep imap);
73             our %EXPORT_TAGS = (
74             all => \@EXPORT_OK,
75             );
76              
77             our $VERSION = '1.146';
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   1013 unless eval { $_[0]->can( $Next ) };
  12         481  
87             croak( "iterate object has no $More() method" )
88 7 50       14 unless eval { $_[0]->can( $More ) };
  7         43  
89              
90 7 100       12 $_[0]->$Init() if eval { $_[0]->can( $Init ) };
  7         56  
91              
92 7         25 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 1     1 1 735 my $sub = shift;
115 1         3 my $object = shift;
116              
117 1         5 _check_object( $object );
118              
119 1         5 while( $object->$More() ) {
120 6         72 local $_;
121 6         16 $_ = $object->$Next();
122 6         23 $sub->();
123             }
124              
125 1 50       14 $object->$Final() if $object->can( $Final );
126             }
127              
128             =item igrep BLOCK, OBJECT
129              
130             Applies BLOCK to each item returned by C<< OBJECT->__next__ >>, and
131             returns all of the elements for which the BLOCK returns TRUE.
132              
133             my $output = igrep { print "$_\n" } $object;
134              
135             This is a grep for something that cannot be represented as a
136             list at one time.
137              
138             while( $object->__more__ ) {
139             local $_ = $object->__next__;
140             push @output, $_ if ...BLOCK...;
141             }
142              
143             =cut
144              
145             sub igrep :prototype(&$) {
146 1     1 1 522 my $sub = shift;
147 1         2 my $object = shift;
148              
149 1         4 _check_object( $object );
150              
151 1         2 my @output = ();
152              
153 1         4 while( $object->$More() ) {
154 6         7 local $_;
155 6         11 $_ = $object->$Next();
156 6 100       10 push @output, $_ if $sub->();
157             }
158              
159 1 50       6 $object->$Final() if $object->can( $Final );
160              
161 1 50       5 wantarray ? @output : scalar @output;
162             }
163              
164             =item imap BLOCK, OBJECT
165              
166             Applies BLOCK to each item returned by C<< OBJECT->__next__ >>, and
167             returns the combined lists that BLOCK returns for each of the
168             elements.
169              
170             my @output = imap { print "$_\n" } $object;
171              
172             This is a map for something that cannot be represented as a
173             list at one time.
174              
175             while( $object->$More ) {
176             local $_ = $object->__next__;
177              
178             push @output, ...BLOCK...;
179             }
180              
181             =cut
182              
183             sub imap :prototype(&$) {
184 4     4 1 1841 my $sub = shift;
185 4         10 my $object = shift;
186              
187 4         14 _check_object( $object );
188              
189 4         8 my @output = ();
190              
191 4         37 while( $object->$More ) {
192 31         132 local $_;
193 31         51 $_ = $object->$Next;
194 31         87 push @output, $sub->();
195             }
196              
197 4 100       34 $object->$Final if $object->can( $Final );
198              
199 4         18 @output;
200             }
201              
202             =back
203              
204             =head1 ERROR MESSAGES
205              
206             =over 4
207              
208             =item iterate object has no C<__more__()> method at script line N
209              
210             You need to provide the method to let C determine if
211             more elements are available. You don't have to call it C<__more__> if
212             you change the value of C<$Object::Iterate::More>.
213              
214             =item iterate object has no C<__next__()> method at script line N
215              
216             You need to provide the method to let Object::Iterate fetch the next
217             element. You don't have to call it C<__next__> if you change the
218             value of C<$Object::Iterate::Next>.
219              
220             =back
221              
222             =head1 SOURCE AVAILABILITY
223              
224             This module is on Github:
225              
226             http://github.com/briandfoy/Object-Iterate
227              
228             =head1 TO DO
229              
230             * let the methods discover the method names per object.
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-2022, 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;