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

« back to all changes in this revision

Viewing changes to lib/Jifty/DBI/Record/Cachable.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
package Jifty::DBI::Record::Cachable;
 
2
 
 
3
use base qw(Jifty::DBI::Record);
 
4
 
 
5
use Jifty::DBI::Handle;
 
6
 
 
7
use Cache::Simple::TimedExpiry;
 
8
use Scalar::Util qw/ blessed /;
 
9
 
 
10
use strict;
 
11
use warnings;
 
12
 
 
13
=head1 NAME
 
14
 
 
15
Jifty::DBI::Record::Cachable - records with caching behavior
 
16
 
 
17
=head1 SYNOPSIS
 
18
 
 
19
  package Myrecord;
 
20
  use base qw/Jifty::DBI::Record::Cachable/;
 
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 fetch
 
29
or load methods without retrieving them from the database.
 
30
 
 
31
=head1 METHODS
 
32
 
 
33
=cut
 
34
 
 
35
my %_CACHES = ();
 
36
 
 
37
sub _setup_cache {
 
38
    my $self  = shift;
 
39
    my $cache = shift;
 
40
    $_CACHES{$cache} = Cache::Simple::TimedExpiry->new();
 
41
    $_CACHES{$cache}->expire_after( $self->_cache_config->{'cache_for_sec'} );
 
42
}
 
43
 
 
44
=head2 flush_cache 
 
45
 
 
46
This class method flushes the _global_ Jifty::DBI::Record::Cachable 
 
47
cache.  All caches are immediately expired.
 
48
 
 
49
=cut
 
50
 
 
51
sub flush_cache {
 
52
    %_CACHES = ();
 
53
}
 
54
 
 
55
sub _key_cache {
 
56
    my $self  = shift;
 
57
    my $cache = $self->_handle->dsn
 
58
        . "-KEYS--"
 
59
        . ( $self->{'_class'} ||= ref($self) );
 
60
    $self->_setup_cache($cache) unless exists( $_CACHES{$cache} );
 
61
    return ( $_CACHES{$cache} );
 
62
 
 
63
}
 
64
 
 
65
=head2 _flush_key_cache
 
66
 
 
67
Blow away this record type's key cache
 
68
 
 
69
=cut
 
70
 
 
71
sub _flush_key_cache {
 
72
    my $self  = shift;
 
73
    my $cache = $self->_handle->dsn
 
74
        . "-KEYS--"
 
75
        . ( $self->{'_class'} ||= ref($self) );
 
76
    $self->_setup_cache($cache);
 
77
}
 
78
 
 
79
sub _record_cache {
 
80
    my $self = shift;
 
81
    my $cache
 
82
        = $self->_handle->dsn . "--" . ( $self->{'_class'} ||= ref($self) );
 
83
    $self->_setup_cache($cache) unless exists( $_CACHES{$cache} );
 
84
    return ( $_CACHES{$cache} );
 
85
 
 
86
}
 
87
 
 
88
=head2 load_from_hash
 
89
 
 
90
Overrides the implementation from L<Jifty::DBI::Record> to add caching.
 
91
 
 
92
=cut
 
93
 
 
94
 
 
95
sub load_from_hash {
 
96
    my $self = shift;
 
97
 
 
98
    my ( $rvalue, $msg );
 
99
    if ( ref($self) ) {
 
100
 
 
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(@_);
 
104
 
 
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 );
 
112
        return ($self);
 
113
    }
 
114
 
 
115
}
 
116
 
 
117
=head2 load_by_cols
 
118
 
 
119
Overrides the implementation from L<Jifty::DBI::Record> to add caching.
 
120
 
 
121
=cut
 
122
 
 
123
sub load_by_cols {
 
124
    my ( $class, %attr ) = @_;
 
125
 
 
126
    my ($self);
 
127
    if ( ref($class) ) {
 
128
        ( $self, $class ) = ( $class, undef );
 
129
    } else {
 
130
        $self = $class->new(
 
131
            handle => ( delete $attr{'_handle'} || undef ) );
 
132
    }
 
133
 
 
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" ) }
 
139
    }
 
140
 
 
141
    # Blow away the primary cache key since we're loading.
 
142
    $self->{'_jifty_cache_pkey'} = undef;
 
143
 
 
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!
 
147
    if ($rvalue) {
 
148
        ## Only cache the object if its okay to do so.
 
149
        $self->_store();
 
150
        $self->_key_cache->set(
 
151
            $alt_key => $self->_primary_record_cache_key );
 
152
 
 
153
    }
 
154
    if ($class) { return $self }
 
155
    else {
 
156
        return ( $rvalue, $msg );
 
157
    }
 
158
}
 
159
 
 
160
# Function: __set
 
161
# Type    : (overloaded) public instance
 
162
# Args    : see Jifty::DBI::Record::_Set
 
163
# Lvalue  : ?
 
164
 
 
165
sub __set () {
 
166
    my $self = shift;
 
167
 
 
168
    $self->_expire();
 
169
    return $self->SUPER::__set(@_);
 
170
 
 
171
}
 
172
 
 
173
# Function: delete
 
174
# Type    : (overloaded) public instance
 
175
# Args    : nil
 
176
# Lvalue  : ?
 
177
 
 
178
sub __delete () {
 
179
    my $self = shift;
 
180
 
 
181
    $self->_expire();
 
182
    return $self->SUPER::__delete(@_);
 
183
 
 
184
}
 
185
 
 
186
# Function: _expire
 
187
# Type    : private instance
 
188
# Args    : string(cache_key)
 
