File Coverage

blib/lib/Array/Iterator.pm
Criterion Covered Total %
statement 79 81 97.5
branch 43 44 97.7
condition 4 6 66.6
subroutine 21 22 95.4
pod 14 14 100.0
total 161 167 96.4


line stmt bran cond sub pod time code
1             package Array::Iterator;
2              
3 10     10   772585 use strict;
  10         21  
  10         366  
4 10     10   46 use warnings;
  10         22  
  10         12413  
5              
6             =head1 NAME
7              
8             Array::Iterator - A simple class for iterating over Perl arrays
9              
10             =head1 VERSION
11              
12             Version 0.136
13              
14             =cut
15              
16             our $VERSION = '0.136';
17              
18             =head1 SYNOPSIS
19              
20             C is a Perl module that provides a simple,
21             uni-directional iterator interface for traversing arrays.
22             It allows users to iterate over arrays, array references, or hash references containing an array, offering methods like next, has_next, peek, and current to facilitate controlled access to elements.
23             The iterator maintains an internal pointer, ensuring elements are accessed sequentially without modifying the underlying array.
24             Tt offers a clean, object-oriented approach to iteration, inspired by Java’s Iterator interface.
25             The module is extendable, allowing subclassing for custom behaviour.
26              
27             use Array::Iterator;
28              
29             # create an iterator with an array
30             my $i = Array::Iterator->new(1 .. 100);
31              
32             # create an iterator with an array reference
33             my $i = Array::Iterator->new(\@array);
34              
35             # create an iterator with a hash reference
36             my $i = Array::Iterator->new({ __array__ => \@array });
37              
38             # a base iterator example
39             while ($i->has_next()) {
40             if ($i->peek() < 50) {
41             # ... do something because
42             # the next element is over 50
43             }
44             my $current = $i->next();
45             # ... do something with current
46             }
47              
48             # shortcut style
49             my @accumulation;
50             push @accumulation => { item => $iterator->next() } while $iterator->has_next();
51              
52             # C++ ish style iterator
53             for (my $i = Array::Iterator->new(@array); $i->has_next(); $i->next()) {
54             my $current = $i->current();
55             # .. do something with current
56             }
57              
58             # common perl iterator idiom
59             my $current;
60             while ($current = $i->get_next()) {
61             # ... do something with $current
62             }
63              
64             It is not recommended to alter the array during iteration, however
65             no attempt is made to enforce this (although I will if I can find an efficient
66             means of doing so). This class only intends to provide a clear and simple
67             means of generic iteration, nothing more (yet).
68              
69             =head2 new (@array | $array_ref | $hash_ref)
70              
71             The constructor can be passed either a plain Perl array, an array reference,
72             or a hash reference (with the array specified as a single key of the hash,
73             __array__).
74             Single-element arrays are not supported by either of the first
75             two calling conventions, since it is not possible to distinguish between an
76             array of a single-element which happens to be an array reference and an
77             array reference of a single element, thus previous versions of the constructor
78             would raise an exception. If you expect to pass arrays to the constructor which
79             may have only a single element, then the array can be passed as the element
80             of a HASH reference, with the key, __array__:
81              
82             my $i = Array::Iterator->new({ __array__ => \@array });
83              
84             =cut
85              
86             sub new {
87 31     31 1 1922615 my ($_class, @array) = @_;
88              
89 31 100       195 (@array) || die 'Insufficient Arguments: you must provide something to iterate over';
90              
91 29   33     234 my $class = ref($_class) || $_class;
92 29         58 my $_array;
93 29 100       100 if (scalar @array == 1) {
94 11 100       57 if (ref $array[0] eq 'ARRAY') {
    100          
95 4         38 $_array = $array[0];
96             } elsif (ref $array[0] eq 'HASH') {
97             die 'Incorrect type: HASH reference must contain the key __array__'
98 6 100       46 unless exists $array[0]->{__array__};
99             die 'Incorrect type: __array__ value must be an ARRAY reference'
100 4 100       31 unless ref $array[0]->{__array__} eq 'ARRAY';
101 3         6 $_array = $array[0]->{__array__};
102             } else {
103             # One element array
104 1         4 $_array = \@array;
105             }
106             } else {
107 18         43 $_array = \@array;
108             }
109 26         141 my $iterator = {
110             _current_index => 0,
111             _length => 0,
112             _iteratee => [],
113             _iterated => 0, # -1 when going backwards, +1 when going forwards
114             };
115 26         71 bless($iterator, $class);
116 26         48 return $iterator->_init(scalar(@{$_array}), $_array);
  26         147  
117             }
118              
119             sub _init {
120 28     28   951 my ($self, $length, $iteratee) = @_;
121              
122 28 100 100     191 (defined($length) && defined($iteratee)) || die 'Insufficient Arguments: you must provide an length and an iteratee';
123 26         82 $self->{_current_index} = 0;
124 26         65 $self->{_length} = $length;
125             # $self->{_iteratee} = $iteratee;
126              
127             # Store a private copy to prevent modifications
128 26         46 $self->{_iteratee} = [@{$iteratee}];
  26         96  
129              
130 26         121 return $self;
131             }
132              
133             =head2 _current_index
134              
135             An lvalue-ed subroutine that allows access to the iterator's internal pointer.
136             This can be used in a subclass to access the value.
137              
138             =cut
139              
140             # We need to alter this so it's an lvalue
141             sub _current_index : lvalue {
142 216 100   216   1364 (UNIVERSAL::isa((caller)[0], __PACKAGE__))
143             || die 'Illegal Operation: This method can only be called by a subclass';
144             $_[0]->{_current_index}
145 215         2869 }
146              
147             =head2 _iteratee
148              
149             This returns the item being iterated over, in our case an array.
150              
151             =cut
152              
153             # This we should never need to alter so we don't make it a lvalue
154             sub _iteratee {
155 80 100   80   782 (UNIVERSAL::isa((caller)[0], __PACKAGE__))
156             || die 'Illegal Operation: This method can only be called by a subclass';
157             $_[0]->{_iteratee}
158 79         730 }
159              
160             # we move this from a private method
161             # to a protected one, and check our access
162             # as well
163             sub _getItem {
164 207 100   207   1423 (UNIVERSAL::isa((caller)[0], __PACKAGE__)) || die 'Illegal Operation: This method can only be called by a subclass';
165              
166 206         2034 my ($self, $iteratee, $index) = @_;
167 206         848 return $iteratee->[$index];
168             }
169              
170             =head2 _get_item ($iteratee, $index)
171              
172             This method is used by all other routines to access items. Given the iteratee
173             and an index, it will return the item being stored in the C<$iteratee> at the index
174             of C<$index>.
175              
176             =cut
177              
178 0     0   0 sub _get_item { my $self = shift; $self->_getItem(@_) }
  0         0  
