File Coverage

blib/lib/Tie/Cycle.pm
Criterion Covered Total %
statement 34 46 73.9
branch 3 6 50.0
condition n/a
subroutine 10 14 71.4
pod 3 3 100.0
total 50 69 72.4


line stmt bran cond sub pod time code
1             package Tie::Cycle;
2 4     4   892448 use strict;
  4         8  
  4         259  
3              
4             our $VERSION = '1.233';
5              
6 4     4   34 use Carp qw(carp);
  4         6  
  4         308  
7              
8 4     4   28 use constant CURSOR_COL => 0;
  4         7  
  4         390  
9 4     4   22 use constant COUNT_COL => 1;
  4         11  
  4         210  
10 4     4   41 use constant ITEM_COL => 2;
  4         14  
  4         2126  
11              
12             sub TIESCALAR {
13 2     2   420175 my( $class, $list_ref ) = @_;
14 2         8 my $self = bless [], $class;
15              
16 2 50       11 unless( $self->STORE( $list_ref ) ) {
17 0         0 carp "The argument to Tie::Cycle must be an array reference";
18 0         0 return;
19             }
20              
21 2         8 return $self;
22             }
23              
24             sub FETCH {
25 12     12   10078 my( $self ) = @_;
26              
27 12         33 my $index = $self->[CURSOR_COL]++;
28 12         33 $self->[CURSOR_COL] %= $self->_count;
29              
30 12         31 return $self->_item( $index );
31             }
32              
33             sub STORE {
34 2     2   6 my( $self, $list_ref ) = @_;
35 2 50       17 return unless ref $list_ref eq ref [];
36 2         7 my @shallow_copy = map { $_ } @$list_ref;
  4         15  
37              
38 2         12 $self->[CURSOR_COL] = 0;
39 2         7 $self->[COUNT_COL] = scalar @shallow_copy;
40 2         11 $self->[ITEM_COL] = \@shallow_copy;
41             }
42              
43 0     0 1 0 sub reset { $_[0]->[CURSOR_COL] = 0 }
44              
45             sub previous {
46 0     0 1 0 my( $self ) = @_;
47              
48 0         0 my $index = $self->_cursor - 1;
49 0         0 $self->[CURSOR_COL] %= $self->_count;
50              
51 0         0 return $self->_item( $index );
52             }
53              
54             sub next {
55 0     0 1 0 my( $self ) = @_;
56              
57 0         0 my $index = $self->_cursor + 1;
58 0         0 $self->[CURSOR_COL] %= $self->_count;
59              
60 0         0 return $self->_item( $index );
61             }
62              
63 0     0   0 sub _cursor { $_[0]->[CURSOR_COL] }
64 12     12   28 sub _count { $_[0]->[COUNT_COL] }
65             sub _item {
66 12     12   27 my( $self, $index ) = @_;
67 12 50       34 $index = defined $index ? $index : $self->_cursor;
68 12         55 $self->[ITEM_COL][ $index ]
69             }
70              
71             __PACKAGE__;
72              
73             __END__