X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FLiveObjectIndex.pm;h=970b2d9e066c86a0a88567b4bb345bc4d05bb22b;hb=5e0eea3522876a30453af24097507198bbbc9409;hp=4c52191ddd2c9887ecaccc7ca205b8264df92323;hpb=8d5134b09734852f9c11a3fd6b1c8f6551637b53;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm b/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
index 4c52191..970b2d9 100644
--- a/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
+++ b/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
@@ -1,74 +1,83 @@
-package DBIx::Class::CDBICompat::LiveObjectIndex;
+package # hide from PAUSE
+    DBIx::Class::CDBICompat::LiveObjectIndex;
 
 use strict;
 use warnings;
 
 use Scalar::Util qw/weaken/;
 
-use base qw/Class::Data::Inheritable/;
+use base 'DBIx::Class';
 
 __PACKAGE__->mk_classdata('purge_object_index_every' => 1000);
 __PACKAGE__->mk_classdata('live_object_index' => { });
 __PACKAGE__->mk_classdata('live_object_init_count' => { });
 
-# Ripped from Class::DBI 0.999, all credit due to Tony Bowden for this code,
-# all blame due to me for whatever bugs I introduced porting it.
+# Caching is on by default, but a classic CDBI hack to turn it off is to
+# set this variable false.
+$Class::DBI::Weaken_Is_Available = 1
+    unless defined $Class::DBI::Weaken_Is_Available;
+__PACKAGE__->mk_classdata('__nocache' => 0);
 
-sub _live_object_key {
-  my ($me) = @_;
-  my $class   = ref($me) || $me;
-  my @primary = keys %{$class->_primaries};
+sub nocache {
+    my $class = shift;
 
-  # no key unless all PK columns are defined
-  return "" unless @primary == grep defined $me->get_column($_), @primary;
+    return $class->__nocache(@_) if @_;
 
-  # create single unique key for this object
-  return join "\030", $class, map { $_ . "\032" . $me->get_column($_) }
-                                sort @primary;
+    return 1 if $Class::DBI::Weaken_Is_Available == 0;
+    return $class->__nocache;
 }
 
+# Ripped from Class::DBI 0.999, all credit due to Tony Bowden for this code,
+# all blame due to me for whatever bugs I introduced porting it.
+
 sub purge_dead_from_object_index {
-  my $live = $_[0]->live_object_index;
+  my $live = shift->live_object_index;
   delete @$live{ grep !defined $live->{$_}, keys %$live };
 }
 
 sub remove_from_object_index {
-  my $self    = shift;
-  my $obj_key = $self->_live_object_key;
-  delete $self->live_object_index->{$obj_key};
+  my $self = shift;
+  delete $self->live_object_index->{$self->ID};
 }
 
 sub clear_object_index {
-  my $live = $_[0]->live_object_index;
+  my $live = shift->live_object_index;
   delete @$live{ keys %$live };
 }
 
+
 # And now the fragments to tie it in to DBIx::Class::Table
 
 sub insert {
   my ($self, @rest) = @_;
-  $self->NEXT::ACTUAL::insert(@rest);
-    # Because the insert will die() if it can't insert into the db (or should)
-    # we can be sure the object *was* inserted if we got this far. In which
-    # case, given primary keys are unique and _live_object_key only returns a
-    # value if the object has all its primary keys, we can be sure there
-    # isn't a real one in the object index already because such a record
-    # cannot have existed without the insert failing.
-  if (my $key = $self->_live_object_key) {
+  $self->next::method(@rest);
+
+  return $self if $self->nocache;
+
+  # Because the insert will die() if it can't insert into the db (or should)
+  # we can be sure the object *was* inserted if we got this far. In which
+  # case, given primary keys are unique and ID only returns a
+  # value if the object has all its primary keys, we can be sure there
+  # isn't a real one in the object index already because such a record
+  # cannot have existed without the insert failing.
+  if (my $key = $self->ID) {
     my $live = $self->live_object_index;
     weaken($live->{$key} = $self);
     $self->purge_dead_from_object_index
       if ++$self->live_object_init_count->{count}
               % $self->purge_object_index_every == 0;
   }
-  #use Data::Dumper; warn Dumper($self);
+
   return $self;
 }
 
-sub _row_to_object {
+sub inflate_result {
   my ($class, @rest) = @_;
-  my $new = $class->NEXT::ACTUAL::_row_to_object(@rest);
-  if (my $key = $new->_live_object_key) {
+  my $new = $class->next::method(@rest);
+
+  return $new if $new->nocache;
+
+  if (my $key = $new->ID) {
     #warn "Key $key";
     my $live = $class->live_object_index;
     return $live->{$key} if $live->{$key};
@@ -80,16 +89,4 @@ sub _row_to_object {
   return $new;
 }
 
-sub discard_changes {
-  my ($self) = @_;
-  if (my $key = $self->_live_object_key) {
-    $self->remove_from_object_index;
-    my $ret = $self->NEXT::ACTUAL::discard_changes;
-    $self->live_object_index->{$key} = $self if $self->in_storage;
-    return $ret;
-  } else {
-    return $self->NEXT::ACTUAL::discard_changes;
-  }
-}
-
 1;