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 <abw@wardley.org> 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 22package Template::Iterator; 23 24use strict; 25use warnings; 26use base 'Template::Base'; 27use Template::Constants; 28use Template::Exception; 29use Scalar::Util qw(blessed); 30 31use constant ODD => 'odd'; 32use constant EVEN => 'even'; 33 34our $VERSION = 2.68; 35our $DEBUG = 0 unless defined $DEBUG; 36our $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 50sub new { 51 my $class = shift; 52 my $data = shift || [ ]; 53 my $params = shift || { }; 54 55 if (ref $data eq 'HASH') { 56 # map a hash into a list of { key => ???, value => ??? } hashes, 57 # one for each key, sorted by keys 58 $data = [ map { { key => $_, value => $data->{ $_ } } } 59 sort keys %$data ]; 60 } 61 elsif (blessed($data) && $data->can('as_list')) { 62 $data = $data->as_list(); 63 } 64 elsif (ref $data ne 'ARRAY') { 65 # coerce any non-list data into an array reference 66 $data = [ $data ] ; 67 } 68 69 bless { 70 _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 89sub get_first { 90 my $self = shift; 91 my $data = $self->{ _DATA }; 92 93 $self->{ _DATASET } = $self->{ _DATA }; 94 my $size = scalar @$data; 95 my $index = 0; 96 97 return (undef, Template::Constants::STATUS_DONE) unless $size; 98 99 # initialise various counters, flags, etc. 100 @$self{ qw( SIZE MAX INDEX COUNT FIRST LAST ) } 101 = ( $size, $size - 1, $index, 1, 1, $size > 1 ? 0 : 1, undef ); 102 @$self{ qw( PREV NEXT ) } = ( undef, $self->{ _DATASET }->[ $index + 1 ]); 103 104 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 117sub get_next { 118 my $self = shift; 119 my ($max, $index) = @$self{ qw( MAX INDEX ) }; 120 my $data = $self->{ _DATASET }; 121 122 # warn about incorrect usage 123 unless (defined $index) { 124 my ($pack, $file, $line) = caller(); 125 warn("iterator get_next() called before get_first() at $file line $line\n"); 126 return (undef, Template::Constants::STATUS_DONE); ## RETURN ## 127 } 128 129 # if there's still some data to go... 130 if ($index < $max) { 131 # update counters and flags 132 $index++; 133 @$self{ qw( INDEX COUNT FIRST LAST ) } 134 = ( $index, $index + 1, 0, $index == $max ? 1 : 0 ); 135 @$self{ qw( PREV NEXT ) } = @$data[ $index - 1, $index + 1 ]; 136 return $data->[ $index ]; ## RETURN ## 137 } 138 else { 139 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 154sub get_all { 155 my $self = shift; 156 my ($max, $index) = @$self{ qw( MAX INDEX ) }; 157 my @data; 158 159 # handle cases where get_first() has yet to be called. 160 unless (defined $index) { 161 my ($first, $status) = $self->get_first; 162 163 # refresh $max and $index, after get_first updates MAX and INDEX 164 ($max, $index) = @$self{ qw( MAX INDEX ) }; 165 166 # empty lists are handled here. 167 if ($status && $status == Template::Constants::STATUS_DONE) { 168 return (undef, Template::Constants::STATUS_DONE); ## RETURN ## 169 } 170 171 push @data, $first; 172 173 ## if there's nothing left in the iterator, return the single value. 174 unless ($index < $max) { 175 return \@data; 176 } 177 } 178 179 # if there's still some data to go... 180 if ($index < $max) { 181 $index++; 182 push @data, @{ $self->{ _DATASET } } [ $index..$max ]; 183 184 # update counters and flags 185 @$self{ qw( INDEX COUNT FIRST LAST ) } 186 = ( $max, $max + 1, 0, 1 ); 187 188 return \@data; ## RETURN ## 189 } 190 else { 191 return (undef, Template::Constants::STATUS_DONE); ## RETURN ## 192 } 193} 194 195sub odd { 196 shift->{ COUNT } % 2 ? 1 : 0 197} 198 199sub even { 200 shift->{ COUNT } % 2 ? 0 : 1 201} 202 203sub parity { 204 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 214sub AUTOLOAD { 215 my $self = shift; 216 my $item = $AUTOLOAD; 217 $item =~ s/.*:://; 218 return if $item eq 'DESTROY'; 219 220 # alias NUMBER to COUNT for backwards compatability 221 $item = 'COUNT' if $item =~ /NUMBER/i; 222 223 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 238sub _dump { 239 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 " Last: ", $self->{ LAST }, "\n", 248 "\n" 249 ); 250} 251 252 2531; 254 255__END__ 256 257=head1 NAME 258 259Template::Iterator - Data iterator used by the FOREACH directive 260 261=head1 SYNOPSIS 262 263 my $iter = Template::Iterator->new(\@data, \%options); 264 265=head1 DESCRIPTION 266 267The C<Template::Iterator> module defines a generic data iterator for use 268by the C<FOREACH> directive. 269 270It may be used as the base class for custom iterators. 271 272=head1 PUBLIC METHODS 273 274=head2 new($data) 275 276Constructor method. A reference to a list of values is passed as the 277first parameter. Subsequent calls to L<get_first()> and L<get_next()> calls 278will return each element from the list. 279 280 my $iter = Template::Iterator->new([ 'foo', 'bar', 'baz' ]); 281 282The constructor will also accept a reference to a hash array and will 283expand it into a list in which each entry is a hash array containing 284a 'C<key>' and 'C<value>' item, sorted according to the hash keys. 285 286 my $iter = Template::Iterator->new({ 287 foo => 'Foo Item', 288 bar => 'Bar Item', 289 }); 290 291This is equivalent to: 292 293 my $iter = Template::Iterator->new([ 294 { key => 'bar', value => 'Bar Item' }, 295 { key => 'foo', value => 'Foo Item' }, 296 ]); 297 298When passed a single item which is not an array reference, the constructor 299will automatically create a list containing that single item. 300 301 my $iter = Template::Iterator->new('foo'); 302 303This is equivalent to: 304 305 my $iter = Template::Iterator->new([ 'foo' ]); 306 307Note that a single item which is an object based on a blessed ARRAY 308references will NOT be treated as an array and will be folded into 309a list containing that one object reference. 310 311 my $list = bless [ 'foo', 'bar' ], 'MyListClass'; 312 my $iter = Template::Iterator->new($list); 313 314equivalent to: 315 316 my $iter = Template::Iterator->new([ $list ]); 317 318If the object provides an C<as_list()> method then the L<Template::Iterator> 319constructor will call that method to return the list of data. For example: 320 321 package MyListObject; 322 323 sub new { 324 my $class = shift; 325 bless [ @_ ], $class; 326 } 327 328 package main; 329 330 my $list = MyListObject->new('foo', 'bar'); 331 my $iter = Template::Iterator->new($list); 332 333This is then functionally equivalent to: 334 335 my $iter = Template::Iterator->new([ $list ]); 336 337The iterator will return only one item, a reference to the C<MyListObject> 338object, C<$list>. 339 340By adding an C<as_list()> method to the C<MyListObject> class, we can force 341the C<Template::Iterator> constructor to treat the object as a list and 342use the data contained within. 343 344 package MyListObject; 345 346 ... 347 348 sub as_list { 349 my $self = shift; 350 return $self; 351 } 352 353 package main; 354 355 my $list = MyListObject->new('foo', 'bar'); 356 my $iter = Template::Iterator->new($list); 357 358The iterator will now return the two items, 'C<foo>' and 'C<bar>', which the 359C<MyObjectList> encapsulates. 360 361=head2 get_first() 362 363Returns a C<($value, $error)> pair for the first item in the iterator set. 364The C<$error> returned may be zero or undefined to indicate a valid datum 365was successfully returned. Returns an error of C<STATUS_DONE> if the list 366is empty. 367 368=head2 get_next() 369 370Returns a C<($value, $error)> pair for the next item in the iterator set. 371Returns an error of C<STATUS_DONE> if all items in the list have been 372visited. 373 374=head2 get_all() 375 376Returns a C<(\@values, $error)> pair for all remaining items in the iterator 377set. Returns an error of C<STATUS_DONE> if all items in the list have been 378visited. 379 380=head2 size() 381 382Returns the size of the data set or undef if unknown. 383 384=head2 max() 385 386Returns the maximum index number (i.e. the index of the last element) 387which is equivalent to L<size()> - C<1>. 388 389=head2 index() 390 391Returns the current index number which is in the range C<0> to L<max()>. 392 393=head2 count() 394 395Returns the current iteration count in the range C<1> to L<size()>. This is 396equivalent to L<index()> + C<1>. 397 398=head2 first() 399 400Returns a boolean value to indicate if the iterator is currently on 401the first iteration of the set. 402 403=head2 last() 404 405Returns a boolean value to indicate if the iterator is currently on 406the last iteration of the set. 407 408=head2 prev() 409 410Returns the previous item in the data set, or C<undef> if the iterator is 411on the first item. 412 413=head2 next() 414 415Returns the next item in the data set or C<undef> if the iterator is on the 416last item. 417 418=head2 parity() 419 420Returns the text string C<even> or C<odd> to indicate the parity of the 421current iteration count (starting at 1). This is typically used to create 422striped I<zebra tables>. 423 424 <table> 425 [% FOREACH name IN ['Arthur', 'Ford', 'Trillian'] -%] 426 <tr class="[% loop.parity %]"> 427 <td>[% name %]</td> 428 </tr> 429 [% END %] 430 </table> 431 432This will produce the following output: 433 434 <table> 435 <tr class="odd"> 436 <td>Arthur</td> 437 </tr> 438 <tr class="even"> 439 <td>Ford</td> 440 </tr> 441 <tr class="odd"> 442 <td>Trillian</td> 443 </tr> 444 </table> 445 446You can then style the C<tr.odd> and C<tr.even> elements using CSS: 447 448 tr.odd td { 449 background-color: black; 450 color: white; 451 } 452 453 tr.even td { 454 background-color: white; 455 color: black; 456 } 457 458=head2 odd() 459 460Returns a boolean (0/1) value to indicate if the current iterator count 461(starting at 1) is an odd number. In other words, this will return a true 462value for the first iterator, the third, fifth, and so on. 463 464=head2 even() 465 466Returns a boolean (0/1) value to indicate if the current iterator count 467(starting at 1) is an even number. In other words, this will return a true 468value for the second iteration, the fourth, sixth, and so on. 469 470=head1 AUTHOR 471 472Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/> 473 474=head1 COPYRIGHT 475 476Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. 477 478This module is free software; you can redistribute it and/or 479modify it under the same terms as Perl itself. 480 481=head1 SEE ALSO 482 483L<Template> 484 485=cut 486 487# Local Variables: 488# mode: perl 489# perl-indent-level: 4 490# indent-tabs-mode: nil 491# End: 492# 493# vim: expandtab shiftwidth=4: 494