File Coverage

blib/lib/Cache/Memory/Entry.pm
Criterion Covered Total %
statement 126 128 98.4
branch 40 50 80.0
condition 9 11 81.8
subroutine 21 21 100.0
pod 6 7 85.7
total 202 217 93.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Cache::Memory::Entry - An entry in the memory based implementation of Cache
4              
5             =head1 SYNOPSIS
6              
7             See 'Cache::Entry' for a synopsis.
8              
9             =head1 DESCRIPTION
10              
11             This module implements a version of Cache::Entry for the Cache::Memory variant
12             of Cache. It should not be created or used directly, please see
13             'Cache::Memory' or 'Cache::Entry' instead.
14              
15             =cut
16             package Cache::Memory::Entry;
17              
18             require 5.006;
19 6     6   26 use strict;
  6         6  
  6         185  
20 6     6   21 use warnings;
  6         6  
  6         146  
21 6     6   35 use Cache::Memory;
  6         7  
  6         104  
22 6     6   3083 use Storable;
  6         14732  
  6         381  
23 6     6   36 use Carp;
  6         6  
  6         339  
24              
25 6     6   32 use base qw(Cache::Entry);
  6         8  
  6         2597  
26 6     6   37 use fields qw(store_entry);
  6         7  
  6         25  
27              
28             our $VERSION = '2.11';
29              
30              
31             sub new {
32 241     241 0 227 my Cache::Memory::Entry $self = shift;
33 241         253 my ($cache, $key, $entry) = @_;
34              
35 241 50       630 $self = fields::new($self) unless ref $self;
36 241         12139 $self->SUPER::new($cache, $key);
37              
38 241         267 $self->{store_entry} = $entry;
39              
40             # increment the reference count for the entry
41 241         345 $entry->{rc}++;
42              
43 241         636 return $self;
44             }
45              
46             sub DESTROY {
47 241     241   2896 my Cache::Memory::Entry $self = shift;
48              
49             # drop the reference count and signal the cache if required
50 241 100       552 unless (--$self->{store_entry}->{rc}) {
51 238         498 $self->{cache}->entry_dropped_final_rc($self->{key});
52             }
53             }
54              
55             sub exists {
56 74     74 1 102 my Cache::Memory::Entry $self = shift;
57              
58             # ensure pending expiries are removed
59 74         181 $self->{cache}->purge();
60              
61 74         576 return defined $self->{store_entry}->{data};
62             }
63              
64             sub _set {
65 247     247   225 my Cache::Memory::Entry $self = shift;
66 247         318 my ($data, $expiry) = @_;
67              
68 247         253 my $cache = $self->{cache};
69 247         254 my $key = $self->{key};
70 247         240 my $entry = $self->{store_entry};
71              
72 247         251 my $exists = defined $entry->{data};
73 247         193 my $orig_size;
74              
75 247 100       320 unless ($exists) {
    100          
76             # we're creating the element
77 244         258 my $time = time();
78              
79 244         458 $entry->{age_elem} = $cache->add_age_to_heap($key, $time);
80 244         441 $entry->{use_elem} = $cache->add_use_to_heap($key, $time);
81 244         250 $orig_size = 0;
82             }
83             elsif (not exists $entry->{handlelock}) {
84             # only remove current size if there is no active handle
85 2         3 $orig_size = length(${$entry->{data}});
  2         4  
86             }
87             else {
88 1         2 $orig_size = 0;
89             }
90              
91 247         293 $entry->{data} = \$data;
92              
93             # invalidate any active handles
94 247         266 delete $entry->{handlelock};
95              
96 247 100 100     862 $self->_set_expiry($expiry) if $expiry or $exists;
97 247 100       361 $cache->update_last_used($key) if $exists;
98              
99 247         606 $cache->change_size(length($data) - $orig_size);
100             # ensure pending expiries are removed;
101 247         472 $cache->purge();
102             }
103              
104             sub _get {
105 17     17   17 my Cache::Memory::Entry $self = shift;
106              
107 17 100       36 $self->exists() or return undef;
108              
109 14         28 my $entry = $self->{store_entry};
110              
111 14 50       29 $entry->{handlelock}
112             and warnings::warnif('Cache', 'get called whilst write handle is open');
113              
114 14         37 $self->{cache}->update_last_used($self->{key});
115              
116 14         46 return ${$self->{store_entry}->{data}};
  14         38  
117             }
118              
119             sub size {
120 6     6 1 10 my Cache::Memory::Entry $self = shift;
121 6 100       20 defined $self->{store_entry}->{data}
122             or return undef;
123 5         5 return length(${$self->{store_entry}->{data}});
  5         28  
124             }
125              
126             sub remove {
127 27     27 1 34 my Cache::Memory::Entry $self = shift;
128             # send remove request directly to cache object
129 27         77 return $self->{cache}->remove($self->{key});
130             }
131              
132             sub expiry {
133 2     2 1 4 my Cache::Memory::Entry $self = shift;
134 2 50       5 $self->exists() or return undef;
135 2 50       7 my $exp_elem = $self->{store_entry}->{exp_elem}
136             or return undef;
137 2         5 return $exp_elem->val();
138             }
139              
140             sub _set_expiry {
141 6     6   9 my Cache::Memory::Entry $self = shift;
142 6         9 my ($time) = @_;
143              
144 6         11 my $cache = $self->{cache};
145 6         10 my $entry = $self->{store_entry};
146              
147 6 50       17 defined $entry->{data}
148             or croak "Cannot set expiry on non-existant entry: $self->{key}";
149              
150 6         11 my $exp_elem = $entry->{exp_elem};
151              
152 6 50       17 if ($exp_elem) {
153 0         0 $cache->del_expiry_from_heap($self->{key}, $exp_elem);
154 0         0 $entry->{exp_elem} = undef;
155             }
156              
157 6 100       13 return unless $time;
158 3         13 $entry->{exp_elem} = $cache->add_expiry_to_heap($self->{key}, $time);
159             }
160              
161             # create a handle. The entry is 'locked' via the use of a 'handlelock'
162             # element. The current data reference is reset to an empty string whilst the
163             # handle is active to allow set and remove to work correctly without
164             # corrupting size tracking. If set or remove are used to change the entry,
165             # this is detected when the handle is closed again and the size is adjusted
166             # (downwards) and the original data discarded.
167             sub _handle {
168 7     7   9 my Cache::Memory::Entry $self = shift;
169 7         6 my ($mode, $expiry) = @_;
170              
171 7         464 require Cache::IOString;
172              
173 7         32 my $writing = $mode =~ />|\+/;
174 7         63 my $entry = $self->{store_entry};
175              
176             # set the entry to a empty string if the entry doesn't exist or
177             # should be truncated
178 7 100 66     34 if (not defined $entry->{data} or $mode =~ /^\+?>$/) {
179             # return undef unless we're writing to the string
180 2 100       9 $writing or return undef;
181 1         3 $self->_set('', $expiry);
182             }
183             else {
184 5         19 $self->{cache}->update_last_used($self->{key});
185             }
186              
187 6         21 my $dataref = $entry->{data};
188              
189 6 100       9 if ($writing) {
190 4 50       11 exists $entry->{handlelock}
191             and croak "Write handle already active for this entry";
192              
193 4         5 my $orig_size = length($$dataref);
194              
195             # replace data with empty string whilst handle is active
196 4         5 $entry->{handlelock} = $dataref;
197              
198             return Cache::IOString->new($dataref, $mode,
199 4     4   25 sub { $self->_handle_closed(shift, $orig_size); });
  4         11  
200             }
201             else {
202 2         15 return Cache::IOString->new($dataref, $mode);
203             }
204             }
205              
206             sub validity {
207 3     3 1 4 my Cache::Memory::Entry $self = shift;
208 3 50       6 $self->exists() or return undef;
209 3         7 my $validity = $self->{store_entry}->{validity};
210             # return a clone of the validity if it's a reference
211 3 100       82 return Storable::dclone($validity) if ref($validity);
212 1         4 return $validity;
213             }
214              
215             sub set_validity {
216 3     3 1 5 my Cache::Memory::Entry $self = shift;
217 3         3 my ($data) = @_;
218              
219 3         4 my $entry = $self->{store_entry};
220              
221             # ensure data is not undefined
222 3 100       5 unless (defined $entry->{data}) {
223 1         3 $self->set('');
224             }
225              
226 3         10 $entry->{validity} = $data;
227             }
228              
229              
230             # UTILITY METHODS
231              
232             sub _handle_closed {
233 4     4   4 my Cache::Memory::Entry $self = shift;
234 4         5 my ($iostring, $orig_size) = @_;
235 4   100     12 $orig_size ||= 0;
236              
237 4         12 my $dataref = $iostring->sref();
238 4         14 my $entry = $self->{store_entry};
239              
240             # ensure the data hasn't been removed or been replaced
241 4         7 my $removed = !$self->exists();
242              
243             # check our handle marker
244 4 100 66     18 if (defined $entry->{handlelock} and $entry->{handlelock} == $dataref) {
245 2         4 delete $entry->{handlelock};
246             }
247             else {
248 2         3 $removed = 1;
249             }
250              
251 4 100       6 if ($removed) {
252             # remove original size and discard dataref
253 2 50       9 $self->{cache}->change_size(-$orig_size) if $orig_size;
254 2         4 return;
255             }
256              
257             # reinsert data
258 2         4 $entry->{data} = $dataref;
259 2         3 my $new_size = length(${$entry->{data}});
  2         5  
260 2 50       10 if ($orig_size != $new_size) {
261 2         10 $self->{cache}->change_size($new_size - $orig_size);
262             }
263             }
264              
265              
266             1;
267             __END__