Warning if primary key is changed (was Re: Ignorance prevention)

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

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

On Thu, Sep 16, 2004 at 10:12:22AM -0400, Perrin Harkins wrote:
> > Obviously, I'd like to save myself from doing this a third time by
> > adding an exception or at least a warning message to my logs when such a
> > change occurs.
> > 
> > From the docs, it appears that this kind of warning may be desirable
> > (see Caveats-- "I should really protect against this."). Is this code
> > going to be difficult to add? I'm willing to take a stab at it if Tony
> > or someone familiar with the codebase could give me any warnings or
> > advice.
> 
> Sounds like a good idea to me.  Go for it.  You probably just need to
> change the method generation code to provide different mutators for
> primary key columns that croak with a message.

I'm not sure where the method generation code is located but was able to
find a way to generate the warning by adding an extra test to the set()
method. I suspect that it's probably not as robust as could be but
hopefully will prompt some of the more knowledgeable folks on the list
to find where this functionality should really live.

I've attached my patch against v0.96 along with a patch to t/02-Film.t
which adds a new test for this function. All tests that I can run are
passing. Hope this patch in some form or another can get included in the
next release.


William

        -- 
        Knowmad Services Inc.
http://www.knowmad.com

--LKTjZJSUETSlgu2t
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="DBI.pm.diff"

--- /tmp/Class-DBI-0.96/lib/Class/DBI.pm	2004-04-30 03:22:12.000000000 -0400
+++ lib//Class/DBI.pm	2004-10-07 18:20:10.000000000 -0400
@@ -316,11 +316,11 @@
 	# we don't use get() here because all objects should have
 	# exisitng values for PK columns, or else loop endlessly
 	my @pk_values = $self->_attrs($self->primary_columns);
-	return @pk_values if wantarray;
+  return map { "$_" } @pk_values if wantarray;
 	$self->_croak(
 		"id called in scalar context for class with multiple primary key columns")
 		if @pk_values > 1;
-	return $pk_values[0];
+  return "$pk_values[0]";
 }
 
 sub primary_column {
@@ -741,11 +741,15 @@
 
 	eval { $self->sql_DeleteMe->execute($self->id) };
 	if ($@) {
+    #require Data::Dumper;
+    #carp "\n!\n![Class::DBI->delete] Error: $@\n", Dumper($self, \@_), "\n\n";
 		return $self->_croak("Can't delete $self: $@", err => $@);
 	}
 	$self->call_trigger('after_delete');
+  my $original_class = ref $self;
 	undef %$self;
 	bless $self, 'Class::DBI::Object::Has::Been::Deleted';
+  $self->{'original_class'} = $original_class;
 	return 1;
 }
 
@@ -868,6 +872,7 @@
 
 	while (my ($column, $value) = each %$column_values) {
 		my $col = $self->find_column($column) or die "No such column: $column\n";
+    return $self->_croak("Changing the value of a primary key is unsupported.") if ($col eq $self->primary_column);
 		$self->_attribute_set($col => $value);
 
 		# $self->SUPER::set($column, $value);
@@ -2151,8 +2156,10 @@
 	$id = $obj->id;
 
 Returns a unique identifier for this object.  It's the equivalent of
-$obj->get($self->columns('Primary'));  A warning will be generated
-if this method is used on a table with a multi-column primary key.
+$obj->get($self->columns('Primary'));  Returns an array if called in list
+context on a table with multiple primary keys. A warning will be generated if
+this method is used in scalar context on a table with a multi-column primary
+key.
 
 =head2 LOW-LEVEL DATA ACCESS
 

--LKTjZJSUETSlgu2t
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="02-Film.t.diff"

--- /tmp/Class-DBI-0.96/t/02-Film.t	2004-04-25 11:33:36.000000000 -0400
+++ t/02-Film.t	2004-10-07 18:35:07.000000000 -0400
@@ -4,7 +4,7 @@
 
 BEGIN {
 	eval "use DBD::SQLite";
-	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 90);
+	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 92);
 }
 
 INIT {
@@ -298,6 +298,13 @@
 	is "$blrunner", "Bladerunner:R", "Provide stringify_self()";
 }
 
+# Changing primary key causes error
+is $blrunner->id, $blrunner->title, "Verify id";
+eval {
+  $blrunner->title('ScissorHands');
+};
+like $@, qr/Changing the value/, "Cannot change a primary key";
+
 {
 	{
 		ok my $byebye = DeletingFilm->create({

--LKTjZJSUETSlgu2t--