189
# Lvalue  : 1
 
190
# Desc    : Removes this object from the cache.
 
191
 
 
192
sub _expire (\$) {
 
193
    my $self = shift;
 
194
    $self->_record_cache->set( $self->_primary_record_cache_key, undef, time - 1 );
 
195
 
 
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;
 
198
 
 
199
}
 
200
 
 
201
# Function: _fetch
 
202
# Type    : private instance
 
203
# Args    : string(cache_key)
 
204
# Lvalue  : 1
 
205
# Desc    : Get an object from the cache, and make this object that.
 
206
 
 
207
sub _fetch () {
 
208
    my ( $self, $cache_key ) = @_;
 
209
        # If the alternate key is really the primary one
 
210
       
 
211
        
 
212
        my $data = $self->_record_cache->fetch($cache_key);
 
213
 
 
214
  unless ($data) {
 
215
    $cache_key = $self->_key_cache->fetch( $cache_key );
 
216
    $data = $self->_record_cache->fetch( $cache_key ) if $cache_key;
 
217
  }
 
218
 
 
219
  return undef unless ($data);
 
220
 
 
221
  @{$self}{ keys %$data } = values %$data;    # deserialize
 
222
  return 1;
 
223
 
 
224
 
 
225
}
 
226
 
 
227
#sub __value {
 
228
#    my $self   = shift;
 
229
#    my $column = shift;
 
230
#
 
231
#    # XXX TODO, should we be fetching directly from the cache?
 
232
#    return ( $self->SUPER::__value($column) );
 
233
#}
 
234
 
 
235
# Function: _store
 
236
# Type    : private instance
 
237
# Args    : string(cache_key)
 
238
# Lvalue  : 1
 
239
# Desc    : Stores this object in the cache.
 
240
 
 
241
sub _store (\$) {
 
242
    my $self = shift;
 
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'},
 
248
        }
 
249
    );
 
250
}
 
251
 
 
252
 
 
253
# Function: _gen_record_cache_key
 
254
# Type    : private instance
 
255
# Args    : hash (attr)
 
256
# Lvalue  : 1
 
257
# Desc    : Takes a perl hash and generates a key from it.
 
258
 
 
259
sub _gen_record_cache_key {
 
260
  my ( $self, %attr ) = @_;
 
261
 
 
262
  my @cols;
 
263
 
 
264
  while ( my ( $key, $value ) = each %attr ) {
 
265
    unless ( defined $value ) {
 
266
      push @cols, lc($key) . '=__undef';
 
267
    }
 
268
    elsif ( ref($value) eq "HASH" ) {
 
269
      push @cols, lc($key) . ( $value->{operator} || '=' )
 
270
          . defined $value->{value}? $value->{value}: '__undef';
 
271
    }
 
272
    elsif ( blessed $value and $value->isa('Jifty::DBI::Record') ) {
 
273
      push @cols, lc($key) . '=' . ( $value->id );
 
274
    }
 
275
    else {
 
276
      push @cols, lc($key) . "=" . $value;
 
277
    }
 
278
  }
 
279
  return ( $self->table() . ':' . join( ',', @cols ) );
 
280
}
 
281
 
 
282
# Function: _fetch_record_cache_key
 
283
# Type    : private instance
 
284
# Args    : nil
 
285
# Lvalue  : 1
 
286
 
 
287
sub _fetch_record_cache_key {
 
288
    my ($self) = @_;
 
289
    my $cache_key = $self->_cache_config->{'cache_key'};
 
290
    return ($cache_key);
 
291
}
 
292
 
 
293
# Function: _primary_record_cache_key
 
294
# Type    : private instance
 
295
# Args    : none
 
296
# Lvalue: : 1
 
297
# Desc    : generate a primary-key based variant of this object's cache key
 
298
#           primary keys is in the cache
 
299
 
 
300
sub _primary_record_cache_key {
 
301
    my ($self) = @_;
 
302
 
 
303
    unless ( $self->{'_jifty_cache_pkey'} ) {
 
304
 
 
305
        my @attributes;
 
306
        my %pk = $self->primary_keys;
 
307
        while ( my ($key, $value) = each %pk ) {
 
308
            return unless defined $value;
 
309
            push @attributes, lc( $key ) . '=' . $value;
 
310
        }
 
311
 
 
312
        $self->{'_jifty_cache_pkey'} = $self->table .':'
 
313
            . join ',', @attributes;
 
314
    }
 
315
    return ( $self->{'_jifty_cache_pkey'} );
 
316
 
 
317
}
 
318
 
 
319
=head2 _cache_config 
 
320
 
 
321
You can override this method to change the duration of the caching
 
322
from the default of 5 seconds.
 
323
 
 
324
For example, to cache records for up to 30 seconds, add the following
 
325
method to your class:
 
326
 
 
327
  sub _cache_config {
 
328
      { 'cache_for_sec' => 30 }
 
329
  }
 
330
 
 
331
=cut
 
332
 
 
333
sub _cache_config {
 
334
    {   'cache_p'       => 1,
 
335
        'cache_for_sec' => 5,
 
336
    };
 
337
}
 
338
 
 
339
1;
 
340
 
 
341
__END__
 
342
 
 
343
 
 
344
=head1 AUTHOR
 
345
 
 
346
Matt Knopp <mhat@netlag.com>
 
347
 
 
348
=head1 SEE ALSO
 
349
 
 
350
L<Jifty::DBI>, L<Jifty::DBI::Record>
 
351
 
 
352
=cut
 
353
 
 
354