File Coverage

lib/Template/Iterator.pm
Criterion Covered Total %
statement 79 84 94.0
branch 32 34 94.1
condition 7 10 70.0
subroutine 16 17 94.1
pod 7 7 100.0
total 141 152 92.7


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Template::Iterator
4             #
5             # DESCRIPTION
6             #
7             # Module defining an iterator class which is used by the FOREACH
8             # directive for iterating through data sets. This may be
9             # sub-classed to define more specific iterator types.
10             #
11             # AUTHOR
12             # Andy Wardley
13             #
14             # COPYRIGHT
15             # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
16             #
17             # This module is free software; you can redistribute it and/or
18             # modify it under the same terms as Perl itself.
19             #
20             #============================================================================
21              
22             package Template::Iterator;
23              
24 29     29   1046 use strict;
  29         66  
  29         2660  
25 29     29   167 use warnings;
  29         57  
  29         1077  
26 29     29   180 use base 'Template::Base';
  29         57  
  29         3044  
27 29     29   177 use Template::Constants;
  29         64  
  29         1410  
28 29     29   168 use Template::Exception;
  29         72  
  29         1105  
29 29     29   185 use Scalar::Util qw(blessed);
  29         61  
  29         1803  
30              
31 29     29   214 use constant ODD => 'odd';
  29         72  
  29         3371  
32 29     29   159 use constant EVEN => 'even';
  29         1633  
  29         43555  