179              
180             # we need to alter this so it's an lvalue
181             sub _iterated : lvalue {
182 79 50   79   273 (UNIVERSAL::isa((caller)[0], __PACKAGE__))
183             || die 'Illegal Operation: This method can only be called by a subclass';
184             $_[0]->{_iterated}
185 79         739 }
186              
187             =head2 iterated
188              
189             Access to the _iterated status, for subclasses
190              
191             =cut
192              
193             sub iterated {
194 2     2 1 7376 my $self = shift;
195              
196 2         11 return $self->{_iterated};
197             }
198              
199             =head2 has_next([$n])
200              
201             This method returns a boolean. True (1) if there are still more elements in
202             the iterator, false (0) if there are not.
203              
204             Takes an optional positive integer (E 0) that specifies the position you
205             want to check. This allows you to check if there an element at an arbitrary position.
206             Think of it as an ordinal number you want to check:
207              
208             $i->has_next(2); # 2nd next element
209             $i->has_next(10); # 10th next element
210              
211             Note that C is the same as C.
212              
213             Throws an exception if C<$n> E= 0.
214              
215             =cut
216              
217             sub has_next {
218 83     83 1 712 my ($self, $n) = @_;
219              
220 83 100       292 if(not defined $n) {
    100          
    100          
221 75         128 $n = 1
222             } elsif(not $n) {
223 1         11 die "has_next(0) doesn't make sense, did you mean current()?"
224             } elsif($n < 0) {
225 1         10 die "has_next() with negative argument doesn't make sense, perhaps you should use a BiDirectional iterator"
226             }
227              
228 81         4522 my $idx = $self->{_current_index} + ($n - 1);
229              
230 81 100       309 return ($idx < $self->{_length}) ? 1 : 0;
231             }
232              
233             =head2 hasNext
234              
235             Alternative name for has_next
236              
237             =cut
238              
239 61     61 1 15189 sub hasNext { my $self = shift; $self->has_next(@_) }
  61         177  
