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