File Coverage

blib/lib/Tie/Array/Expire.pm
Criterion Covered Total %
statement 44 84 52.3
branch 5 16 31.2
condition n/a
subroutine 10 15 66.6
pod n/a
total 59 115 51.3


line stmt bran cond sub pod time code
1             package Tie::Array::Expire;
2              
3             our $DATE = '2017-06-07'; # DATE
4             our $VERSION = '0.001'; # VERSION
5              
6 1     1   13398 use 5.010001;
  1         3  
7 1     1   4 use strict;
  1         2  
  1         21  
8 1     1   4 use warnings;
  1         2  
  1         25  
9              
10 1     1   432 use Time::HiRes 'time';
  1         1073  
  1         4  
11              
12             sub TIEARRAY {
13 1     1   18 my $class = shift;
14 1         22 my $expiry = shift;
15              
16 1 50       5 die "Please specify a positive expiry time" unless $expiry > 0;
17 1         9 return bless {
18             EXPIRY => $expiry,
19             ARRAY => [], # each elem is [val, time]
20             }, $class;
21             }
22              
23             sub _expire_items {
24 22     22   35 my $self = shift;
25              
26 22         68 my $time = time() - $self->{EXPIRY};
27 22         34 my $i = 0;
28 22         38 while (1) {
29 76 100       94 last if $i >= @{ $self->{ARRAY} };
  76         197  
30 54 100       125 if ($self->{ARRAY}[$i][1] < $time) {
31 4         8 splice @{ $self->{ARRAY} }, $i, 1;
  4         18  
32             } else {
33 50         75 $i++;
34             }
35             }
36             }
37              
38             sub FETCH {
39 10     10   23 my ($self, $index) = @_;
40 10         23 $self->_expire_items;
41 10         59 $self->{ARRAY}[$index][0];
42             }
43              
44             sub STORE {
45 0     0   0 my ($self, $index, $value) = @_;
46 0         0 $self->_expire_items;
47 0         0 my $time = time();
48 0 0       0 if ($index > @{ $self->{ARRAY} }) {
  0         0  
49 0         0 for my $i ($#{ $self->{ARRAY} } .. $index-1) {
  0         0  
50 0         0 $self->{ARRAY}[$i] = [undef, $time];
51             }
52             }
53 0         0 $self->{ARRAY}[$index] = [$value, $time];
54             }
55              
56             sub FETCHSIZE {
57 10     10   38 my $self = shift;
58 10         40 $self->_expire_items;
59 10         17 scalar @{ $self->{ARRAY} };
  10         71  
60             }
61              
62             sub STORESIZE {
63 0     0   0 my ($self, $count) = @_;
64 0         0 $self->_expire_items;
65 0         0 my $time = time();
66 0 0       0 if ($count > @{ $self->{ARRAY} }) {
  0 0       0  
67 0         0 for my $i ($#{ $self->{ARRAY} } .. $count) {
  0         0  
68 0         0 $self->{ARRAY}[$i] = [undef, $time];
69             }
70 0         0 } elsif ($count < @{ $self->{ARRAY} }) {
71 0         0 splice @{ $self->{ARRAY} }, $count;
  0         0  
72             }
73             }
74              
75             # sub EXTEND this, count
76              
77             # sub EXISTS this, key
78              
79             # sub DELETE this, key
80              
81             sub PUSH {
82 1     1   8 my $self = shift;
83 1         6 $self->_expire_items;
84 1         3 my $time = time();
85 1         2 push @{ $self->{ARRAY} }, map { [$_, $time] } @_;
  1         4  
  2         7  
86             }
87              
88             sub POP {
89 0     0   0 my $self = shift;
90 0         0 $self->_expire_items;
91 0         0 my $elem = pop @{ $self->{ARRAY} };
  0         0  
92 0 0       0 $elem ? $elem->[0] : undef;
93             }
94              
95             sub UNSHIFT {
96 1     1   3 my $self = shift;
97 1         4 $self->_expire_items;
98 1         3 my $time = time();
99 1         3 unshift @{ $self->{ARRAY} }, map { [$_, $time] } @_;
  1         3  
  2         8  
100             }
101              
102             sub SHIFT {
103 0     0     my $self = shift;
104 0           $self->_expire_items;
105 0           my $elem = shift @{ $self->{ARRAY} };
  0            
106 0 0         $elem ? $elem->[0] : undef;
107             }
108              
109             sub SPLICE {
110 0     0     my $self = shift;
111 0           my $offset = shift;
112 0           my $length = shift;
113 0           $self->_expire_items;
114 0           my $time = time();
115              
116 0           my @spliced = map { $_->[0] } splice @{ $self->{ARRAY} }, $offset, $length, map { [$_, $time] } @_;
  0            
  0            
  0            
117 0           @spliced;
118             }
119              
120             1;
121             # ABSTRACT: Array with expiring elements
122              
123             __END__