lib/DBIx/Class/ObjectCache.pm

   1 package DBIx::Class::ObjectCache;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/Class::Data::Inheritable/;
   7
   8 __PACKAGE__->mk_classdata('cache');
   9
  10 sub insert {
  11   my $self = shift;
  12   $self->NEXT::ACTUAL::insert(@_);
  13   $self->_insert_into_cache if $self->cache;
  14   return $self;
  15 }
  16
  17 sub find {
  18   my ($self,@vals) = @_;
  19   return $self->NEXT::ACTUAL::find(@vals) unless $self->cache;
  20
  21   # this is a terrible hack here. I know it can be improved.
  22   # but, it's a start anyway. probably find in PK.pm needs to
  23   # call a hook, or some such thing. -Dave/ningu
  24   my ($object,$key);
  25   my @pk = keys %{$self->_primaries};
  26   if (ref $vals[0] eq 'HASH') {
  27     my $cond = $vals[0]->{'-and'};
  28     $key = $self->_create_ID(%{$cond->[0]}) if ref $cond eq 'ARRAY';
  29   } elsif (@pk == @vals) {
  30     my %data;
  31     @data{@pk} = @vals;
  32     $key = $self->_create_ID(%data);
  33   } else {
  34     $key = $self->_create_ID(@vals);
  35   }
  36   if ($key and $object = $self->cache->get($key)) {
  37     return $object;
  38   }
  39
  40   $object = $self->NEXT::ACTUAL::find(@vals);
  41   $object->_insert_into_cache if $object;
  42   return $object;
  43 }
  44
  45 sub update {
  46   my $self = shift;
  47   $self->cache->remove($self->ID) if $self->cache;
  48   return $self->NEXT::ACTUAL::update(@_);
  49 }
  50
  51 sub delete {
  52   my $self = shift;
  53   $self->cache->remove($self->ID) if $self->cache;
  54   return $self->NEXT::ACTUAL::delete(@_);
  55 }
  56
  57 sub _insert_into_cache {
  58   my ($self) = @_;
  59   if (my $key = $self->ID) {
  60     if (my $object = $self->new( $self->{_column_data} )) {
  61       $self->cache->set($key,$object);
  62     }
  63   }
  64 }
  65
  66 1;