patch CDBI live object index emulation to use ->ID method, add tests for ->ID

diff --git a/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm b/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
index 4c52191..8ebdf12 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
+++ b/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
@@ -14,32 +14,18 @@ __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.
 
-sub _live_object_key {
-  my ($me) = @_;
-  my $class   = ref($me) || $me;
-  my @primary = keys %{$class->_primaries};
-
-  # no key unless all PK columns are defined
-  return "" unless @primary == grep defined $me->get_column($_), @primary;
-
-  # create single unique key for this object
-  return join "\030", $class, map { $_ . "\032" . $me->get_column($_) }
-                                sort @primary;
-}
-
 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 };
 }
 
@@ -50,11 +36,11 @@ sub insert {
   $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
+    # 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->_live_object_key) {
+  if (my $key = $self->ID) {
     my $live = $self->live_object_index;
     weaken($live->{$key} = $self);
     $self->purge_dead_from_object_index
@@ -68,7 +54,7 @@ sub insert {
 sub _row_to_object {
   my ($class, @rest) = @_;
   my $new = $class->NEXT::ACTUAL::_row_to_object(@rest);
-  if (my $key = $new->_live_object_key) {
+  if (my $key = $new->ID) {
     #warn "Key $key";
     my $live = $class->live_object_index;
     return $live->{$key} if $live->{$key};
@@ -82,7 +68,7 @@ sub _row_to_object {
 
 sub discard_changes {
   my ($self) = @_;
-  if (my $key = $self->_live_object_key) {
+  if (my $key = $self->ID) {
     $self->remove_from_object_index;
     my $ret = $self->NEXT::ACTUAL::discard_changes;
     $self->live_object_index->{$key} = $self if $self->in_storage;

diff --git a/t/run/01core.tl b/t/run/01core.tl
index 3f5eace..13b4d34 100644 (file)
--- a/t/run/01core.tl
+++ b/t/run/01core.tl
@@ -1,6 +1,6 @@
 sub run_tests {
 
-plan tests => 22; 
+plan tests => 23; 
 
 my @art = DBICTest::Artist->search({ }, { order_by => 'name DESC'});
 
@@ -70,6 +70,8 @@ $new_again = DBICTest::Artist->find(4);
 
 is($new_again->name, 'Man With A Spoon', 'Retrieved correctly');
 
+is($new_again->ID, 'DBICTest::Artist|artistid=4', 'unique object id generated correctly');
+
 is(DBICTest::Artist->count, 4, 'count ok');
 
 # insert_or_update

diff --git a/t/run/05multipk.tl b/t/run/05multipk.tl
index 3dff0f6..3a0eb0d 100644 (file)
--- a/t/run/05multipk.tl
+++ b/t/run/05multipk.tl
@@ -1,10 +1,12 @@
 sub run_tests {
 
-plan tests => 2;
+plan tests => 3;
 
 ok(DBICTest::FourKeys->find(1,2,3,4), "find multiple pks without hash");
 ok(DBICTest::FourKeys->find(5,4,3,6), "find multiple pks without hash");
 
+is(DBICTest::FourKeys->find(1,2,3,4)->ID, 'DBICTest::FourKeys|bar=2|foo=1|goodbye=4|hello=3', 'unique object id ok for multiple pks');
+
 }
 
 1;