~ubuntu-branches/ubuntu/precise/libjifty-dbi-perl/precise

« back to all changes in this revision

Viewing changes to lib/Jifty/DBI/Record/Memcached.pm

  • Committer: Bazaar Package Importer
  • Author(s): AGOSTINI Yves
  • Date: 2008-04-17 08:11:44 UTC
  • Revision ID: james.westby@ubuntu.com-20080417081144-jcpvqplvkkh07s1g
Tags: upstream-0.49
ImportĀ upstreamĀ versionĀ 0.49

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
use warnings;
 
2
use strict;
 
3
 
 
4
package Jifty::DBI::Record::Memcached;
 
5
 
 
6
use Jifty::DBI::Record;
 
7
use Jifty::DBI::Handle;
 
8
use base qw (Jifty::DBI::Record);
 
9
 
 
10
use Cache::Memcached;
 
11
 
 
12
 
 
13
=head1 NAME
 
14
 
 
15
Jifty::DBI::Record::Memcached - records with caching behavior
 
16
 
 
17
=head1 SYNOPSIS
 
18
 
 
19
  package Myrecord;
 
20
  use base qw/Jifty::DBI::Record::Memcached/;
 
21
 
 
22
=head1 DESCRIPTION
 
23
 
 
24
This module subclasses the main L<Jifty::DBI::Record> package to add a
 
25
caching layer.
 
26
 
 
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.
 
30
 
 
31
=head1 METHODS
 
32
 
 
33
=cut
 
34
 
 
35
 
 
36
use vars qw/$MEMCACHED/;
 
37
 
 
38
 
 
39
 
 
40
 
 
41
# Function: _init
 
42
# Type    : class ctor
 
43
# Args    : see Jifty::DBI::Record::new
 
44
# Lvalue  : Jifty::DBI::Record::Cachable
 
45
 
 
46
sub _init () {
 
47
    my ( $self, @args ) = @_;
 
48
    $MEMCACHED ||= Cache::Memcached->new( {$self->memcached_config} );
 
49
    $self->SUPER::_init(@args);
 
50
}
 
51
 
 
52
=head2 load_from_hash
 
53
 
 
54
Overrides the implementation from L<Jifty::DBI::Record> to add support for caching.
 
55
 
 
56
=cut
 
57
 
 
58
sub load_from_hash {
 
59
    my $self = shift;
 
60
 
 
61
    # Blow away the primary cache key since we're loading.
 
62
    if ( ref($self) ) {
 
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 );
 
67
    } else {
 
68
        $self = $self->SUPER::load_from_hash(@_);
 
69
        ## Check the return value, if its good, cache it!
 
70
        $self->_store() if ( $self->id );
 
71
        return $self;
 
72
 
 
73
    }
 
74
}
 
75
 
 
76
=head2 load_by_cols
 
77
 
 
78
Overrides the implementation from L<Jifty::DBI::Record> to add support for caching.
 
79
 
 
80
=cut
 
81
 
 
82
sub load_by_cols {
 
83
    my ( $class, %attr ) = @_;
 
84
 
 
85
    my ($self);
 
86
    if ( ref($class) ) {
 
87
        ( $self, $class ) = ( $class, undef );
 
88
    } else {
 
89
        $self = $class->new( handle => ( delete $attr{'_handle'} || undef ) );
 
90
    }
 
91
 
 
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" ) }
 
97
    }
 
98
    ## Fetch from the DB!
 
99
    my ( $rvalue, $msg ) = $self->SUPER::load_by_cols(%attr);
 
100
    ## Check the return value, if its good, cache it!
 
101
    if ($rvalue) {
 
102
        $self->_store();
 
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;
 
107
        }
 
108
    }
 
109
    if ($class) { return $self }
 
110
    else {
 
111
        return ( $rvalue, $msg );
 
112
    }
 
113
}
 
114
 
 
115
# Function: __set
 
116
# Type    : (overloaded) public instance
 
117
# Args    : see Jifty::DBI::Record::_Set
 
118
# Lvalue  : ?
 
119
 
 
120
sub __set () {
 
121
    my ( $self, %attr ) = @_;
 
122
    $self->_expire();
 
123
    return $self->SUPER::__set(%attr);
 
124
 
 
125
}
 
126
 
 
127
# Function: _delete
 
128
# Type    : (overloaded) public instance
 
129
# Args    : nil
 
130
# Lvalue  : ?
 
131
 
 
132
sub __delete () {
 
133
    my ($self) = @_;
 
134
    $self->_expire();
 
135
    return $self->SUPER::__delete();
 
136
}
 
137
 
 
138
# Function: _expire
 
139
# Type    : private instance
 
140
# Args    : string(cache_key)
 
141
# Lvalue  : 1
 
142
# Desc    : Removes this object from the cache.
 
143
 
 
144
sub _expire (\$) {
 
145
    my $self = shift;
 
146
    $MEMCACHED->delete($self->_primary_cache_key);
 
147
    $MEMCACHED->delete($self->{'loaded_by_cols'}) if ($self->{'loaded_by_cols'});
 
148
 
 
149
}
 
150
 
 
151
# Function: _get
 
152
# Type    : private instance
 
