Re: object cache/index multiple apps -- best practice?

[prev] [thread] [next] [Date index for 2004/07/19]

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

On Mon, Jul 19, 2004 at 12:18:20AM -0500, Matt Sisk wrote:
> Perrin Harkins said:
> > That's not good.  It means you have scoping problems somewhere, 
> either in your
> > own code or in Perl's behavior (see the recent thread about scoping 
> of return values).
> > Disabling the object index should not alter the behavior of a program 
> without scoping
> > problems unless that program was counting on being able to to work 
> with two separate
> > objects representing the same row of data at once.  The only other 
> situation where
> > people have had problems is when they have an incorrect primary key 
> set, or objects
> > that contain data in TEMP columns which can not be identified by a 
> primary key.
> 
> I'm not sure if I'm following. Take the following example:
> 
>  # from within process_a
>  my $obj = MyClass->retrieve(1);
>  # invoke process B to do something to that table
>  system('process_b'); # process_b changes the table in question
>  $obj = MyClass->retrieve(1);
>  # $obj does not reflect update
> 
> Is the scoping issue here that the second retrieve is executed *before* 
> $obj is destroyed by the assignment, therefore reflecting the values in 
> the cache?

Yes.

> As for disabling the object cache with $Class::DBI::Weaken_Is_Available 
> ...that seems like it could definitely be fleshed out. I'd like to see 
> the ability to disable cacheing on a per-table basis so that you can 
> enjoy the benefits on tables where it doesn't matter, but disable it on 
> tables where it's absolutely essential that every read consults the 
> database.

You can do that by applying my _live_object_key() patch (attached)
and then defining

  sub _live_object_key { "" }

in any class for which you want the cache disabled.

Tim.

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

Only in Class-DBI-0.96-live_object_key: Makefile
Only in Class-DBI-0.96-live_object_key: blib
diff -u -r Class-DBI-0.96.orig/lib/Class/DBI.pm Class-DBI-0.96-live_object_key/lib/Class/DBI.pm
--- Class-DBI-0.96.orig/lib/Class/DBI.pm	Fri Apr 30 08:22:12 2004
+++ Class-DBI-0.96-live_object_key/lib/Class/DBI.pm	Fri Jun 25 11:08:50 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};
 }
 
Only in Class-DBI-0.96-live_object_key: pm_to_blib

--45Z9DzgjV8m4Oswq--