File Coverage

blib/lib/Array/Circular.pm
Criterion Covered Total %
statement 76 84 90.4
branch 25 30 83.3
condition 2 3 66.6
subroutine 17 20 85.0
pod 13 13 100.0
total 133 150 88.6


line stmt bran cond sub pod time code
1 3     3   1311 use strict;
  3         17  
  3         83  
2 3     3   14 use warnings;
  3         10  
  3         101  
3             package Array::Circular;
4             # ABSTRACT: Provide an array data structure that can go around in circles
5              
6 3     3   14 use Carp;
  3         5  
  3         303  
7 3     3   24 use Scalar::Util qw/refaddr/;
  3         7  
  3         423  
8 3     3   1902 use Storable qw/dclone/;
  3         9820  
  3         2796  
9              
10             my %DATA;
11              
12             sub new {
13 113     113 1 701 my ($class, @self) = @_;
14 113         241 my $self = bless \@self, $class;
15 113         478 $self->me( { current => 0, count => 0 } );
16 113         215 return $self;
17             }
18              
19             sub clone {
20 110     110 1 64382 my ($self) = @_;
21 110         245 my $class = ref $self;
22 110         278 my $new = $class->new(@$self);
23 110         273 $new->index($self->index);
24 110         213 $new->loops($self->loops);
25 110         226 return $new;
26             }
27              
28             sub me {
29 4180     4180 1 6681 my ($self, $args) = @_;
30 4180         6367 my $loc = refaddr $self;
31 4180 100       7157 $DATA{$loc} = $args if $args;
32 4180         8855 return $DATA{$loc};
33             }
34              
35             sub current {
36 23     23 1 4740 my ($self) = @_;
37 23         59 return $self->[ $self->me->{current} ];
38             }
39              
40             *curr = \¤t;
41              
42             sub index {
43 550     550 1 72828 my ($self, $idx) = @_;
44 550 100       1178 $self->me->{current} = $idx if defined $idx;
45 550         903 return $self->me->{current};
46             }
47              
48             sub loops {
49 459     459 1 773 my ($self, $new_ct) = @_;
50 459 100       908 $self->me->{count} = $new_ct if defined $new_ct;
51 459         745 return $self->me->{count};
52             }
53              
54             sub next {
55 595     595 1 28557 my ($self, $num) = @_;
56 595 100       1080 return unless @$self;
57 585 50 66     1254 return $self->current if defined $num && $num == 0; # undefined just goes next. zero gives current.
58 585 100       981 if ($num) {
59 102 100       224 croak "Calls to next with a count of how many to go forward must be a positive number" if $num < 0;
60 101         142 $num--;
61 101         292 $self->next for 1 .. $num; # This is inefficient but simple. Could use $self->me to compute where we are as optimisation
62             }
63              
64              
65 584         723 my $last_index = $#{$self};
  584         1016  
66 584 100       978 if ( $self->me->{current} == $last_index ) {
67 125         213 $self->me->{current} = -1;
68 125         213 $self->me->{count}++;
69             }
70 584         987 return $self->[ ++ $self->me->{current} ];
71             }
72              
73             sub previous {
74 566     566 1 4058 my ($self, $num) = @_;
75 566 50       937 return unless @$self;
76              
77 566 100       929 if ($num) {
78 101 50       204 croak "Calls to next with a count of how many to go forward must be a positive number" if $num < 0;
79 101         124 $num--;
80 101         224 $self->previous for 1 .. $num; # This is inefficient but simple. Could use $self->me to compute where we are as optimisation
81             }
82              
83 566 100       783 if ( $self->me->{current} == 0 ) {
84 115         248 $self->me->{current} = scalar(@$self);
85 115         179 $self->me->{count}--;
86              
87             }
88 566         953 return $self->[ -- $self->me->{current} ];
89             }
90              
91             *prev = \&previous;
92              
93             sub reset {
94 2     2 1 12 my ($self) = @_;
95 2         6 $self->me->{current} = 0;
96 2         6 $self->me->{count} = 0;
97 2         6 return $self->current;
98             }
99              
100             sub _current_and_action {
101 0     0   0 my ($self, $action) = @_;
102 0         0 my $c = $self->current;
103 0         0 $self->$action;
104 0         0 return $c
105             }
106              
107             sub current_and_next {
108 0     0 1 0 my ($self) = @_;
109 0         0 return $self->_current_and_action('next');
110             }
111              
112             *curr_and_next = \¤t_and_next;
113              
114             sub current_and_previous {
115 0     0 1 0 my ($self) = @_;
116 0         0 return $self->_current_and_action('previous');
117             }
118              
119             *curr_and_prev = \&curr_and_prev;
120              
121             sub peek {
122 110     110 1 479 my ($self, $count) = @_;
123 110 100       292 return $self->current if $count == 0;
124 100 50       258 my $meth = $count > 0 ? 'next': 'prev';
125 100 50       167 my $undo = $count > 0 ? 'prev': 'next';
126 100         146 $count = abs $count;
127 100         299 my $val = $self->$meth($count);
128 100         277 $self->$undo($count);
129 100         226 return $val;
130             }
131              
132             sub size {
133 121     121 1 8093 my ($self ) = @_;
134 121         290 return scalar @$self;
135             }
136              
137              
138              
139             sub DESTROY {
140 113     113   68443 my $self = shift;
141 113         1052 delete $DATA{refaddr $self};
142             }
143              
144             1;
145              
146             __END__