153
# Args    : string(cache_key)
 
154
# Lvalue  : 1
 
155
# Desc    : Get an object from the cache, and make this object that.
 
156
 
 
157
sub _get () {
 
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
 
164
}
 
165
 
 
166
sub __value {
 
167
    my $self   = shift;
 
168
    my $column = shift;
 
169
    return ( $self->SUPER::__value($column) );
 
170
}
 
171
 
 
172
# Function: _store
 
173
# Type    : private instance
 
174
# Args    : string(cache_key)
 
175
# Lvalue  : 1
 
176
# Desc    : Stores this object in the cache.
 
177
 
 
178
sub _store (\$) {
 
179
    my $self = shift;
 
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'}
 
186
        },
 
187
        $self->_cache_config->{'cache_for_sec'}
 
188
    );
 
189
}
 
190
 
 
191
 
 
192
# Function: _gen_load_by_cols_key
 
193
# Type    : private instance
 
194
# Args    : hash (attr)
 
195
# Lvalue  : 1
 
196
# Desc    : Takes a perl hash and generates a key from it.
 
197
 
 
198
sub _gen_load_by_cols_key {
 
199
    my ( $self, %attr ) = @_;
 
200
 
 
201
    my $cache_key = $self->cache_key_prefix . '-'. $self->table() . ':';
 
202
    my @items;
 
203
    while ( my ( $key, $value ) = each %attr ) {
 
204
        $key   ||= '__undef';
 
205
        $value ||= '__undef';
 
206
 
 
207
        if ( ref($value) eq "HASH" ) {
 
208
            $value = ( $value->{operator} || '=' ) . $value->{value};
 
209
        } else {
 
210
            $value = "=" . $value;
 
211
        }
 
212
        push @items, $key.$value;
 
213
 
 
214
    }
 
215
    $cache_key .= join(',',@items);
 
216
    return ($cache_key);
 
217
}
 
218
 
 
219
# Function: _primary_cache_key
 
220
# Type    : private instance
 
221
# Args    : none
 
222
# Lvalue: : 1
 
223
# Desc    : generate a primary-key based variant of this object's cache key
 
224
#           primary keys is in the cache
 
225
 
 
226
sub _primary_cache_key {
 
227
    my ($self) = @_;
 
228
 
 
229
    return undef unless ( $self->id );
 
230
 
 
231
    unless ( $self->{'_jifty_cache_pkey'} ) {
 
232
 
 
233
        my $primary_cache_key = $self->cache_key_prefix .'-' .$self->table() . ':';
 
234
        my @attributes;
 
235
        foreach my $key ( @{ $self->_primary_keys } ) {
 
236
            push @attributes, $key . '=' . $self->SUPER::__value($key);
 
237
        }
 
238
 
 
239
        $primary_cache_key .= join( ',', @attributes );
 
240
 
 
241
        $self->{'_jifty_cache_pkey'} = $primary_cache_key;
 
242
    }
 
243
    return ( $self->{'_jifty_cache_pkey'} );
 
244
 
 
245
}
 
246
 
 
247
=head2 _cache_config 
 
248
 
 
249
You can override this method to change the duration of the caching
 
250
from the default of 5 seconds.
 
251
 
 
252
For example, to cache records for up to 30 seconds, add the following
 
253
method to your class:
 
254
 
 
255
  sub _cache_config {
 
256
      { 'cache_for_sec' => 30 }
 
257
  }
 
258
 
 
259
=cut
 
260
 
 
261
sub _cache_config {
 
262
    {   
 
263
        'cache_for_sec' => 180,
 
264
    };
 
265
}
 
266
 
 
267
=head2 memcached_config
 
268
 
 
269
Returns a hash containing arguments to pass to L<Cache::Memcached> during construction. The defaults are like:
 
270
 
 
271
  (
 
272
      services => [ '127.0.0.1:11211' ],
 
273
      debug    => 0,
 
274
  )
 
275
 
 
276
You may want to override this method if you want a customized cache configuration:
 
277
 
 
278
  sub memcached_config {
 
279
      (
 
280
          servers => [ '10.0.0.15:11211', '10.0.0.15:11212',
 
281
                       '10.0.0.17:11211', [ '10.0.0.17:11211', 3 ] ],
 
282
          debug   => 0,
 
283
          compress_threshold => 10_000,
 
284
      );
 
285
  }
 
286
 
 
287
=cut
 
288
 
 
289
 
 
290
sub memcached_config {
 
291
    servers => ['127.0.0.1:11211'],
 
292
    debug => 0
 
293
 
 
294
}
 
295
 
 
296
=head2 cache_key_prefix
 
297
 
 
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.
 
300
 
 
301
=cut
 
302
 
 
303
sub cache_key_prefix {
 
304
    return 'Jifty-DBI';
 
305
}
 
306
 
 
307
1;
 
308
 
 
309
__END__
 
310
 
 
311
 
 
312
=head1 AUTHOR
 
313
 
 
314
Matt Knopp <mhat@netlag.com>
 
315
 
 
316
=head1 SEE ALSO
 
317
 
 
318
L<Jifty::DBI>, L<Jifty::DBI::Record>
 
319
 
 
320
=cut
 
321
 
 
322