33              
34             our $VERSION = 2.68;
35             our $DEBUG = 0 unless defined $DEBUG;
36             our $AUTOLOAD;
37              
38             #========================================================================
39             # ----- CLASS METHODS -----
40             #========================================================================
41              
42             #------------------------------------------------------------------------
43             # new(\@target, \%options)
44             #
45             # Constructor method which creates and returns a reference to a new
46             # Template::Iterator object. A reference to the target data (array
47             # or hash) may be passed for the object to iterate through.
48             #------------------------------------------------------------------------
49              
50             sub new {
51 179     179 1 387 my $class = shift;
52 179   100     605 my $data = shift || [ ];
53 179   50     910 my $params = shift || { };
54              
55 179 100 66     1509 if (ref $data eq 'HASH') {
    100          
    100          
56             # map a hash into a list of { key => ???, value => ??? } hashes,
57             # one for each key, sorted by keys
58 3         24 $data = [ map { { key => $_, value => $data->{ $_ } } }
  8         36  
59             sort keys %$data ];
60             }
61             elsif (blessed($data) && $data->can('as_list')) {
62 2         10 $data = $data->as_list();
63             }
64             elsif (ref $data ne 'ARRAY') {
65             # coerce any non-list data into an array reference
66 4         13 $data = [ $data ] ;
67             }
68              
69             bless {
70 179         1851 _DATA => $data,
71             _ERROR => '',
72             }, $class;
73             }
74              
75              
76             #========================================================================
77             # ----- PUBLIC OBJECT METHODS -----
78             #========================================================================
79              
80             #------------------------------------------------------------------------
81             # get_first()
82             #
83             # Initialises the object for iterating through the target data set. The
84             # first record is returned, if defined, along with the STATUS_OK value.
85             # If there is no target data, or the data is an empty set, then undef
86             # is returned with the STATUS_DONE value.
87             #------------------------------------------------------------------------
88              
89             sub get_first {
90 181     181 1 997 my $self = shift;
91 181         403 my $data = $self->{ _DATA };
92              
93 181         462 $self->{ _DATASET } = $self->{ _DATA };
94 181         328 my $size = scalar @$data;
95 181         333 my $index = 0;
96            
97 181 100       542 return (undef, Template::Constants::STATUS_DONE) unless $size;
98              
99             # initialise various counters, flags, etc.
100 176 100       1943 @$self{ qw( SIZE MAX INDEX COUNT FIRST LAST ) }
101             = ( $size, $size - 1, $index, 1, 1, $size > 1 ? 0 : 1, undef );
102 176         984 @$self{ qw( PREV NEXT ) } = ( undef, $self->{ _DATASET }->[ $index + 1 ]);
103              
104 176         621 return $self->{ _DATASET }->[ $index ];
105             }
106              
107              
108              
109             #------------------------------------------------------------------------
110             # get_next()
111             #
112             # Called repeatedly to access successive elements in the data set.
113             # Should only be called after calling get_first() or a warning will
114             # be raised and (undef, STATUS_DONE) returned.
115             #------------------------------------------------------------------------
116              
117             sub get_next {
118 604     604 1 11067 my $self = shift;
119 604         1205 my ($max, $index) = @$self{ qw( MAX INDEX ) };
120 604         926 my $data = $self->{ _DATASET };
121              
122             # warn about incorrect usage
123 604 50       1423 unless (defined $index) {
124 0         0 my ($pack, $file, $line) = caller();
125 0         0 warn("iterator get_next() called before get_first() at $file line $line\n");
126 0         0 return (undef, Template::Constants::STATUS_DONE); ## RETURN ##
127             }
128              
129             # if there's still some data to go...
130 604 100       1233 if ($index < $max) {
131             # update counters and flags
132 442         534 $index++;
133 442 100       1502 @$self{ qw( INDEX COUNT FIRST LAST ) }
134             = ( $index, $index + 1, 0, $index == $max ? 1 : 0 );
135 442         1410 @$self{ qw( PREV NEXT ) } = @$data[ $index - 1, $index + 1 ];
136 442         1435 return $data->[ $index ]; ## RETURN ##
137             }
138             else {
139 162         691 return (undef, Template::Constants::STATUS_DONE); ## RETURN ##
140             }
141             }
142              
143              
144             #------------------------------------------------------------------------
145             # get_all()
146             #
147             # Method which returns all remaining items in the iterator as a Perl list
148             # reference. May be called at any time in the life-cycle of the iterator.
149             # The get_first() method will be called automatically if necessary, and
150             # then subsequent get_next() calls are made, storing each returned
151             # result until the list is exhausted.
152             #------------------------------------------------------------------------
153              
154             sub get_all {
155 8     8 1 15 my $self = shift;
156 8         13 my ($max, $index) = @$self{ qw( MAX INDEX ) };
157 8         8 my @data;
158              
159             # handle cases where get_first() has yet to be called.
160 8 100       14 unless (defined $index) {
161 3         6 my ($first, $status) = $self->get_first;
162              
163             # refresh $max and $index, after get_first updates MAX and INDEX
164 3         11 ($max, $index) = @$self{ qw( MAX INDEX ) };
165              
166             # empty lists are handled here.
167 3 100 66     97 if ($status && $status == Template::Constants::STATUS_DONE) {
168 1         3 return (undef, Template::Constants::STATUS_DONE); ## RETURN ##
169             }
170              
171 2         4 push @data, $first;
172              
173             ## if there's nothing left in the iterator, return the single value.
174 2 100       6 unless ($index < $max) {
175 1         3 return \@data;
176             }
177             }
178              
179             # if there's still some data to go...
180 6 100       8 if ($index < $max) {
181 3         3 $index++;
182 3         7 push @data, @{ $self->{ _DATASET } } [ $index..$max ];
  3         14  
183            
184             # update counters and flags
185 3         8 @$self{ qw( INDEX COUNT FIRST LAST ) }
186             = ( $max, $max + 1, 0, 1 );
187              
188 3         10 return \@data; ## RETURN ##
189             }
190             else {
191 3         8 return (undef, Template::Constants::STATUS_DONE); ## RETURN ##
192             }
193             }
194              
195             sub odd {
196 10 100   10 1 197 shift->{ COUNT } % 2 ? 1 : 0
197             }
198              
199             sub even {
200 10 100   10 1 176 shift->{ COUNT } % 2 ? 0 : 1
201             }
202              
203             sub parity {
204 10 100   10 1 171 shift->{ COUNT } % 2 ? ODD : EVEN;
205             }
206              
207              
208             #------------------------------------------------------------------------
209             # AUTOLOAD
210             #
211             # Provides access to internal fields (e.g. size, first, last, max, etc)
212             #------------------------------------------------------------------------
213              
214             sub AUTOLOAD {
215 122     122   6423 my $self = shift;
216 122         158 my $item = $AUTOLOAD;
217 122         450 $item =~ s/.*:://;
218 122 50       260 return if $item eq 'DESTROY';
219              
220             # alias NUMBER to COUNT for backwards compatibility
221 122 100       230 $item = 'COUNT' if $item =~ /NUMBER/i;
222              
223 122         472 return $self->{ uc $item };
224             }
225              
226              
227             #========================================================================
228             # ----- PRIVATE DEBUG METHODS -----
229             #========================================================================
230              
231             #------------------------------------------------------------------------
232             # _dump()
233             #
234             # Debug method which returns a string detailing the internal state of
235             # the iterator object.
236             #------------------------------------------------------------------------
237              
238             sub _dump {
239 0     0     my $self = shift;
240             join('',
241             " Data: ", $self->{ _DATA }, "\n",
242             " Index: ", $self->{ INDEX }, "\n",
243             "Number: ", $self->{ NUMBER }, "\n",
244             " Max: ", $self->{ MAX }, "\n",
245             " Size: ", $self->{ SIZE }, "\n",
246             " First: ", $self->{ FIRST }, "\n",
247 0           " Last: ", $self->{ LAST }, "\n",
248             "\n"
249             );
250             }
251              
252              
253             1;
254              
255             __END__