File Coverage

blib/lib/Array/Circular.pm
Criterion Covered Total %
statement 76 84 90.4
branch 26 30 86.6
condition 8 9 88.8
subroutine 17 20 85.0
pod 13 13 100.0
total 140 156 89.7


line stmt bran cond sub pod time code
1 3     3   17094 use strict;
  3         6  
  3         108  
2 3     3   32 use warnings;
  3         5  
  3         289  
3             package Array::Circular;
4             our $VERSION=0.009;
5             # ABSTRACT: Provide an array data structure that can go around in circles
6              
7 3     3   18 use Carp;
  3         10  
  3         272  
8 3     3   38 use Scalar::Util qw/refaddr/;
  3         6  
  3         431  
9 3     3   1890 use Storable qw/dclone/;
  3         13848  
  3         3277  
10              
11             my %DATA;
12              
13             sub new {
14 113     113 1 958281 my ($class, @self) = @_;
15 113         295 my $self = bless \@self, $class;
16 113         523 $self->me( { current => 0, count => 0 } );
17 113         239 return $self;
18             }
19              
20             sub clone {
21 110     110 1 82327 my ($self) = @_;
22 110         244 my $class = ref $self;
23 110         373 my $new = $class->new(@$self);
24 110         255 $new->index($self->index);
25 110         270 $new->loops($self->loops);
26 110         256 return $new;
27             }
28              
29             sub me {
30 4222     4222 1 6120 my ($self, $args) = @_;
31 4222         4847 my $loc = refaddr $self;
32 4222 100       6366 $DATA{$loc} = $args if $args;
33 4222         9188 return $DATA{$loc};
34             }
35              
36             sub current {
37 28     28 1 11106 my ($self) = @_;
38 28         83 return $self->[ $self->me->{current} ];
39             }
40              
41             *curr = \¤t;
42              
43             sub index {
44 555     555 1 79975 my ($self, $idx) = @_;
45 555 100       1234 $self->me->{current} = $idx if defined $idx;
46 555         856 return $self->me->{current};
47             }
48              
49             sub loops {
50 459     459 1 767 my ($self, $new_ct) = @_;
51 459 100       1148 $self->me->{count} = $new_ct if defined $new_ct;
52 459         858 return $self->me->{count};
53             }
54              
55             sub next {
56 601     601 1 55538 my ($self, $num) = @_;
57 601 100       1082 return unless @$self;
58 591 50 66     1333 return $self->current if defined $num && $num == 0; # undefined just goes next. zero gives current.
59 591 100 100     1538 if ($num && $num < 0) {
    100          
60 2         10 $self->previous(1 + abs $num);
61             }
62             elsif ($num) {
63 103         131 $num--;
64 103         386 $self->next for 1 .. $num; # This is inefficient but simple. Could use $self->me to compute where we are as optimisation
65             }
66              
67 591         570 my $last_index = $#{$self};
  591         771  
68 591 100       949 if ( $self->me->{current} == $last_index ) {
69 126         218 $self->me->{current} = -1;
70 126         213 $self->me->{count}++;
71             }
72 591         811 return $self->[ ++ $self->me->{current} ];
73             }
74              
75             sub previous {
76 573     573 1 11998 my ($self, $num) = @_;
77 573 50       856 return unless @$self;
78              
79 573 100 100     1184 if ($num && $num < 0) {
    100          
80 2         7 $self->next(1 + abs $num);
81             }
82             elsif ($num) {
83 103         127 $num--;
84 103         282 $self->previous for 1 .. $num; # This is inefficient but simple. Could use $self->me to compute where we are as optimisation
85             }
86              
87 573 100       807 if ( $self->me->{current} == 0 ) {
88 116         206 $self->me->{current} = scalar(@$self);
89 116         204 $self->me->{count}--;
90              
91             }
92 573         731 return $self->[ -- $self->me->{current} ];
93             }
94              
95             *prev = \&previous;
96              
97             sub reset {
98 2     2 1 11 my ($self) = @_;
99 2         8 $self->me->{current} = 0;
100 2         6 $self->me->{count} = 0;
101 2         8 return $self->current;
102             }
103              
104             sub _current_and_action {
105 0     0   0 my ($self, $action) = @_;
106 0         0 my $c = $self->current;
107 0         0 $self->$action;
108 0         0 return $c
109             }
110              
111             sub current_and_next {
112 0     0 1 0 my ($self) = @_;
113 0         0 return $self->_current_and_action('next');
114             }
115              
116             *curr_and_next = \¤t_and_next;
117              
118             sub current_and_previous {
119 0     0 1 0 my ($self) = @_;
120 0         0 return $self->_current_and_action('previous');
121             }
122              
123             *curr_and_prev = \&curr_and_prev;
124              
125             sub peek {
126 110     110 1 571 my ($self, $count) = @_;
127 110 100       325 return $self->current if $count == 0;
128 100 50       326 my $meth = $count > 0 ? 'next': 'prev';
129 100 50       230 my $undo = $count > 0 ? 'prev': 'next';
130 100         162 $count = abs $count;
131 100         320 my $val = $self->$meth($count);
132 100         319 $self->$undo($count);
133 100         262 return $val;
134             }
135              
136             sub size {
137 121     121 1 10916 my ($self ) = @_;
138 121         296 return scalar @$self;
139             }
140              
141              
142              
143             sub DESTROY {
144 113     113   92496 my $self = shift;
145 113         1033 delete $DATA{refaddr $self};
146             }
147              
148             1;
149              
150             __END__