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

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

Revision: 301
          http://treebase.svn.sourceforge.net/treebase/?rev=301&view=rev
Author:   mjdominus
Date:     2009-11-24 03:33:05 +0000 (Tue, 24 Nov 2009)

Log Message:
-----------
New tests for subobject features.

Restore ucfirst(lc(...)) code removed by RAV; it is actually correct.
Document behavior of ->subobject_class method.

Modified Paths:
--------------
    trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm
    trunk/treebase-core/src/main/perl/t/10_internal.t
    trunk/treebase-core/src/main/perl/t/20_study.t

Added Paths:
-----------
    trunk/treebase-core/src/main/perl/t/21_subobject.t

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 02:47:19 UTC (rev 300)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm	2009-11-24 03:33:05 UTC (rev 301)
@@ -107,6 +107,10 @@
 =cut
 
 # Maybe add some caching here at some point
+#
+# This should dispatch off to ->get because the code in the
+# two places is almost the same and we've already had one bug
+# occur when they didn't stay in sync.  mjd 20091123
 sub AUTOLOAD {
     my $obj = shift;
     our $AUTOLOAD;
@@ -541,17 +545,36 @@
 
 =item subobject_class()
 
-Returns the class name for the supplied subobject name. This is either a value in the invocant 
-class's %subobject hash (see TreeBaseObjects), an alias as returned by the alias() method or
-the supplied subobject's name itself.
+Returns the class name for the supplied attribute name.  The default is the name of the attribute,
+lowercase with initial capital.  This may be overridden by an entry in the C<%subobject> hash in the
+invocant's class.  For example, suppose there are C<Dessert> objects and C<Flavor> objects.  Suppose
+each C<Dessert> has a C<flavor> and an C<alternate_flavor> attribute, which are C<Flavor> objects.
+One could represent this by defining:
 
+    %Dessert::subobject = (flavor => 'Flavor',
+                           alternate_flavor => 'Flavor',
+                          );
+
+which says that whenever a C<Dessert>  object's C<flavor> or C<alternate_flavor> attributes are
+accessed, C<VeryBadORM> should instantiate them as C<Flavor> objects.
+
+But one could omit the first entry from the hash:
+
+    %Dessert::subobject = (alternate_flavor => 'Flavor');
+
+since the class for the C<flavor> attribute will be inferred to be C<Flavor> by default.
+
+One may, of course, override this method to implement any mapping of attribute to class names that
+is desired.
+
+
 =cut
 
 sub subobject_class { 
     my ($self, $subobj) = @_;
     my $subobj_class = \%{$self->class . "::subobject"};
     return $subobj_class->{$subobj} if exists $subobj_class->{$subobj};
-    return $self->alias($subobj) || $subobj;#ucfirst(lc($subobj)); # XXX really?
+    return $self->alias($subobj) || ucfirst(lc($subobj));
 }
 
 =item get_id_pair()

Modified: trunk/treebase-core/src/main/perl/t/10_internal.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/10_internal.t	2009-11-24 02:47:19 UTC (rev 300)
+++ trunk/treebase-core/src/main/perl/t/10_internal.t	2009-11-24 03:33:05 UTC (rev 301)
@@ -1,5 +1,6 @@
 
 # To test:  attr_list
 # attr_hash
+# subobject_class
 
-use Test::More 'skip_all' => 'none yet';
\ No newline at end of file
+use Test::More 'skip_all' => 'none yet';

Modified: trunk/treebase-core/src/main/perl/t/20_study.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/20_study.t	2009-11-24 02:47:19 UTC (rev 300)
+++ trunk/treebase-core/src/main/perl/t/20_study.t	2009-11-24 03:33:05 UTC (rev 301)
@@ -1,6 +1,5 @@
-use Test::More tests => 5;
+use Test::More tests => 7;
 
-use lib '../blib/lib';
 use_ok('CIPRES::TreeBase::TestObjects');
 use DBI;
 my $dbh = DBI->connect("DBI:CSV:f_dir=test_db;csv_eol=\n");
@@ -11,3 +10,6 @@
 
 ok(my $s8 = Study->new(8));
 is($s8->owner, 'Otto');
+
+is(Tree->new(120)->name, "tree cxx");
+is(Matrix->new(25)->n_rows, 26);
\ No newline at end of file

Added: trunk/treebase-core/src/main/perl/t/21_subobject.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/21_subobject.t	                        (rev 0)
+++ trunk/treebase-core/src/main/perl/t/21_subobject.t	2009-11-24 03:33:05 UTC (rev 301)
@@ -0,0 +1,9 @@
+use Test::More tests => 3;
+
+use_ok('CIPRES::TreeBase::TestObjects');
+use DBI;
+my $dbh = DBI->connect("DBI:CSV:f_dir=test_db;csv_eol=\n");
+CIPRES::TreeBase::VeryBadORM->set_db_connection($dbh);
+
+is(Study->new(4)->Tree->name, "tree xxiv");
+is(Study->new(4)->tree->name, "tree xxiv");


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