[Treebase-guts] SF.net SVN: treebase:[322] trunk/treebase-core/src/main/perl

[<mjd...@us...>]

Revision: 322
          http://treebase.svn.sourceforge.net/treebase/?rev=322&view=rev
Author:   mjdominus
Date:     2009-11-24 21:28:47 +0000 (Tue, 24 Nov 2009)

Log Message:
-----------
add another link table test

Modified Paths:
--------------
    trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm
    trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm
    trunk/treebase-core/src/main/perl/t/23_link.t

Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm	2009-11-24 19:47:39 UTC (rev 321)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm	2009-11-24 21:28:47 UTC (rev 322)
@@ -10,11 +10,12 @@
 
 package Person;
 CIPRES::TreeBase::VeryBadORM->register();
+%r2_attr = (studies => ['study_author', 'Study']);
 
 package Study;
 CIPRES::TreeBase::VeryBadORM->register();
 %r_attr = (matrices => 'Matrix');
-%r2_attr = (people => ['study_author', 'Person']);
+%r2_attr = (people => ['study_author', 'Person', 'person_id']);
 
 package Tree;
 CIPRES::TreeBase::VeryBadORM->register();

Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm	2009-11-24 19:47:39 UTC (rev 321)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm	2009-11-24 21:28:47 UTC (rev 322)
@@ -453,13 +453,22 @@
 =item r2_id_attr()
 
 Returns name of the foreign key column in the intersection table of the referenced objects 
-(as opposed to instances of the invocant column) in a many-to-many relation.  By default, it 
-consults %r2_attr first. And if that doesn't work, it consults the foreign class's %r2 instead, 
-to see if the relationship was defined in the other direction.
+(as opposed to instances of the invocant column) in a many-to-many relation.  
 
-See description of %r2_attr hash in TreeBaseObjects. This method returns the 3rd element (index 2)
-in the value array ref.
+If C<%r2_attr> lists a target class for the referenced object,
+C<r2_id_attr> uses that class's default C<id_attr>, unless that us
+overriden by C<%r2_attr>.  For example, if C<Study> has:
 
+    %Study::r2_attr = (nexusfiles => ['study_nexus', 'Nexus'])
+
+then the C<nexus_id> column will be consulted, unless
+C<Nexus->id_attr> returns something else.  But if the attribute is
+given explicitly, like this:
+
+    %Study::r2_attr = (nexusfiles => ['study_nexus', 'Nexus', 'nexusfileID'])
+
+then the C<nexusfileID> column of the C<study_nexus> table will be consulted.
+
 =cut
 
 sub r2_id_attr {

Modified: trunk/treebase-core/src/main/perl/t/23_link.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/23_link.t	2009-11-24 19:47:39 UTC (rev 321)
+++ trunk/treebase-core/src/main/perl/t/23_link.t	2009-11-24 21:28:47 UTC (rev 322)
@@ -1,9 +1,9 @@
-use Test::More tests => 2;
+use Test::More tests => 5;
 
 #
 # Tests for link attributes (%r2_attr)
 #
-
+use lib '../lib';
 use_ok('CIPRES::TreeBase::TestObjects');
 use DBI;
 my $dbh = DBI->connect("DBI:CSV:f_dir=test_db;csv_eol=\n");
@@ -25,3 +25,14 @@
 }
 ok($FAIL eq "", $FAIL || "check study 5 people");
 
+
+# ----------------------------------------------------------------
+# This is to test that reverse attributes are inferred automatically, 
+# without requiring a separate r2_attr declaration
+
+my @p7_studies = sort { $a->id <=> $b->id } Person->new(7)->studies;
+
+is(scalar @p7_studies, 2, "Septimus is involved in 2 studies");
+is($p7_studies[0]->id, 5, "Septimus in study 5");
+is($p7_studies[1]->id, 7, "Septimus in study 7");
+


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.