[Bast-commits] r3128 - in trunk/DBIx-Class: lib/DBIx/Class/CDBICompat t/cdbi-t t/testlib

[castaway at dev.catalyst.perl.org]

Author: castaway
Date: 2007-03-14 15:02:44 +0000 (Wed, 14 Mar 2007)
New Revision: 3128

Added:
   trunk/DBIx-Class/t/testlib/OtherThing.pm
   trunk/DBIx-Class/t/testlib/Thing.pm
Modified:
   trunk/DBIx-Class/lib/DBIx/Class/CDBICompat/HasMany.pm
   trunk/DBIx-Class/t/cdbi-t/09-has_many.t
Log:
Added patch from Schwern to allow cdbi compat to infer the has_many from a has_a


Modified: trunk/DBIx-Class/lib/DBIx/Class/CDBICompat/HasMany.pm
===================================================================
--- trunk/DBIx-Class/lib/DBIx/Class/CDBICompat/HasMany.pm	2007-03-13 23:22:12 UTC (rev 3127)
+++ trunk/DBIx-Class/lib/DBIx/Class/CDBICompat/HasMany.pm	2007-03-14 15:02:44 UTC (rev 3128)
@@ -20,6 +20,12 @@
     $args->{cascade_delete} = 0;
   }
 
+  if( !$f_key and !@f_method ) {
+      my $f_source = $f_class->result_source_instance;
+      ($f_key) = grep { $f_source->relationship_info($_)->{class} eq $class }
+                      $f_source->relationships;
+  }
+
   $class->next::method($rel, $f_class, $f_key, $args);
 
   if (@f_method) {

Modified: trunk/DBIx-Class/t/cdbi-t/09-has_many.t
===================================================================
--- trunk/DBIx-Class/t/cdbi-t/09-has_many.t	2007-03-13 23:22:12 UTC (rev 3127)
+++ trunk/DBIx-Class/t/cdbi-t/09-has_many.t	2007-03-14 15:02:44 UTC (rev 3128)
@@ -6,15 +6,15 @@
   eval "use DBIx::Class::CDBICompat;";
   plan skip_all => 'Class::Trigger and DBIx::ContextualFetch required' if $@;
   eval "use DBD::SQLite";
-  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 30);
+  plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 31);
 }
 
 
 use lib 't/testlib';
 use Film;
 use Actor;
-Film->has_many(actors => Actor => 'Film', { order_by => 'name' });
 Actor->has_a(Film => 'Film');
+Film->has_many(actors => 'Actor', { order_by => 'name' });
 is(Actor->primary_column, 'id', "Actor primary OK");
 
 ok(Actor->can('Salary'), "Actor table set-up OK");
@@ -110,3 +110,18 @@
 
 is($as->Name, 'Arnold Schwarzenegger', "Arnie's still Arnie");
 
+
+# Test infering of the foreign key of a has_many from an existing has_a
+{
+    use Thing;
+    use OtherThing;
+
+    Thing->has_a(that_thing => "OtherThing");
+    OtherThing->has_many(things => "Thing");
+
+    my $other_thing = OtherThing->create({ id => 1 });
+    Thing->create({ id => 1, that_thing => $other_thing });
+    Thing->create({ id => 2, that_thing => $other_thing });
+
+    is_deeply [sort map { $_->id } $other_thing->things], [1,2];
+}

Added: trunk/DBIx-Class/t/testlib/OtherThing.pm
===================================================================
--- trunk/DBIx-Class/t/testlib/OtherThing.pm	                        (rev 0)
+++ trunk/DBIx-Class/t/testlib/OtherThing.pm	2007-03-14 15:02:44 UTC (rev 3128)
@@ -0,0 +1,11 @@
+package OtherThing;
+use base 'DBIx::Class::Test::SQLite';
+
+OtherThing->set_table("other_thing");
+OtherThing->columns(All => qw(id));
+
+sub create_sql {
+    return qq{
+        id              INTEGER
+    };
+}

Added: trunk/DBIx-Class/t/testlib/Thing.pm
===================================================================
--- trunk/DBIx-Class/t/testlib/Thing.pm	                        (rev 0)
+++ trunk/DBIx-Class/t/testlib/Thing.pm	2007-03-14 15:02:44 UTC (rev 3128)
@@ -0,0 +1,14 @@
+package Thing;
+use base 'DBIx::Class::Test::SQLite';
+
+Thing->set_table("thing");
+Thing->columns(All => qw(id that_thing));
+
+sub create_sql {
+    return qq{
+        id              INTEGER,
+        that_thing      INTEGER
+    };
+}
+
+1;