1=head1 NAME
2
3Cache::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
11This module implements a version of Cache::Entry for the Cache::Memory variant
12of Cache.  It should not be created or used directly, please see
13'Cache::Memory' or 'Cache::Entry' instead.
14
15=cut
16package Cache::Memory::Entry;
17
18require 5.006;
19use strict;
20use warnings;
21use Cache::Memory;
22use Storable;
23use Carp;
24
25use base qw(Cache::Entry);
26use fields qw(store_entry);
27
28our $VERSION = '2.11';
29
30
31sub new {
32    my Cache::Memory::Entry $self = shift;
33    my ($cache, $key, $entry) = @_;
34
35    $self = fields::new($self) unless ref $self;
36    $self->SUPER::new($cache, $key);
37
38    $self->{store_entry} = $entry;
39
40    # increment the reference count for the entry
41    $entry->{rc}++;
42
43    return $self;
44}
45
46sub DESTROY {
47    my Cache::Memory::Entry $self = shift;
48
49    # drop the reference count and signal the cache if required
50    unless (--$self->{store_entry}->{rc}) {
51        $self->{cache}->entry_dropped_final_rc($self->{key});
52    }
53}
54
55sub exists {
56    my Cache::Memory::Entry $self = shift;
57
58    # ensure pending expiries are removed
59    $self->{cache}->purge();
60
61    return defined $self->{store_entry}->{data};
62}
63
64sub _set {
65    my Cache::Memory::Entry $self = shift;
66    my ($data, $expiry) = @_;
67
68    my $cache = $self->{cache};
69    my $key = $self->{key};
70    my $entry = $self->{store_entry};
71
72    my $exists = defined $entry->{data};
73    my $orig_size;
74
75    unless ($exists) {
76        # we're creating the element
77        my $time = time();
78
79        $entry->{age_elem} = $cache->add_age_to_heap($key, $time);
80        $entry->{use_elem} = $cache->add_use_to_heap($key, $time);
81        $orig_size = 0;
82    }
83    elsif (not exists $entry->{handlelock}) {
84        # only remove current size if there is no active handle
85        $orig_size = length(${$entry->{data}});
86    }
87    else {
88        $orig_size = 0;
89    }
90
91    $entry->{data} = \$data;
92
93    # invalidate any active handles
94    delete $entry->{handlelock};
95
96    $self->_set_expiry($expiry) if $expiry or $exists;
97    $cache->update_last_used($key) if $exists;
98
99    $cache->change_size(length($data) - $orig_size);
100    # ensure pending expiries are removed;
101    $cache->purge();
102}
103
104sub _get {
105    my Cache::Memory::Entry $self = shift;
106
107    $self->exists() or return undef;
108
109    my $entry = $self->{store_entry};
110
111    $entry->{handlelock}
112        and warnings::warnif('Cache', 'get called whilst write handle is open');
113
114    $self->{cache}->update_last_used($self->{key});
115
116    return ${$self->{store_entry}->{data}};
117}
118
119sub size {
120    my Cache::Memory::Entry $self = shift;
121    defined $self->{store_entry}->{data}
122        or return undef;
123    return length(${$self->{store_entry}->{data}});
124}
125
126sub remove {
127    my Cache::Memory::Entry $self = shift;
128    # send remove request directly to cache object
129    return $self->{cache}->remove($self->{key});
130}
131
132sub expiry {
133    my Cache::Memory::Entry $self = shift;
134    $self->exists() or return undef;
135    my $exp_elem = $self->{store_entry}->{exp_elem}
136        or return undef;
137    return $exp_elem->val();
138}
139
140sub _set_expiry {
141    my Cache::Memory::Entry $self = shift;
142    my ($time) = @_;
143
144    my $cache = $self->{cache};
145    my $entry = $self->{store_entry};
146
147    defined $entry->{data}
148        or croak "Cannot set expiry on non-existant entry: $self->{key}";
149
150    my $exp_elem = $entry->{exp_elem};
151
152    if ($exp_elem) {
153        $cache->del_expiry_from_heap($self->{key}, $exp_elem);
154        $entry->{exp_elem} = undef;
155    }
156
157    return unless $time;
158    $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.
167sub _handle {
168    my Cache::Memory::Entry $self = shift;
169    my ($mode, $expiry) = @_;
170
171    require Cache::IOString;
172
173    my $writing = $mode =~ />|\+/;
174    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    if (not defined $entry->{data} or $mode =~ /^\+?>$/) {
179        # return undef unless we're writing to the string
180        $writing or return undef;
181        $self->_set('', $expiry);
182    }
183    else {
184        $self->{cache}->update_last_used($self->{key});
185    }
186
187    my $dataref = $entry->{data};
188
189    if ($writing) {
190        exists $entry->{handlelock}
191            and croak "Write handle already active for this entry";
192
193        my $orig_size = length($$dataref);
194
195        # replace data with empty string whilst handle is active
196        $entry->{handlelock} = $dataref;
197
198        return Cache::IOString->new($dataref, $mode,
199            sub { $self->_handle_closed(shift, $orig_size); });
200    }
201    else {
202        return Cache::IOString->new($dataref, $mode);
203    }
204}
205
206sub validity {
207    my Cache::Memory::Entry $self = shift;
208    $self->exists() or return undef;
209    my $validity = $self->{store_entry}->{validity};
210    # return a clone of the validity if it's a reference
211    return Storable::dclone($validity) if ref($validity);
212    return $validity;
213}
214
215sub set_validity {
216    my Cache::Memory::Entry $self = shift;
217    my ($data) = @_;
218
219    my $entry = $self->{store_entry};
220
221    # ensure data is not undefined
222    unless (defined $entry->{data}) {
223    	$self->set('');
224    }
225
226    $entry->{validity} = $data;
227}
228
229
230# UTILITY METHODS
231
232sub _handle_closed {
233    my Cache::Memory::Entry $self = shift;
234    my ($iostring, $orig_size) = @_;
235    $orig_size ||= 0;
236
237    my $dataref = $iostring->sref();
238    my $entry = $self->{store_entry};
239
240    # ensure the data hasn't been removed or been replaced
241    my $removed = !$self->exists();
242
243    # check our handle marker
244    if (defined $entry->{handlelock} and $entry->{handlelock} == $dataref) {
245        delete $entry->{handlelock};
246    }
247    else {
248        $removed = 1;
249    }
250
251    if ($removed) {
252        # remove original size and discard dataref
253        $self->{cache}->change_size(-$orig_size) if $orig_size;
254        return;
255    }
256
257    # reinsert data
258    $entry->{data} = $dataref;
259    my $new_size = length(${$entry->{data}});
260    if ($orig_size != $new_size) {
261        $self->{cache}->change_size($new_size - $orig_size);
262    }
263}
264
265
2661;
267__END__
268
269=head1 SEE ALSO
270
271Cache::Entry, Cache::Memory
272
273=head1 AUTHOR
274
275 Chris Leishman <chris@leishman.org>
276 Based on work by DeWitt Clinton <dewitt@unto.net>
277
278=head1 COPYRIGHT
279
280 Copyright (C) 2003-2006 Chris Leishman.  All Rights Reserved.
281
282This module is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND,
283either expressed or implied. This program is free software; you can
284redistribute or modify it under the same terms as Perl itself.
285
286$Id: Entry.pm,v 1.8 2006/01/31 15:23:58 caleishm Exp $
287
288=cut
289