From: <mjd...@us...> - 2009-11-24 21:29:43
|
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. |