Re: Class::DBI 1.00 (almost)

[prev] [thread] [next] [Date index for 2005/06/20]

--==========1CCF134F526C7B59962A==========
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

--On June 20, 2005 11:03:54 AM -0400 Perrin Harkins <perrin@xxxx.xxx> wrote:

> On Mon, 2005-06-20 at 12:08 +0200, Hartmaier Alexander wrote:
>> Is the 'has_a on primary keys' patch from Charles Bailey included?
>
> My patch for that is included in what I sent to Tony.  The larger one
> Charles Bailey did that also tries to keep objects working after
> database errors is not included.  I didn't need that and didn't want to
> tackle the job of writing tests for it.

I think that summarizes the differences well.  I believe my prior patch 
subsumes the functionality of Perrin's.  It does include test cases for 
both the "normal" and the "exceptional" cases.

Because it adds a (inflated primary key) feature that's frequently 
requested (as does Perrin's) and some armor in the face of errors, without 
great cost in performance, I'd argue for its inclusion.  I am, of course, a 
biased source.

I've attached a copy for review, in case it's useful.  (The patch is 
against 0.96;
I'll pull down and test pre-1.00 in the next day or so.)

--
Regards,
Charles Bailey  < bailey _at_ newman _dot_ upenn _dot_ edu >
Newman Center at the University of Pennsylvania
--==========1CCF134F526C7B59962A==========
Content-Type: text/x-patch; charset=utf-8; name="object_pk.patch"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment; filename="object_pk.patch"; size=5662

diff -bBur Class-DBI-0.96/lib/Class/DBI/Relationship/HasA.pm =
Class-DBI-0.96_patched/lib/Class/DBI/Relationship/HasA.pm
--- Class-DBI-0.96/lib/Class/DBI/Relationship/HasA.pm	Sun Apr 25 11:33:36 =
2004
+++ Class-DBI-0.96_patched/lib/Class/DBI/Relationship/HasA.pm	Fri Apr 30 =
12:09:16 2004
@@ -24,6 +24,7 @@
 	return (
 		select              =3D> $self->_inflator,
 		"after_set_$column" =3D> $self->_inflator,
+		inflate             =3D> $self->_inflator,
 		deflate_for_create  =3D> $self->_deflator(1),
 		deflate_for_update  =3D> $self->_deflator,
 	);
diff -bBur Class-DBI-0.96/lib/Class/DBI.pm =
Class-DBI-0.96_patched/lib/Class/DBI.pm
--- Class-DBI-0.96/lib/Class/DBI.pm	Fri Apr 30 03:22:12 2004
+++ Class-DBI-0.96_patched/lib/Class/DBI.pm	Fri Jun 25 18:24:36 2004
@@ -587,7 +587,18 @@
 		($class->has_real_column($col) ? $real : $temp)->{$col} =3D
 			$self->_attrs($col);
 	}
-	$self->_insert_row($real);
+	eval { $self->_insert_row($real); };
+	my $err =3D $@;
+	# Restore linked objects even if insert failed
+	$self->call_trigger('inflate');
+	if ($err) {
+		my $class =3D ref $self;
+		return $self->_croak(
+			"Can't insert new $class: $err",
+			err    =3D> $err,
+			method =3D> 'create'
+		);
+	}
=20
 	my @primary_columns =3D $class->primary_columns;
 	$self->_attribute_store(
@@ -626,7 +637,6 @@
 sub _insert_row {
 	my $self =3D shift;
 	my $data =3D shift;
-	eval {
 		my @columns =3D keys %$data;
 		my $sth     =3D $self->sql_MakeNewObj(
 			join(', ', @columns),
@@ -638,15 +648,6 @@
 		$data->{ $primary_columns[0] } =3D $self->_auto_increment_value
 			if @primary_columns =3D=3D 1
 			&& !defined $data->{ $primary_columns[0] };
-	};
-	if ($@) {
-		my $class =3D ref $self;
-		return $self->_croak(
-			"Can't insert new $class: $@",
-			err    =3D> $@,
-			method =3D> 'create'
-		);
-	}
 	return 1;
 }
=20
@@ -776,11 +777,14 @@
 	$self->call_trigger('before_update');
 	return 1 unless my @changed_cols =3D $self->is_changed;
 	$self->call_trigger('deflate_for_update');
-	my @primary_columns =3D $self->primary_columns;
 	my $sth             =3D $self->sql_update($self->_update_line);
 	$class->_bind_param($sth, \@changed_cols);
 	my $rows =3D eval { $sth->execute($self->_update_vals, $self->id); };
-	return $self->_croak("Can't update $self: $@", err =3D> $@) if $@;
+	my $err =3D $@;
+	# Restore linked objects even if SQL update fails
+	$self->call_trigger('inflate');
+	return $self->_croak("Can't update $self: $err",
+			     err =3D> $err, method =3D> 'update') if $err;
=20
 	# enable this once new fixed DBD::SQLite is released:
 	if (0 and $rows !=3D 1) {    # should always only update one row
@@ -838,6 +842,7 @@
=20
 	if (my @fetch_cols =3D grep !$self->_attribute_exists($_), @cols) {
 		$self->_flesh($self->__grouper->groups_for(@fetch_cols));
+		$self->call_trigger('select');
 	}
=20
 	return $self->_attrs(@cols);
@@ -851,7 +856,6 @@
 		my %row;
 		@row{@want} =3D $self->sql_Flesh(join ", ", =
@want)->select_row($self->id);
 		$self->_attribute_store(\%row);
-		$self->call_trigger('select');
 	}
 	return 1;
 }
diff -bBur Class-DBI-0.96/t/10-mysql.t Class-DBI-0.96_patched/t/10-mysql.t
--- Class-DBI-0.96/t/10-mysql.t	Sun Apr 25 11:33:36 2004
+++ Class-DBI-0.96_patched/t/10-mysql.t	Wed May 19 11:49:10 2004
@@ -9,7 +9,7 @@
 eval { require 't/testlib/MyFoo.pm' };
 plan skip_all =3D> "Need MySQL for this test" if $@;
=20
-plan tests =3D> 64;
+plan tests =3D> 68;
=20
 package main;
=20
@@ -51,15 +51,22 @@
 ok(my $l2 =3D MyStarLink->create({ film =3D> $f1, star =3D> $s2 }), "Link =
2");
 ok(my $l3 =3D MyStarLink->create({ film =3D> $f2, star =3D> $s1 }), "Link =
3");
 ok(my $l4 =3D MyStarLink->create({ film =3D> $f2, star =3D> $s3 }), "Link =
4");
+isa_ok($l4->film, 'MyFilm', 'has_a target is an object');
=20
-ok(my $lm1 =3D MyStarLinkMCPK->create({ film =3D> $f1, star =3D> $s1 }),
+ok(my $lm1 =3D MyStarLinkMCPK->create({ film =3D> $f1, star =3D> $s1,
+				      role =3D> 'Veronique' }),
 	"Link MCPK 1");
-ok(my $lm2 =3D MyStarLinkMCPK->create({ film =3D> $f1, star =3D> $s2 }),
+ok(my $lm2 =3D MyStarLinkMCPK->create({ film =3D> $f1, star =3D> $s2,
+				      role =3D> 'Antek' }),
 	"Link MCPK 2");
-ok(my $lm3 =3D MyStarLinkMCPK->create({ film =3D> $f2, star =3D> $s1 }),
+ok(my $lm3 =3D MyStarLinkMCPK->create({ film =3D> $f2, star =3D> $s1,
+				      role =3D> 'Valentine' }),
 	"Link MCPK 3");
-ok(my $lm4 =3D MyStarLinkMCPK->create({ film =3D> $f2, star =3D> $s3 }),
+ok(my $lm4 =3D MyStarLinkMCPK->create({ film =3D> $f2, star =3D> $s3,
+				      role =3D> 'Karin' }),
 	"Link MCPK 4");
+isa_ok($lm4->film, 'MyFilm', 'has_a target is an object');
+is($lm3->role, 'Valentine', 'select handles PK relationship');
=20
 {    # Warnings for scalar context?
 	my $err =3D "";
@@ -76,6 +83,7 @@
 my $lm5 =3D eval { MyStarLinkMCPK->create({ film =3D> $f2, star =3D> $s3 =
}) };
 ok(!$lm5, "Can't create duplicate");
 ok($@ =3D~ /^Can't insert .* duplicate/i, "Duplicate create caused =
exception");
+isa_ok($lm4->film, 'MyFilm', 'has_a target is still an object');
=20
 # create one to delete
 ok(my $lm6 =3D MyStarLinkMCPK->create({ film =3D> $f2, star =3D> $s2 }),
diff -bBur Class-DBI-0.96/t/testlib/MyStarLinkMCPK.pm =
Class-DBI-0.96_patched/t/testlib/MyStarLinkMCPK.pm
--- Class-DBI-0.96/t/testlib/MyStarLinkMCPK.pm	Sun Apr 25 11:33:36 2004
+++ Class-DBI-0.96_patched/t/testlib/MyStarLinkMCPK.pm	Wed May 19 11:47:19 =
2004
@@ -13,7 +13,7 @@
=20
 __PACKAGE__->set_table();
 __PACKAGE__->columns(Primary =3D> qw/film star/);
-__PACKAGE__->columns(All     =3D> qw/film star/);
+__PACKAGE__->columns(All     =3D> qw/film star role/);
 __PACKAGE__->has_a(film =3D> 'MyFilm');
 __PACKAGE__->has_a(star =3D> 'MyStar');
=20
@@ -21,6 +21,7 @@
 	return qq{
     film    INTEGER NOT NULL,
     star    INTEGER NOT NULL,
+    role    VARCHAR(255) NOT NULL,
     PRIMARY KEY (film, star)
   };
 }


## End of patch ##

--==========1CCF134F526C7B59962A==========--