1 package DBIx::Class::ObjectCache;
6 use base qw/Class::Data::Inheritable/;
8 __PACKAGE__->mk_classdata('cache');
12 DBIx::Class::ObjectCache - Cache rows by primary key (EXPERIMENTAL)
16 # in your class definition
18 __PACKAGE__->cache(Cache::FastMmap->new);
22 This class implements a simple object cache. It should be loaded before most (all?) other
23 L<DBIx::Class> components. Note that, in its current state, this code is rather experimental.
24 The only time the cache is made use of is on calls to $obj->find. This can still result in a
25 significant savings, but more intelligent caching, e.g. of the resultset of a has_many call,
26 is currently not possible. It is not difficult, however, to implement additional caching
27 on top of this module.
29 The cache is stored in a package variable called C<cache>. It can be set to any object that
30 implements the required C<get>, C<set>, and C<remove> methods.
36 $self->next::method(@_);
37 $self->_insert_into_cache if $self->cache;
42 my ($self,@vals) = @_;
43 return $self->next::method(@vals) unless $self->cache;
45 # this is a terrible hack here. I know it can be improved.
46 # but, it's a start anyway. probably find in PK.pm needs to
47 # call a hook, or some such thing. -Dave/ningu
49 my @pk = $self->primary_columns;
50 if (ref $vals[0] eq 'HASH') {
51 my $cond = $vals[0]->{'-and'};
52 $key = $self->_create_ID(%{$cond->[0]}) if ref $cond eq 'ARRAY';
53 } elsif (@pk == @vals) {
56 $key = $self->_create_ID(%data);
58 $key = $self->_create_ID(@vals);
60 if ($key and $object = $self->cache->get($key)) {
61 #warn "retrieving cached item $key";
65 $object = $self->next::method(@vals);
66 $object->_insert_into_cache if $object;
72 my $new = $self->next::method(@_);
73 $self->_insert_into_cache if $self->cache;
79 $self->cache->remove($self->ID) if $self->cache;
80 return $self->next::method(@_);
85 my $new = $self->next::method(@_);
86 $new->_insert_into_cache if $self->cache;
90 sub _insert_into_cache {
92 if (my $key = $self->ID) {
93 my $object = bless { %$self }, ref $self;
94 $self->cache->set($key,$object);
102 David Kamholz <davekam@pobox.com>
106 You may distribute this code under the same terms as Perl itself.