local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Template/Iterator.pm

   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
  22 package Template::Iterator;
  23
  24 use strict;
  25 use warnings;
  26 use base 'Template::Base';
  27 use Template::Constants;
  28 use Template::Exception;
  29 use Scalar::Util qw(blessed);
  30
  31 use constant ODD  => 'odd';
  32 use constant EVEN => 'even';
  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     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
  89 sub 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
 117 sub 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
 154 sub 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
 195 sub odd {
 196     shift->{ COUNT } % 2 ? 1 : 0
 197 }
 198
 199 sub even {
 200     shift->{ COUNT } % 2 ? 0 : 1
 201 }
 202
 203 sub 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
 214 sub 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
 238 sub _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
 253 1;
 254
 255 __END__
 256
 257 =head1 NAME
 258
 259 Template::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
 267 The C<Template::Iterator> module defines a generic data iterator for use
 268 by the C<FOREACH> directive.
 269
 270 It may be used as the base class for custom iterators.
 271
 272 =head1 PUBLIC METHODS
 273
 274 =head2 new($data)
 275
 276 Constructor method.  A reference to a list of values is passed as the
 277 first parameter.  Subsequent calls to L<get_first()> and L<get_next()> calls
 278 will return each element from the list.
 279
 280     my $iter = Template::Iterator->new([ 'foo', 'bar', 'baz' ]);
 281
 282 The constructor will also accept a reference to a hash array and will
 283 expand it into a list in which each entry is a hash array containing
 284 a '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
 291 This is equivalent to:
 292
 293     my $iter = Template::Iterator->new([
 294         { key => 'bar', value => 'Bar Item' },
 295         { key => 'foo', value => 'Foo Item' },
 296     ]);
 297
 298 When passed a single item which is not an array reference, the constructor
 299 will automatically create a list containing that single item.
 300
 301     my $iter = Template::Iterator->new('foo');
 302
 303 This is equivalent to:
 304
 305     my $iter = Template::Iterator->new([ 'foo' ]);
 306
 307 Note that a single item which is an object based on a blessed ARRAY
 308 references will NOT be treated as an array and will be folded into
 309 a list containing that one object reference.
 310
 311     my $list = bless [ 'foo', 'bar' ], 'MyListClass';
 312     my $iter = Template::Iterator->new($list);
 313
 314 equivalent to:
 315
 316     my $iter = Template::Iterator->new([ $list ]);
 317
 318 If the object provides an C<as_list()> method then the L<Template::Iterator>
 319 constructor 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
 333 This is then functionally equivalent to:
 334
 335     my $iter = Template::Iterator->new([ $list ]);
 336
 337 The iterator will return only one item, a reference to the C<MyListObject>
 338 object, C<$list>.
 339
 340 By adding an C<as_list()> method to the C<MyListObject> class, we can force
 341 the C<Template::Iterator> constructor to treat the object as a list and
 342 use 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
 358 The iterator will now return the two items, 'C<foo>' and 'C<bar>', which the
 359 C<MyObjectList> encapsulates.
 360
 361 =head2 get_first()
 362
 363 Returns a C<($value, $error)> pair for the first item in the iterator set.
 364 The C<$error> returned may be zero or undefined to indicate a valid datum
 365 was successfully returned.  Returns an error of C<STATUS_DONE> if the list
 366 is empty.
 367
 368 =head2 get_next()
 369
 370 Returns a C<($value, $error)> pair for the next item in the iterator set.
 371 Returns an error of C<STATUS_DONE> if all items in the list have been
 372 visited.
 373
 374 =head2 get_all()
 375
 376 Returns a C<(\@values, $error)> pair for all remaining items in the iterator
 377 set.  Returns an error of C<STATUS_DONE> if all items in the list have been
 378 visited.
 379
 380 =head2 size()
 381
 382 Returns the size of the data set or undef if unknown.
 383
 384 =head2 max()
 385
 386 Returns the maximum index number (i.e. the index of the last element)
 387 which is equivalent to L<size()> - C<1>.
 388
 389 =head2 index()
 390
 391 Returns the current index number which is in the range C<0> to L<max()>.
 392
 393 =head2 count()
 394
 395 Returns the current iteration count in the range C<1> to L<size()>.  This is
 396 equivalent to L<index()> + C<1>.
 397
 398 =head2 first()
 399
 400 Returns a boolean value to indicate if the iterator is currently on
 401 the first iteration of the set.
 402
 403 =head2 last()
 404
 405 Returns a boolean value to indicate if the iterator is currently on
 406 the last iteration of the set.
 407
 408 =head2 prev()
 409
 410 Returns the previous item in the data set, or C<undef> if the iterator is
 411 on the first item.
 412
 413 =head2 next()
 414
 415 Returns the next item in the data set or C<undef> if the iterator is on the
 416 last item.
 417
 418 =head2 parity()
 419
 420 Returns the text string C<even> or C<odd> to indicate the parity of the
 421 current iteration count (starting at 1).  This is typically used to create
 422 striped 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
 432 This 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
 446 You 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
 460 Returns 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
 462 value for the first iterator, the third, fifth, and so on.
 463
 464 =head2 even()
 465
 466 Returns 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
 468 value for the second iteration, the fourth, sixth, and so on.
 469
 470 =head1 AUTHOR
 471
 472 Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
 473
 474 =head1 COPYRIGHT
 475
 476 Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
 477
 478 This module is free software; you can redistribute it and/or
 479 modify it under the same terms as Perl itself.
 480
 481 =head1 SEE ALSO
 482
 483 L<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: