Re: retrieve() hits db even if obj present in %Live_Objects.

[prev] [thread] [next] [Date index for 2004/06/24]

--fdj2RfSjLxBAspz7
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

On Thu, Jun 24, 2004 at 09:30:30AM +0100, Tim Bunce wrote:
> On Thu, Jun 24, 2004 at 05:50:13AM +0100, trlorenz@xxxxxxx.xxx wrote:
> > Hi, all.
> > 
> > Unless I'm mistaken, retrieve() makes a trip to the db even if the object being sought is already present in the CDBI object cache. (Apparently this is because retrieve() is implemented through _do_search(), which has no concept of an id-only lookup.) Only after the data is picked up from the db is the id used for a lookup into the cache (and any fresh data from the db lookup discarded).
> > 
> > Is this correct?
> 
> Yeap. Needs fixing.

I've attached a (tested) patch that fixes this and also fixes some
other problems that were shown up by it.

The first patch is an updated and tested version of my previous
_live_object_key() patch. This one includes fixing remove_from_object_index(),
and _live_object_key() now works correctly if called as an instance method.

The second patch assumes the first has been applied. It adds code to
retrieve() to check the object cache first and avoid a database lookup.

It also:

 - Fixes delete() to call $self->remove_from_object_index;

 - Calls $class->clear_object_index when new relationships are defined
   for a class. Otherwise cached objects may have columns that ought
   to be inflated but aren't because the object was fetched before the
   relationship was defined. Unlikely to be an issue in practice but
   the test suite does that.

 - Simplifies the code path through retrieve()

 - Fixes the "parameters don't include values for all primary key
   columns" test which was too simplistic (I wrote it originally :).

All tests pass.

Tim.

--fdj2RfSjLxBAspz7
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="Class-DBI-0.96-live_object_key.patch"

diff -u -r Class-DBI-0.96.orig/lib/Class/DBI.pm Class-DBI-0.96/lib/Class/DBI.pm
--- Class-DBI-0.96.orig/lib/Class/DBI.pm	Fri Apr 30 08:22:12 2004
+++ Class-DBI-0.96/lib/Class/DBI.pm	Thu Jun 24 10:29:31 2004
@@ -509,19 +509,23 @@
 my %Live_Objects;
 my $Init_Count = 0;
 
+sub _live_object_key {
+	my ($class, $data) = @_;
+	my @primary_columns = $class->primary_columns;
+
+	# no key unless all PK columns are defined
+	return "" unless @primary_columns == grep defined, @{$data}{@primary_columns};
+
+	# create single unique key for this object
+	return join "\030", ref($class)||$class, map { $_ . "\032" . $data->{$_} }
+		       sort @primary_columns;
+}
+
 sub _init {
 	my $class = shift;
 	my $data = shift || {};
 	my $obj;
-	my $obj_key = "";
-
-	my @primary_columns = $class->primary_columns;
-	if (@primary_columns == grep defined, @{$data}{@primary_columns}) {
-
-		# create single unique key for this object
-		$obj_key = join "|", $class, map { $_ . '=' . $data->{$_} }
-			sort @primary_columns;
-	}
+	my $obj_key = $class->_live_object_key($data);
 
 	unless (defined($obj = $Live_Objects{$obj_key})) {
 
@@ -548,11 +552,7 @@
 
 sub remove_from_object_index {
 	my $self            = shift;
-	my @primary_columns = $self->primary_columns;
-	my %data;
-	@data{@primary_columns} = $self->get(@primary_columns);
-	my $obj_key = join "|", ref $self, map $_ . '=' . $data{$_},
-		sort @primary_columns;
+	my $obj_key = $self->_live_object_key($self);
 	delete $Live_Objects{$obj_key};
 }
 

--fdj2RfSjLxBAspz7
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="Class-DBI-0.96-retieve-from-cache.patch"

Only in Class-DBI-0.96/: Makefile
Only in Class-DBI-0.96/: blib
diff -u -r Class-DBI-0.96-live_object_key/lib/Class/DBI/Relationship.pm Class-DBI-0.96/lib/Class/DBI/Relationship.pm
--- Class-DBI-0.96-live_object_key/lib/Class/DBI/Relationship.pm	Sun Apr 25 16:33:36 2004
+++ Class-DBI-0.96/lib/Class/DBI/Relationship.pm	Thu Jun 24 11:24:34 2004
@@ -20,6 +20,7 @@
 	my $proto = shift;
 	my $name  = shift;
 	my ($class, $accessor, $foreign_class, $args) = $proto->remap_arguments(@_);
+	$class->clear_object_index;
 	return $proto->new({
 			name          => $name,
 			class         => $class,
diff -u -r Class-DBI-0.96-live_object_key/lib/Class/DBI.pm Class-DBI-0.96/lib/Class/DBI.pm
--- Class-DBI-0.96-live_object_key/lib/Class/DBI.pm	Thu Jun 24 10:29:31 2004
+++ Class-DBI-0.96/lib/Class/DBI.pm	Thu Jun 24 11:57:21 2004
@@ -661,23 +661,34 @@
 }
 
 sub retrieve {
-	my $class           = shift;
+	my $class = shift;
+	my @args  = @_;
 	my @primary_columns = $class->primary_columns
 		or return $class->_croak(
 		"Can't retrieve unless primary columns are defined");
+
+	if (@args == 1 && @primary_columns == 1) {
+		my $id = shift @args;
+		return $class->_croak("Can't retrieve a reference")
+			if ref $id and !UNIVERSAL::isa($id => 'Class::DBI');
+		@args = ($primary_columns[0] => $id)
+	}
+
 	my %key_value;
-	if (@_ == 1 && @primary_columns == 1) {
-		my $id = shift;
-		return unless defined $id;
-		return $class->_croak("Can't retrieve a reference") if ref($id);
-		$key_value{ $primary_columns[0] } = $id;
-	} else {
-		%key_value = @_;
-		$class->_croak(
-			"$class->retrieve(@_) parameters don't include values for all primary key columns (@primary_columns)"
-			)
-			if keys %key_value < @primary_columns;
+	while (my ($col, $val) = splice @args, 0, 2) { # as per _do_search:
+		my $column = $class->find_column($col)
+			|| (List::Util::first { $_->accessor eq $col } $class->columns)
+			|| $class->_croak("$col is not a column of $class");
+		$key_value{$column} = $class->_deflated_column($column, $val);
 	}
+	$class->_croak("$class->retrieve(@_) parameters don't include defined values for all primary key columns (@primary_columns)")
+		unless @primary_columns == grep defined, @key_value{@primary_columns};
+
+	my $obj_key = $class->_live_object_key(\%key_value);
+	if ($obj_key && defined(my $obj = $Live_Objects{$obj_key}))  {
+		return $obj;
+	}
+
 	my @rows = $class->search(%key_value);
 	$class->_carp("$class->retrieve(@_) selected " . @rows . " rows")
 		if @rows > 1;
@@ -737,6 +748,7 @@
 sub delete {
 	my $self = shift;
 	return $self->_search_delete(@_) if not ref $self;
+	$self->remove_from_object_index;
 	$self->call_trigger('before_delete');
 
 	eval { $self->sql_DeleteMe->execute($self->id) };
Only in Class-DBI-0.96/: pm_to_blib

--fdj2RfSjLxBAspz7--