240              
241             =head2 next
242              
243             This method returns the next item in the iterator, be sure to only call this
244             once per iteration as it will advance the index pointer to the next item. If
245             this method is called after all elements have been exhausted, an exception
246             will be thrown.
247              
248             =cut
249              
250             sub next {
251 60     60 1 8614 my $self = shift;
252              
253 60 100       238 ($self->{_current_index} < $self->{_length}) || die 'Out Of Bounds: no more elements';
254              
255 59         110 $self->{_iterated} = 1;
256 59         160 return $self->_getItem($self->{_iteratee}, $self->{_current_index}++);
257             }
258              
259             =head2 get_next
260              
261             This method returns the next item in the iterator, be sure to only call this
262             once per iteration as it will advance the index pointer to the next item. If
263             this method is called after all elements have been exhausted, it will return
264             undef.
265              
266             This method was added to allow for a fairly common Perl iterator idiom of:
267              
268             my $current;
269             while ($current = $i->get_next()) {
270             ...
271             }
272              
273             In this,
274             the loop terminates once C<$current> is assigned to a false value.
275             The only problem with this idiom for me is that it does not allow for
276             undefined or false values in the iterator. Of course, if this fits your
277             data, then there is no problem. Otherwise I would recommend the C/C
278             idiom instead.
279              
280             =cut
281              
282             sub get_next {
283 24     24 1 45 my $self = shift;
284              
285 24         48 $self->{_iterated} = 1;
286 24 100       90 return undef unless ($self->{_current_index} < $self->{_length}); ## no critic: Subroutines::ProhibitExplicitReturnUndef
287 18         71 return $self->_getItem($self->{_iteratee}, $self->{_current_index}++);
288             }
289              
290             =head2 getNext
291              
292             Alternative name for get_next
293              
294             =cut
295              
296 49     49 1 11056 sub getNext { my $self = shift; $self->get_next(@_) }
  49         131  
297              
298             =head2 peek([$n])
299              
300             This method can be used to peek ahead at the next item in the iterator. It
301             is non-destructive, meaning it does not advance the internal pointer. If
302             this method is called and attempts to reach beyond the bounds of the iterator,
303             it will return undef.
304              
305             Takes an optional positive integer (E 0) that specifies how far ahead you want to peek:
306              
307             $i->peek(2); # gives you 2nd next element
308             $i->peek(10); # gives you 10th next element
309              
310             Note that C is the same as C.
311              
312             Throws an exception if C<$n> E= 0.
313              
314             B Before version 0.03 this method would throw an exception if called
315             out of bounds. I decided this was not a good practice, as it made it difficult
316             to be able to peek ahead effectively. This is not the case when calling with an argument
317             that is E= 0 though, as it's clearly a sign of incorrect usage.
318              
319             =cut
320              
321             sub peek {
322 35     35 1 1137 my ($self, $n) = @_;
323              
324 35 100       111 if(not defined $n) { $n = 1 }
  22 100       38  
    100          
325 1         18 elsif(not $n) { die "peek(0) doesn't make sense, did you mean get_next()?" }
326 1         11 elsif($n < 0) { die "peek() with negative argument doesn't make sense, perhaps you should use a BiDirectional iterator" }
327              
328 33         84 my $idx = $self->{_current_index} + ($n - 1);
329              
330 33 100       103 return undef unless ($idx < $self->{_length}); ## no critic: Subroutines::ProhibitExplicitReturnUndef
331 26         67 return $self->_getItem($self->{_iteratee}, $idx);
332             }
333              
334             =head2 current
335              
336             This method can be used to get the current item in the iterator. It is non-destructive,
337             meaning that it does not advance the internal pointer. This value will match the
338             last value dispensed by C or C.
339              
340             =cut
341              
342             sub current {
343 24     24 1 75 my $self = shift;
344 24         93 return $self->_getItem($self->{_iteratee}, $self->currentIndex());
345             }
346              
347             =head2 current_index
348              
349             This method can be used to get the current index in the iterator. It is non-destructive,
350             meaning that it does not advance the internal pointer. This value will match the index
351             of the last value dispensed by C or C.
352              
353             =cut
354              
355             sub current_index {
356 68     68 1 490 my $self = shift;
357 68 100       324 return ($self->{_current_index} != 0) ? $self->{_current_index} - 1 : 0;
358             }
359              
360             =head2 currentIndex
361              
362             Alternative name for current_index
363              
364             =cut
365              
366 66     66 1 7005 sub currentIndex { my $self = shift; $self->current_index(@_) }
  66         173  
367              
368             =head2 reset
369              
370             Reset index to allow iteration from the start
371              
372             =cut
373              
374             sub reset
375             {
376 1     1 1 5 my $self = shift;
377 1         2 $self->{'_current_index'} = 0;
378             }
379              
380             =head2 get_length
381              
382             This is a basic accessor for getting the length of the array being iterated over,
383             returns the number of elements in the array.
384              
385             =cut
386              
387             sub get_length {
388 53     53 1 87 my $self = shift;
389              
390 53         225 return $self->{_length};
391             }
392              
393             =head2 getLength
394              
395             Alternative name for get_length
396              
397             =cut
398              
399 53     53 1 4394 sub getLength { my $self = shift; $self->get_length(@_) }
  53         132  
