Re: subclassable %Live_Objects key

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

--GvXjxJ+pjyke8COw
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

On Tue, Jun 29, 2004 at 10:34:47AM +0100, william ross wrote:
> dear perrin, list,
> 
> Could I suggest that in the next version of Class::DBI the key used to 
> store an object in the %Live_Objects hash is returned by a separate 
> live_objects_key() method, so that we can subclass it?

I guess you've not been following the list. Tony already has a patch
that does just that. I've appended it.

Tim.

> I often have several instances of an application running side by side, 
> using Class::DBI::Factory to let each one access a separate database 
> and set of templates, configuration files, etc, but use the same perl.
> 
> The object stash currently defeats this separation, returning objects 
> with the right id, but from whichever database was accessed first. All 
> I have to do is prepend an identifier, but at the moment you do this:
> 
> 	my $obj_key = join "|", ref $self, map $_ . '=' . $data{$_},
> 		sort @primary_columns;
> 
> in two places and I have to override them both, which seems nasty, and 
> I really hate subclassing _init :)

--GvXjxJ+pjyke8COw
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

--GvXjxJ+pjyke8COw--