File Coverage

blib/lib/Cache/Memory/Simple/ID.pm
Criterion Covered Total %
statement 39 45 86.6
branch 10 12 83.3
condition 6 6 100.0
subroutine 11 12 91.6
pod 9 9 100.0
total 75 84 89.2


line stmt bran cond sub pod time code
1             package Cache::Memory::Simple::ID;
2 3     3   137372 use strict;
  3         9  
  3         77  
3 3     3   16 use warnings;
  3         6  
  3         79  
4 3     3   2539 use Time::HiRes;
  3         4698  
  3         15  
5              
6             our $VERSION = '0.02';
7              
8             sub new {
9 7     7 1 8881 my ($class) = @_;
10              
11 7         28 bless +[], $class;
12             }
13              
14             sub get {
15 19     19 1 400469 my $val = $_[0]->[$_[1]];
16 19 100 100     116 if ($val && defined $val->[0]) {
17 6 100       37 if ($val->[0] > Time::HiRes::time() ) {
18 4         50 return $val->[1];
19             } else {
20 2         18 $_[0]->[$_[1]] = undef; # remove expired data
21 2         23 return undef; ## no critic
22             }
23             } else {
24 13         59 return $val->[1];
25             }
26             }
27              
28             sub get_or_set {
29 0     0 1 0 my ($self, $id, $code, $expiration) = @_;
30              
31 0 0       0 if (my $val = $self->get($id)) {
32 0         0 return $val;
33             } else {
34 0         0 my $val = $code->();
35 0         0 $self->set($id, $val, $expiration);
36 0         0 return $val;
37             }
38             }
39              
40             sub set {
41 10     10 1 35 my ($self, $id, $val, $expiration) = @_;
42              
43 10 100       52 $self->[$id] = [defined($expiration)
44             ? $expiration + Time::HiRes::time()
45             : undef,
46             $val];
47 10         53 return $val;
48             }
49              
50             sub delete :method {
51 3     3 1 4 my ($self, $id) = @_;
52 3         9 $self->[$id] = undef;
53             }
54 1     1 1 4 sub remove { shift->delete(@_) } # alias
55              
56             sub delete_all {
57 1     1 1 5 @{$_[0]} = ();
  1         4  
58 1         2 return;
59             }
60              
61             sub purge {
62 1     1 1 2 my $self = shift;
63              
64 1         1 my $id;
65 1         2 for ($id = 0; $id < $#{$self}; $id++) {
  79         184  
66 78 100 100     183 if (defined($self->[$id]) && $self->[$id][0] < Time::HiRes::time() ) {
67 1         12 $self->delete($id);
68             }
69             }
70             }
71              
72             sub count {
73 2     2 1 3 my $self = shift;
74              
75 2         3 my $count = 0;
76 2         3 for my $id (@{$self}) {
  2         7  
77 158 100       397 $count++ if ref($id) eq 'ARRAY';
78             }
79              
80 2         7 return $count;
81             }
82              
83             1;
84              
85             __END__