0: #!/usr/bin/perl -w
1: #
2: # Q: Perl need iterator? That's unpossible!
3: # A: Have you ever had to iterate on multiple list values at once? One 
4: #    often resorts to numeric indexing to solve this problem. Shift and splice
5: #    is another WTDI, but only if you don't mind eating away at your original
6: #    list. Think of the iterator as a non-mutating splice.
7: #
8: # iterstart ARRAY VARIABLE
9: # iterstart ARRAY
10: #   Sets up iteration for a given array, with the iterator variable
11: #   specified. Must be called before any of the other functions.
12: #
13: # iter NUM ARRAY
14: # iter NUM
15: # iter
16: #   Iterates through and returns a list of next NUM elements for the 
17: #   active or specified array. A negative NUM acts as an index from the
18: #   end of the array. When NUM is unspecified, it is defaulted as 1.
19: #
20: # iterend ARRAY
21: # iterend
22: #   End iteration for active or specified array. Not usually
23: #   needed.
24: #
25: use strict;
26: {
27:   my (%listpos, $lref);
28: 
29:   sub iterstart (\@) {
30:     $lref = shift;
31:     $listpos{$lref} = 0;
32:   }
33: 
34:   sub iter (;$\@) {
35:     my $num = shift || 1;
36:     $lref = shift if @_;
37:     return if not exists $listpos{$lref};
38:     my $i = $listpos{$lref};
39:     my $j = $num >= 0 ? $i + $num - 1: $#$lref + $num + 1;
40:     if ($j < $#$lref) {
41:       $listpos{$lref} = $j + 1;
42:     }
43:     else {
44:       delete $listpos{$lref};
45:       $j = $#$lref;
46:     }
47:     @$lref[$i..$j];
48:   }
49: 
50:   sub iterend (;\@) {
51:     delete $listpos{shift || $lref}
52:   }
53: }
54: 
55: ############ EXAMPLES ############
56: 
57: use Data::Dumper;
58: my (@data, @lol);
59: 
60: # Example: iterate over a multi-value list
61: @data = qw(1 one uno 2 two dos 3 three tres 4 four quatro 5 five cinco);
62: iterstart @data;
63: while (my ($num, $eng, $span) = iter 3) {
64:   print "$num is $eng in English and $span in Spanish\n";
65: }
66: 
67: # Example: convert a flat data structure to a list-of-lists
68: @data = qw(1 fee 2 fee fi 3 fee fi fo 4 fee fi fo fum 1 fin);
69: iterstart @data;
70: while (my ($len) = iter) {
71:   push @lol, [iter $len];
72: }
73: print Dumper \@lol;