Re: [PATCH] population bug in create()?

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

On Tue, Oct 19, 2004 at 12:31:04PM +0100, Tony Bowden wrote:
> On Tue, Oct 19, 2004 at 05:24:21PM +0900, Tatsuhiko Miyagawa wrote:
> > 519:   if (@primary_columns == grep defined, @{$data}{@primary_columns})
> > grep defined, @{$data}{qw(id)} automatically populates id => undef on
> > $data hashref. So here's a patch.
> > 
> > - if (@primary_columns == grep defined, @{$data}{@primary_columns}) {
> > + my $num = 0;
> > + for my $pk (@primary_columns) {
> > +     $num++ if defined $data->{$pk};
> > + }
> > + if (@primary_columns == $num) {
> 
> Ouch.
> 
> I'm curious if there isn't a better way here, though...

There is. I found and fixed this bug as part of my live_object_key patch
I posted July 1st (and I think you've applied but not released yet).

(I suspect this is the same issue as in the "Autovivified column
data after before_create trigger" thread.)


Tim.

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