4
package Jifty::DBI::Record::Memcached;
6
use Jifty::DBI::Record;
7
use Jifty::DBI::Handle;
8
use base qw (Jifty::DBI::Record);
15
Jifty::DBI::Record::Memcached - records with caching behavior
20
use base qw/Jifty::DBI::Record::Memcached/;
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 get
29
or load methods without retrieving them from the database.
36
use vars qw/$MEMCACHED/;
43
# Args : see Jifty::DBI::Record::new
44
# Lvalue : Jifty::DBI::Record::Cachable
47
my ( $self, @args ) = @_;
48
$MEMCACHED ||= Cache::Memcached->new( {$self->memcached_config} );
49
$self->SUPER::_init(@args);
54
Overrides the implementation from L<Jifty::DBI::Record> to add support for caching.
61
# Blow away the primary cache key since we're loading.
63
my ( $rvalue, $msg ) = $self->SUPER::load_from_hash(@_);
64
## Check the return value, if its good, cache it!
65
$self->_store() if ($rvalue);
66
return ( $rvalue, $msg );
68
$self = $self->SUPER::load_from_hash(@_);
69
## Check the return value, if its good, cache it!
70
$self->_store() if ( $self->id );
78
Overrides the implementation from L<Jifty::DBI::Record> to add support for caching.
83
my ( $class, %attr ) = @_;
87
( $self, $class ) = ( $class, undef );
89
$self = $class->new( handle => ( delete $attr{'_handle'} || undef ) );
92
## Generate the cache key
93
my $key = $self->_gen_load_by_cols_key(%attr);
94
if ( $self->_get($key) ) {
95
if ($class) { return $self }
96
else { return ( 1, "Fetched from cache" ) }
99
my ( $rvalue, $msg ) = $self->SUPER::load_by_cols(%attr);
100
## Check the return value, if its good, cache it!
103
if ( $key ne $self->_primary_key ) {
104
$MEMCACHED->add( $key, $self->_primary_cache_key,
105
$self->_cache_config->{'cache_for_sec'} );
106
$self->{'loaded_by_cols'} = $key;
109
if ($class) { return $self }
111
return ( $rvalue, $msg );
116
# Type : (overloaded) public instance
117
# Args : see Jifty::DBI::Record::_Set
121
my ( $self, %attr ) = @_;
123
return $self->SUPER::__set(%attr);
128
# Type : (overloaded) public instance
135
return $self->SUPER::__delete();
139
# Type : private instance
140
# Args : string(cache_key)
142
# Desc : Removes this object from the cache.
146
$MEMCACHED->delete($self->_primary_cache_key);
147
$MEMCACHED->delete($self->{'loaded_by_cols'}) if ($self->{'loaded_by_cols'});
152
# Type : private instance
153
# Args : string(cache_key)
155
# Desc : Get an object from the cache, and make this object that.
158
my ( $self, $cache_key ) = @_;
159
my $data = $MEMCACHED->get($cache_key) or return;
160
# If the cache value is a scalar, that's another key
161
unless (ref $data) { $data = $MEMCACHED->get($data); }
162
unless (ref $data) { return undef; }
163
@{$self}{ keys %$data } = values %$data; # deserialize
169
return ( $self->SUPER::__value($column) );
173
# Type : private instance
174
# Args : string(cache_key)
176
# Desc : Stores this object in the cache.
180
# Blow away the primary cache key since we're loading.
181
$self->{'_jifty_cache_pkey'} = undef;
182
$MEMCACHED->set( $self->_primary_cache_key,
183
{ values => $self->{'values'},
184
table => $self->table,
185
fetched => $self->{'fetched'}
187
$self->_cache_config->{'cache_for_sec'}
192
# Function: _gen_load_by_cols_key
193
# Type : private instance
196
# Desc : Takes a perl hash and generates a key from it.
198
sub _gen_load_by_cols_key {
199
my ( $self, %attr ) = @_;
201
my $cache_key = $self->cache_key_prefix . '-'. $self->table() . ':';
203
while ( my ( $key, $value ) = each %attr ) {
205
$value ||= '__undef';
207
if ( ref($value) eq "HASH" ) {
208
$value = ( $value->{operator} || '=' ) . $value->{value};
210
$value = "=" . $value;
212
push @items, $key.$value;
215
$cache_key .= join(',',@items);
219
# Function: _primary_cache_key
220
# Type : private instance
223
# Desc : generate a primary-key based variant of this object's cache key
224
# primary keys is in the cache
226
sub _primary_cache_key {
229
return undef unless ( $self->id );
231
unless ( $self->{'_jifty_cache_pkey'} ) {
233
my $primary_cache_key = $self->cache_key_prefix .'-' .$self->table() . ':';
235
foreach my $key ( @{ $self->_primary_keys } ) {
236
push @attributes, $key . '=' . $self->SUPER::__value($key);
239
$primary_cache_key .= join( ',', @attributes );
241
$self->{'_jifty_cache_pkey'} = $primary_cache_key;
243
return ( $self->{'_jifty_cache_pkey'} );
249
You can override this method to change the duration of the caching
250
from the default of 5 seconds.
252
For example, to cache records for up to 30 seconds, add the following
253
method to your class:
256
{ 'cache_for_sec' => 30 }
263
'cache_for_sec' => 180,
267
=head2 memcached_config
269
Returns a hash containing arguments to pass to L<Cache::Memcached> during construction. The defaults are like:
272
services => [ '127.0.0.1:11211' ],
276
You may want to override this method if you want a customized cache configuration:
278
sub memcached_config {
280
servers => [ '10.0.0.15:11211', '10.0.0.15:11212',
281
'10.0.0.17:11211', [ '10.0.0.17:11211', 3 ] ],
283
compress_threshold => 10_000,
290
sub memcached_config {
291
servers => ['127.0.0.1:11211'],
296
=head2 cache_key_prefix
298
Returns the prefix we should prepend to all cache keys. If you're using one memcached for multiple
299
applications, you want this to be different for each application or they might end up mingling data.
303
sub cache_key_prefix {
314
Matt Knopp <mhat@netlag.com>
318
L<Jifty::DBI>, L<Jifty::DBI::Record>