# 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 };
}
$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
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};
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;
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;