Re: Can we make might_have() relationships easier to use?

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

On Fri, Jun 04, 2004 at 11:33:34AM -0400, Edward J. Sabol wrote:
>> Ah, but you can't *always* just add through setting, can you? Suppose another
>> not-null column is added to the Blurbs table like so:

Tony replied:
> OK. You've convinced me. Want to attempt a patch?
>
> Should be a relatively simple matter of adding another return value to
> Class::DBI::Relationship::MightHave::methods()
>
> I'll get around to it at some point if you don't, but it may be a while ...

OK, how does this look?

diff -rBub Class-DBI-0.96.orig/lib/Class/DBI/Relationship/MightHave.pm Class-DBI-0.96/lib/Class/DBI/Relationship/MightHave.pm
--- Class-DBI-0.96.orig/lib/Class/DBI/Relationship/MightHave.pm	Sun Apr 25 11:33:36 2004
+++ Class-DBI-0.96/lib/Class/DBI/Relationship/MightHave.pm	Sun Jun  6 18:14:44 2004
@@ -32,9 +32,30 @@
 	my ($class, $method) = ($self->class, $self->accessor);
 	return (
 		$method => $self->_object_accessor,
+		"add_$method" => $self->_method_add,
 		map { $_ => $self->_imported_accessor($_) } @{ $self->args->{import} });
 }
 
+sub _method_add {
+	my $self     = shift;
+	my $accessor = $self->accessor;
+	return sub {
+		my ($self, $data) = @_;
+		my $class = ref $self
+			or return $self->_croak("add_$accessor called as class method");
+		return $self->_croak("add_$accessor needs data")
+			unless ref $data eq "HASH";
+
+		return $self->_croak("add_$accessor called on an object that already has a $accessor")
+			if defined $self->$accessor();
+
+		my $meta = $class->meta_info(might_have => $accessor);
+		my $f_class = $meta->foreign_class;
+		$data->{$f_class->primary_column} = $self->id;
+		$f_class->create($data);
+	};
+}
+
 sub _object_accessor {
 	my $self = shift;
 	my ($class, $method) = ($self->class, $self->accessor);
diff -rBub Class-DBI-0.96.orig/lib/Class/DBI.pm Class-DBI-0.96/lib/Class/DBI.pm
--- Class-DBI-0.96.orig/lib/Class/DBI.pm	Fri Apr 30 03:22:12 2004
+++ Class-DBI-0.96/lib/Class/DBI.pm	Sun Jun  6 18:43:23 2004
@@ -2410,6 +2410,10 @@
 	my $liner_notes_object = $cd->liner_notes;
 	my $notes = $cd->notes; # equivalent to $cd->liner_notes->notes;
 
+	$liner_notes_object = $cd->add_liner_notes({
+		notes => 'These are the liner notes.',
+	}); # equivalent to $cd->notes('These are the liner notes.');
+
 might_have() is similar to has_many() for relationships that can have
 at most one associated objects. For example, if you have a CD database
 to which you want to add liner notes information, you might not want
@@ -2427,9 +2431,24 @@
 you can just call $cd->notes and it will call the notes method on the
 correct LinerNotes object transparently for you.
 
-Making sure you don't have namespace clashes is up to you, as is correctly
-creating the objects, but I may make these simpler in later versions.
-(Particularly if someone asks for them!)
+If a LinerNotes object doesn't already exist, then one will be created upon
+calling $cd->notes with an appropriate value, taking care of the primary
+key linking automatically. In addition might_have() creates another method
+(analogous to has_many()'s add_to_* method) which allows a new associated
+object to be constructed by specifying all of the object's values in one
+call. This method is primarily useful if the underlying table has column
+constraints that would otherwise prevent object creation. The name of this
+method is the same as the accessor method with "add_" prepended.
+
+The add_liner_notes example above is exactly equivalent to:
+
+	my $liner_notes_object = LinerNotes->create({
+		cd    => $cd,
+		notes => 'These are the liner notes.',
+	});
+
+Making sure you don't have namespace clashes is up to you, but I may this
+in later versions. (Particularly if someone asks for it!)
 
 =head2 Notes
 
diff -rBub Class-DBI-0.96.orig/t/14-might_have.t Class-DBI-0.96/t/14-might_have.t
--- Class-DBI-0.96.orig/t/14-might_have.t	Sat Nov  1 11:53:55 2003
+++ Class-DBI-0.96/t/14-might_have.t	Sun Jun  6 18:13:05 2004
@@ -3,15 +3,17 @@
 
 BEGIN {
 	eval "use DBD::SQLite";
-	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 18);
+	plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 42);
 }
 
 INIT {
 	use lib 't/testlib';
 	use Film;
 	use Blurb;
+	use Soundtrack;
 	Film->CONSTRUCT;
 	Blurb->CONSTRUCT;
+	Soundtrack->CONSTRUCT;
 }
 
 is(Blurb->primary_column, "title", "Primary key of Blurb = title");
@@ -21,6 +23,7 @@
 is $@, "", "No problem retrieving non-existent Blurb";
 
 Film->might_have(info => Blurb => qw/blurb/);