400              
401             1;
402              
403             =head1 TODO
404              
405             =over 4
406              
407             =item Improve BiDirectional Test suite
408              
409             I want to test the back-and-forth a little more and make sure they work well with one another.
410              
411             =item Other Iterators
412              
413             Array::Iterator::BiDirectional::Circular, Array::Iterator::Skipable and
414             Array::Iterator::BiDirectional::Skipable are just a few ideas I have had. I am going
415             to hold off for now until I am sure they are actually useful.
416              
417             =back
418              
419             =head1 SEE ALSO
420              
421             This module now includes several subclasses of Array::Iterator which add certain behaviors
422             to Array::Iterator, they are:
423              
424             =over 4
425              
426             =item C
427              
428             Adds the ability to move backward and forward through the array.
429              
430             =item C
431              
432             When this iterator reaches the end of its list, it will loop back to the start again.
433              
434             =item C
435              
436             This iterator can be reset to its beginning and used again.
437              
438             =back
439              
440             The Design Patterns book by the Gang of Four, specifically the Iterator pattern.
441              
442             Some of the interface for this class is based on the Java Iterator interface.
443              
444             =head1 OTHER ITERATOR MODULES
445              
446             There are several on CPAN with the word Iterator in them.
447             Most of them are
448             actually iterators included inside other modules, and only really useful within that
449             parent module's context. There are, however, some other modules out there that are just
450             for pure iteration. I have provided a list below of the ones I have found if perhaps
451             you don't happen to like the way I do it.
452              
453             =over 4
454              
455             =item Tie::Array::Iterable
456              
457             This module ties the array, something we do not do. But it also makes an attempt to
458             account for, and allow the array to be changed during iteration. It accomplishes this
459             control because the underlying array is tied. As we all know, tie-ing things can be a
460             performance issue, but if you need what this module provides, then it will likely be
461             an acceptable compromise. Array::Iterator makes no attempt to deal with this mid-iteration
462             manipulation problem.
463             In fact,
464             it is recommended to not alter your array with Array::Iterator,
465             and if possible we will enforce this in later versions.
466              
467             =item Data::Iter
468              
469             This module allows for simple iteration over both hashes and arrays.
470             It does it by
471             importing several functions that can be used to loop over either type (hash or array)
472             in the same way. It is an interesting module, it differs from Array::Iterator in
473             paradigm (Array::Iterator is more OO) and intent.
474              
475             =item Class::Iterator
476              
477             This is essentially a wrapper around a closure-based iterator.
478             This method can be very
479             flexible, but at times is difficult to manage due to the inherent complexity of using
480             closures. I actually was a closure-as-iterator fan for a while but eventually moved
481             away from it in favor of the more plain vanilla means of iteration, like that found
482             Array::Iterator.
483              
484             =item Class::Iter
485              
486             This is part of the Class::Visitor module and is a Visitor and Iterator extension to
487             Class::Template.
488             Array::Iterator is a standalone module that is not associated with others.
489              
490             =item B
491              
492             Data::Iterator::EasyObj makes your array of arrays into iterator objects.
493             It also can
494             further nest additional data structures including Data::Iterator::EasyObj
495             objects.
496             Array::Iterator is one-dimensional only and does not attempt to do many of
497             the more advanced features of this module.
498              
499             =back
500              
501             =head1 ACKNOWLEDGEMENTS
502              
503             =over 4
504              
505             =item Thanks to Hugo Cornelis for pointing out a bug in C
506              
507             =item Thanks to Phillip Moore for providing the patch to allow single element iteration
508             through the hash-ref constructor parameter.
509              
510             =back
511              
512             =head1 MAINTAINER
513              
514             Nigel Horne, C<< >>
515              
516             2025-2026
517              
518             =head1 ORIGINAL AUTHOR
519              
520             stevan little, Estevan@iinteractive.comE
521              
522             =head1 ORIGINAL COPYRIGHT AND LICENSE
523              
524             Copyright 2004, 2005 by Infinity Interactive, Inc.
525              
526             L
527              
528             This library is free software; you can redistribute it and/or modify
529             it under the same terms as Perl itself.
530              
531             =head1 PREVIOUS MAINTAINER
532              
533             Maintained 2017 to 2025 PERLANCAR
534              
535             =head1 SUPPORT
536              
537             This module is provided as-is without any warranty.
538              
539             Please report any bugs or feature requests to C,
540             or through the web interface at
541             L.
542             I will be notified, and then you'll
543             automatically be notified of progress on your bug as I make changes.
544              
545             You can find documentation for this module with the perldoc command.
546              
547             perldoc Array::Iterator
548              
549             You can also look for information at:
550              
551             =over 4
552              
553             =item * MetaCPAN
554              
555             L
556              
557             =item * RT: CPAN's request tracker
558              
559             L
560              
561             =item * CPAN Testers' Matrix
562              
563             L
564              
565             =item * CPAN Testers Dependencies
566              
567             L
568              
569             =back
570              
571             =cut