1
package Jifty::DBI::Record::Cachable;
3
use base qw(Jifty::DBI::Record);
5
use Jifty::DBI::Handle;
7
use Cache::Simple::TimedExpiry;
8
use Scalar::Util qw/ blessed /;
15
Jifty::DBI::Record::Cachable - records with caching behavior
20
use base qw/Jifty::DBI::Record::Cachable/;
24
This module subclasses the main L<Jifty::DBI::Record> package to add a
27
The public interface remains the same, except that records which have
28
been loaded in the last few seconds may be reused by subsequent fetch
29
or load methods without retrieving them from the database.
40
$_CACHES{$cache} = Cache::Simple::TimedExpiry->new();
41
$_CACHES{$cache}->expire_after( $self->_cache_config->{'cache_for_sec'} );
46
This class method flushes the _global_ Jifty::DBI::Record::Cachable
47
cache. All caches are immediately expired.
57
my $cache = $self->_handle->dsn
59
. ( $self->{'_class'} ||= ref($self) );
60
$self->_setup_cache($cache) unless exists( $_CACHES{$cache} );
61
return ( $_CACHES{$cache} );
65
=head2 _flush_key_cache
67
Blow away this record type's key cache
71
sub _flush_key_cache {
73
my $cache = $self->_handle->dsn
75
. ( $self->{'_class'} ||= ref($self) );
76
$self->_setup_cache($cache);
82
= $self->_handle->dsn . "--" . ( $self->{'_class'} ||= ref($self) );
83
$self->_setup_cache($cache) unless exists( $_CACHES{$cache} );
84
return ( $_CACHES{$cache} );
90
Overrides the implementation from L<Jifty::DBI::Record> to add caching.
101
# Blow away the primary cache key since we're loading.
102
$self->{'_jifty_cache_pkey'} = undef;
103
( $rvalue, $msg ) = $self->SUPER::load_from_hash(@_);
105
## Check the return value, if its good, cache it!
106
$self->_store() if ($rvalue);
107
return ( $rvalue, $msg );
108
} else { # Called as a class method;
109
$self = $self->SUPER::load_from_hash(@_);
110
## Check the return value, if its good, cache it!
111
$self->_store() if ( $self->id );
119
Overrides the implementation from L<Jifty::DBI::Record> to add caching.
124
my ( $class, %attr ) = @_;
128
( $self, $class ) = ( $class, undef );
131
handle => ( delete $attr{'_handle'} || undef ) );
134
## Generate the cache key
135
my $alt_key = $self->_gen_record_cache_key(%attr);
136
if ( $self->_fetch($alt_key) ) {
137
if ($class) { return $self }
138
else { return ( 1, "Fetched from cache" ) }
141
# Blow away the primary cache key since we're loading.
142
$self->{'_jifty_cache_pkey'} = undef;
144
## Fetch from the DB!
145
my ( $rvalue, $msg ) = $self->SUPER::load_by_cols(%attr);
146
## Check the return value, if its good, cache it!
148
## Only cache the object if its okay to do so.
150
$self->_key_cache->set(
151
$alt_key => $self->_primary_record_cache_key );
154
if ($class) { return $self }
156
return ( $rvalue, $msg );
161
# Type : (overloaded) public instance
162
# Args : see Jifty::DBI::Record::_Set
169
return $self->SUPER::__set(@_);
174
# Type : (overloaded) public instance
182
return $self->SUPER::__delete(@_);
187
# Type : private instance
188
# Args : string(cache_key)
190
# Desc : Removes this object from the cache.
194
$self->_record_cache->set( $self->_primary_record_cache_key, undef, time - 1 );
196
# We should be doing something more surgical to clean out the key cache. but we do need to expire it
197
$self->_flush_key_cache;
202
# Type : private instance
203
# Args : string(cache_key)
205
# Desc : Get an object from the cache, and make this object that.
208
my ( $self, $cache_key ) = @_;
209
# If the alternate key is really the primary one
212
my $data = $self->_record_cache->fetch($cache_key);
215
$cache_key = $self->_key_cache->fetch( $cache_key );
216
$data = $self->_record_cache->fetch( $cache_key ) if $cache_key;
219
return undef unless ($data);
221
@{$self}{ keys %$data } = values %$data; # deserialize
229
# my $column = shift;
231
# # XXX TODO, should we be fetching directly from the cache?
232
# return ( $self->SUPER::__value($column) );
236
# Type : private instance
237
# Args : string(cache_key)
239
# Desc : Stores this object in the cache.
243
$self->_record_cache->set( $self->_primary_record_cache_key,
244
{ values => $self->{'values'},
245
table => $self->table,
246
fetched => $self->{'fetched'},
247
decoded => $self->{'decoded'},
253
# Function: _gen_record_cache_key
254
# Type : private instance
257
# Desc : Takes a perl hash and generates a key from it.
259
sub _gen_record_cache_key {
260
my ( $self, %attr ) = @_;
264
while ( my ( $key, $value ) = each %attr ) {
265
unless ( defined $value ) {
266
push @cols, lc($key) . '=__undef';
268
elsif ( ref($value) eq "HASH" ) {
269
push @cols, lc($key) . ( $value->{operator} || '=' )
270
. defined $value->{value}? $value->{value}: '__undef';
272
elsif ( blessed $value and $value->isa('Jifty::DBI::Record') ) {
273
push @cols, lc($key) . '=' . ( $value->id );
276
push @cols, lc($key) . "=" . $value;
279
return ( $self->table() . ':' . join( ',', @cols ) );
282
# Function: _fetch_record_cache_key
283
# Type : private instance
287
sub _fetch_record_cache_key {
289
my $cache_key = $self->_cache_config->{'cache_key'};
293
# Function: _primary_record_cache_key
294
# Type : private instance
297
# Desc : generate a primary-key based variant of this object's cache key
298
# primary keys is in the cache
300
sub _primary_record_cache_key {
303
unless ( $self->{'_jifty_cache_pkey'} ) {
306
my %pk = $self->primary_keys;
307
while ( my ($key, $value) = each %pk ) {
308
return unless defined $value;
309
push @attributes, lc( $key ) . '=' . $value;
312
$self->{'_jifty_cache_pkey'} = $self->table .':'
313
. join ',', @attributes;
315
return ( $self->{'_jifty_cache_pkey'} );
321
You can override this method to change the duration of the caching
322
from the default of 5 seconds.
324
For example, to cache records for up to 30 seconds, add the following
325
method to your class:
328
{ 'cache_for_sec' => 30 }
335
'cache_for_sec' => 5,
346
Matt Knopp <mhat@netlag.com>
350
L<Jifty::DBI>, L<Jifty::DBI::Record>