+Film->might_have(soundtrack => Soundtrack => qw/composer conductor orchestra/);
 
 {
 	ok my $bt = Film->retrieve('Bad Taste'), "Get Film";
@@ -59,7 +62,67 @@
 		isa_ok $blurb => "Blurb";
 		$bt->delete;
 		$blurb = Blurb->retrieve('Bad Taste');
-		is $blurb, undef, "Blurb has gone";
+		is $blurb, undef, "Blurb is gone";
+	}
+		
+}
+
+Film->make_bad_taste;
+
+{
+	my $bt = Film->retrieve('Bad Taste');
+	is $bt->soundtrack, undef, "Bad taste has no soundtrack yet";
+	eval { $bt->composer('John Williams') };
+	isnt $@, '', "Test failure to insert nulls";
+	$bt->delete;
+}
+
+Film->make_bad_taste;
+
+{
+	my $bt = Film->retrieve('Bad Taste');
+	is $bt->soundtrack, undef, "Bad taste has no soundtrack yet";
+	eval { $bt->add_soundtrack() };
+	like $@, qr/^add_.* needs data/, "Test failure when no arg provided";
+	eval { $bt->add_soundtrack('blah') };
+	like $@, qr/^add_.* needs data/, "Test failure when no hash provided";
+	my $st = eval { $bt->add_soundtrack({ 'composer' => 'John Williams', 'conductor' => 'John Williams', 'orchestra' => 'London Symphony Orchestra' }) };
+	is $@, '', "No problems calling add_* method";
+	eval { $bt->update };
+	is $@, '', "No problems updating after using add_* method";
+	isa_ok $st, "Soundtrack";
+	is $bt->orchestra, $st->orchestra, "Orchestra is the same as fetching the long way";
+
+	is $bt->composer, "John Williams", "Added soundtrack composer";
+	is $bt->conductor, "John Williams", "Added soundtrack conductor";
+	is $bt->orchestra, "London Symphony Orchestra", "Added soundtrack orchestra";
+	eval { $bt->add_soundtrack({ 'composer' => 'Howard Shore', 'conductor' => 'Howard Shore', 'orchestra' => 'New Zealand Symphony Orchestra' }) };
+	like $@, qr/^add_.* called on an object that already has a soundtrack/, "Test failure on multiple add_* calls";
+}
+
+{
+	my $bt = Film->retrieve('Bad Taste');
+	my $soundtrack = $bt->soundtrack;
+	isa_ok $soundtrack, 'Soundtrack';
+
+	is $bt->composer, 'John Williams', "Retrieved composer OK";
+	ok $bt->composer("Howard Shore"), "We can set the composer";
+	ok $bt->conductor("Howard Shore"), "We can set the conductor";
+	ok $bt->orchestra("New Zealand Symphony"), "We can set the orchestra";
+	eval { $bt->update };
+	is $@, '', "No problems updating when do have";
+
+	is $bt->composer, 'Howard Shore', "Updated composer OK";
+	is $bt->conductor, 'Howard Shore', "Updated conductor OK";
+	is $bt->orchestra, 'New Zealand Symphony', "Updated orchestra OK";
+
+	# cascade delete?
+	{
+		my $soundtrack = Soundtrack->retrieve('Bad Taste');
+		isa_ok $soundtrack => "Soundtrack";
+		$bt->delete;
+		$soundtrack = Soundtrack->retrieve('Bad Taste');
+		is $soundtrack, undef, "Soundtrack is gone";
 	}
 		
 }
diff -rBub Class-DBI-0.96.orig/t/testlib/Blurb.pm Class-DBI-0.96/t/testlib/Blurb.pm
--- Class-DBI-0.96.orig/t/testlib/Blurb.pm	Sun Apr 25 11:33:36 2004
+++ Class-DBI-0.96/t/testlib/Blurb.pm	Sun Jun  6 18:13:35 2004
@@ -21,7 +21,7 @@
 	$class->db_Main->do(
 		qq{
      CREATE TABLE Blurbs (
-        title                   VARCHAR(255) PRIMARY KEY,
+        title                   VARCHAR(255) NOT NULL PRIMARY KEY,
         blurb                   VARCHAR(255) NOT NULL
     )
   }
Only in Class-DBI-0.96/t/testlib: Soundtrack.pm
package Soundtrack;

BEGIN { unshift @INC, './t/testlib'; }

use strict;
use base 'CDBase';

__PACKAGE__->table('Soundtrack');
__PACKAGE__->columns('Primary', 'Title');
__PACKAGE__->columns('Soundtrack', qw/composer conductor orchestra/);

sub CONSTRUCT {
	my $class = shift;
	$class->create_soundtrack_table;
}

sub create_soundtrack_table {
	my $class = shift;
	$class->db_Main->do(
		qq{
     CREATE TABLE Soundtrack (
        title                   VARCHAR(255) NOT NULL PRIMARY KEY,
        composer                VARCHAR(255) NOT NULL,
        conductor               VARCHAR(255) NOT NULL,
        orchestra               VARCHAR(255) NOT NULL
    )
  }
	);
}

1;