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__ |