From: Jess Robinson <castaway@desert-island.me.uk>
Date: Wed, 14 Mar 2007 15:02:44 +0000 (+0000)
Subject: Added patch from Schwern to allow cdbi compat to infer the has_many from a has_a
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3bec1f52a1c0b65a7f323799a9ea832bf4b6695e;p=dbsrgits%2FDBIx-Class-Historic.git

Added patch from Schwern to allow cdbi compat to infer the has_many from a has_a
---

diff --git a/lib/DBIx/Class/CDBICompat/HasMany.pm b/lib/DBIx/Class/CDBICompat/HasMany.pm
index 382b9cb..6438e43 100644
--- a/lib/DBIx/Class/CDBICompat/HasMany.pm
+++ b/lib/DBIx/Class/CDBICompat/HasMany.pm
@@ -20,6 +20,12 @@ sub has_many {
     $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) {
diff --git a/t/cdbi-t/09-has_many.t b/t/cdbi-t/09-has_many.t
index 2af5485..28fa55e 100644
--- a/t/cdbi-t/09-has_many.t
+++ b/t/cdbi-t/09-has_many.t
@@ -6,15 +6,15 @@ BEGIN {
   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 @@ ok $@, $@;
 
 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];
+}
diff --git a/t/testlib/OtherThing.pm b/t/testlib/OtherThing.pm
new file mode 100644
index 0000000..08c31ba
--- /dev/null
+++ b/t/testlib/OtherThing.pm
@@ -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
+    };
+}
diff --git a/t/testlib/Thing.pm b/t/testlib/Thing.pm
new file mode 100644
index 0000000..d71e22a
--- /dev/null
+++ b/t/testlib/Thing.pm
@@ -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;