File Coverage

blib/lib/List/Cycle.pm
Criterion Covered Total %
statement 61 61 100.0
branch 6 6 100.0
condition n/a
subroutine 13 13 100.0
pod 5 5 100.0
total 85 85 100.0


;
line stmt bran cond sub pod time code
1             package List::Cycle;
2              
3 6     6   424153 use warnings;
  6         59  
  6         229  
4 6     6   34 use strict;
  6         12  
  6         119  
5 6     6   31 use Carp ();
  6         10  
  6         4151  
6              
7             =head1 NAME
8              
9             List::Cycle - Objects for cycling through a list of values
10              
11             =head1 VERSION
12              
13             Version 1.04
14              
15             =cut
16              
17             our $VERSION = '1.04';
18              
19             =head1 SYNOPSIS
20              
21             List::Cycle gives you an iterator object for cycling through a series
22             of values. The canonical use is for cycling through a list of colors
23             for alternating bands of color on a report.
24              
25             use List::Cycle;
26              
27             my $colors = List::Cycle->new( {values => ['#000000', '#FAFAFA', '#BADDAD']} );
28             print $colors->next; # #000000
29             print $colors->next; # #FAFAFA
30             print $colors->next; # #BADDAD
31             print $colors->next; # #000000
32             print $colors->next; # #FAFAFA
33             ... etc ...
34              
35             You'd call it at the top of a loop:
36              
37             while ( ... ) {
38             my $color = $colors->next;
39             print qq{
40             ...
41             }
42              
43             Note that a List::Cycle object is not a standard Perl blessed hash.
44             It's an inside-out object, as suggested in I.
45             In the seven years since I has come out, inside-out objects have
46             been almost universally ignored, but I keep List::Cycle as an example.
47             If you don't care about the internals of the object, then List::Cycle
48             is a fine module for you to use.
49              
50             =head1 FUNCTIONS
51              
52             =head2 new( {values => \@values} )
53              
54             Creates a new cycle object, using I<@values>.
55              
56             The C keyword can be C, if you like.
57              
58             =cut
59              
60             my %storage = (
61             values => \my %values_of,
62             pointer => \my %pointer_of,
63             );
64              
65             sub new {
66 7     7 1 5829 my $class = shift;
67 7         16 my $args = shift;
68              
69 7         14 my $self = \do { my $scalar };
  7         19  
70 7         15 bless $self, $class;
71              
72 7         14 $self->_init( %{$args} );
  7         35  
73              
74 6         18 return $self;
75             }
76              
77             sub _init {
78 7     7   13 my $self = shift;
79 7         19 my @args = @_;
80              
81 7         26 $self->_store_pointer( 0 );
82 7         25 while ( @args ) {
83 6         17 my $key = shift @args;
84 6         12 my $value = shift @args;
85              
86 6 100       42 if ( $key =~ /^val(?:ue)?s$/ ) {
87 5         17 $self->set_values($value);
88             }
89             else {
90 1         183 Carp::croak( "$key is not a valid constructor value" );
91             }
92             }
93              
94 6         120 return $self;
95             }
96              
97             =head2 C<< $cycle->set_values(\@values) >>
98              
99             Sets the cycle values and resets the internal pointer.
100              
101             =cut
102              
103             sub set_values {
104 6     6 1 17 my ($self, $values) = @_;
105              
106 6         19 $values_of{ $self } = $values;
107 6         22 $self->reset;
108              
109 6         26 return;
110             }
111              
112             sub DESTROY {
113 7     7   5006 my $self = shift;
114              
115 7         26 for my $attr_ref ( values %storage ) {
116 14         46 delete $attr_ref->{$self};
117             }
118              
119 7         734 return;
120             }
121              
122             sub _pointer {
123 46     46   66 my $self = shift;
124              
125 46         86 return $pointer_of{ $self };
126             }
127              
128             sub _store_pointer {
129 38     38   50 my $self = shift;
130              
131 38         96 $pointer_of{ $self } = shift;
132              
133 38         62 return;
134             }
135              
136             sub _inc_pointer {
137 23     23   34 my $self = shift;
138 23         31 my $ptr = $self->_pointer;
139 23         44 $self->_store_pointer(($ptr+1) % @{$values_of{$self}});
  23         78  
140              
141 23         37 return;
142             }
143              
144             =head2 $cycle->reset
145              
146             Sets the internal pointer back to the beginning of the cycle.
147              
148             my $color = List::Cycle->new( {values => [qw(red white blue)]} );
149             print $color->next; # red
150             print $color->next; # white
151             $color->reset;
152             print $color->next; # red, not blue
153              
154             =cut
155              
156             sub reset {
157 8     8 1 17 my $self = shift;
158              
159 8         22 $self->_store_pointer(0);
160              
161 8         12 return;
162             }
163              
164             =head2 $cycle->dump
165              
166             Returns a handy string representation of internals.
167              
168             =cut
169              
170             sub dump {
171 1     1 1 594 my $self = shift;
172 1         2 my $str = '';
173              
174 1         8 while ( my($key,$value) = each %storage ) {
175 2         5 my $realval = $value->{$self};
176 2 100       9 $realval = join( ',', @{$realval} ) if UNIVERSAL::isa( $realval, 'ARRAY' );
  1         5  
177 2         11 $str .= "$key => $realval\n";
178             }
179 1         8 return $str;
180             }
181              
182             =head2 $cycle->next
183              
184             Gives the next value in the sequence.
185              
186             =cut
187              
188             sub next {
189 24     24 1 2334 my $self = shift;
190              
191 24 100       166 Carp::croak( 'no cycle values provided!' ) unless $values_of{ $self };
192              
193 23         88 my $ptr = $self->_pointer;
194 23         56 $self->_inc_pointer;
195 23         94 return $values_of{ $self }[$ptr];
196             }
197              
198             =head1 AUTHOR
199              
200             Andy Lester, C<< >>
201              
202             =head1 SUPPORT
203              
204             You can find documentation for this module with the perldoc command.
205              
206             perldoc List::Cycle
207              
208             You can also look for information at:
209              
210             =over 4
211              
212             =item * Project home page and source code repository
213              
214             L
215              
216             =item * Issue tracker
217              
218             L
219              
220             =back
221              
222             =head1 BUGS
223              
224             Please report any bugs or feature requests at
225             L.
226              
227             =head1 ACKNOWLEDGEMENTS
228              
229             List::Cycle is a playground that uses some of the ideas in Damian Conway's
230             marvelous I. L
231             One of the chapters mentions a mythical List::Cycle module, so I made
232             it real.
233              
234             Thanks also to Ricardo SIGNES and Todd Rinaldo for patches.
235              
236             =head1 COPYRIGHT & LICENSE
237              
238             Copyright 2005-2012 Andy Lester.
239              
240             This program is free software; you can redistribute it and/or modify
241             it under the terms of the Artistic License v2.0.
242              
243             =cut
244              
245             1; # End of List::Cycle