Menu
▾
▴
[Treebase-guts] SF.net SVN: treebase:[300] trunk/treebase-core/src/main/perl
|
From: <mjd...@us...> - 2009-11-24 02:48:14
|
Revision: 300
http://treebase.svn.sourceforge.net/treebase/?rev=300&view=rev
Author: mjdominus
Date: 2009-11-24 02:47:19 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
More tests; start filling out the test database.
Create TestObjects.pm with schema definition for test database.
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm
trunk/treebase-core/src/main/perl/t/01_basic.t
trunk/treebase-core/src/main/perl/test_db/study
Added Paths:
-----------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm
trunk/treebase-core/src/main/perl/t/02_table.t
trunk/treebase-core/src/main/perl/t/10_internal.t
trunk/treebase-core/src/main/perl/t/20_study.t
trunk/treebase-core/src/main/perl/t/test_db
trunk/treebase-core/src/main/perl/test_db/TREE
trunk/treebase-core/src/main/perl/test_db/matrices
Added: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm (rev 0)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm 2009-11-24 02:47:19 UTC (rev 300)
@@ -0,0 +1,20 @@
+$CIPRES::TreeBase::TestObjects::VERSION=0.1;
+
+require CIPRES::TreeBase::VeryBadORM;
+
+
+package Study;
+CIPRES::TreeBase::VeryBadORM->register();
+
+package Tree;
+CIPRES::TreeBase::VeryBadORM->register();
+
+sub table { "TREE" }
+sub id_attr { "TreeId" }
+
+package Matrix;
+CIPRES::TreeBase::VeryBadORM->register();
+
+sub table { "matrices" }
+
+1;
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm 2009-11-23 21:45:55 UTC (rev 299)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm 2009-11-24 02:47:19 UTC (rev 300)
@@ -1,4 +1,4 @@
-$CIPRES::TreeBase::VERSION=0.1;
+$CIPRES::TreeBase::TreeBaseObjects::VERSION=0.1;
require CIPRES::TreeBase::VeryBadORM;
@@ -8,8 +8,41 @@
=head1 DESCRIPTION
-=head1 PACKAGE VARIABLES
+This module is a collection of classes that represent objects from the TreeBase database.
+Access to the objects is through L<CIPRES::TreeBase::VeryBadORM> and is read-only.
+In general, each kind of object is represented by a different class. For example, studies are
+represented by C<Study> objects, treenodes are represented by C<PhyloTreeNode> objects, and so
+on.
+
+
+=head1 OBJECT ATTRIBUTES
+
+In general, if a database object, represented by C<$X>, has an attribute named C<foo>, then
+C< $X->foo > retrieves the value of the attribute. If the attribute is a scalar, the value is
+returned as a Perl scalar; if the attribute is a reference to another database object, a
+Perl object is returned.
+
+Each object is assumed to correspond to a single table in the database. If the object class is
+C<ObjectClass>, the corresponding table name is assumed to be C<objectclass>. This can be
+overridden by defining the C<ObjectClass::table> method, which should return the correct table
+name.
+
+Each object from class C<ObjectClass> is assumed to have a unique ID attribute which is stored
+in the table in a field whose name is returned by C<ObjectClass::id_attr>. This defaults to
+C<objectclass_id> if the method is not overridden.
+
+C<ObjectClass::new(V<ID>)> will create an object with the specified ID number. Objects are
+created lazily: the database is not consulted until some
+
+We will consider a running example, a database which contains studies, trees, and matrices.
+Each tree and each matrix is contained in exactly one study, but each study may have multiple
+trees and matrices.
+
+Each tree contains zero or more treenodes, and each matrix contains zero or more matrixrows.
+
+Suppose the C<tree> table contains a field, C<study_id>, which contains the foreign key of the
+
=over
=item %r_attr
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-23 21:45:55 UTC (rev 299)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm 2009-11-24 02:47:19 UTC (rev 300)
@@ -1,8 +1,11 @@
package CIPRES::TreeBase::VeryBadORM;
+
+$CIPRES::TreeBase::VeryBadORM::VERSION=0.1;
+
use Carp 'croak';
use strict 'vars';
-use Devel::StackTrace;
-use Data::Dumper;
+#use Devel::StackTrace;
+#use Data::Dumper;
our %dbh;
our $DBH;
@@ -12,15 +15,18 @@
=head1 DESCRIPTION
-Superclass for TreeBASE objects. This class is subclassed by packages in TreeBaseObjects.
+Superclass for TreeBASE objects. This class is subclassed by packages in C<TreeBaseObjects>.
+This module maps relations in a relational database to objects in Perl. It avoids all difficult
+implementation problems by providing only read-only access.
+
=head1 PACKAGE VARIABLES
=over
=item %dbh
-This hash holds cached (in theory different) database handles keyed on class names.
+This hash holds cached database handles keyed on class names.
=item $DBH
@@ -94,7 +100,7 @@
=item AUTOLOAD
Provides the magical methods available in the child classes. It does this by checking which of
-has_attr(), has_subobject(), has_r_attr() or has_r2_attr() applies and returns one of
+has_attr(), has_subobject(), has_r_attr() or has_r2_attr() applies and invokes one of
get_no_check(), get_subobject_no_check(), get_r_subobject_no_check() or get_r2_subobject_no_check()
respectively. Croaks otherwise.
@@ -208,7 +214,7 @@
my $attr_list = $base->attr_list;
if (@$attr_list) {
%$attr_hash = map { $_ => 1 } @$attr_list;
- $attr_hash->{"$class\_id"} = 1; # XXX case correct?
+ $attr_hash->{$class->id_attr} = 1;
return $attr_hash;
}
return;
@@ -229,7 +235,10 @@
my $attr_list = \@{"$class\::attr"};
return $attr_list if @$attr_list;
- my $q = "select * from " . $base->table . " fetch first 1 rows only"; # XXX case correct?
+# For DB2:
+# my $q = "select * from " . $base->table . " fetch first 1 rows only";
+# For Postgres:
+ my $q = "select * from " . $base->table . " limit 1";
my $sth = $DBH->prepare_cached($q);
$sth->execute();
while (my $row = $sth->fetchrow_hashref) {
@@ -563,7 +572,7 @@
=cut
-sub table { return $_[0]->class; } # XXX case correct?
+sub table { return lc($_[0]->class); }
=item r_class()
Modified: trunk/treebase-core/src/main/perl/t/01_basic.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/01_basic.t 2009-11-23 21:45:55 UTC (rev 299)
+++ trunk/treebase-core/src/main/perl/t/01_basic.t 2009-11-24 02:47:19 UTC (rev 300)
@@ -1,18 +1,28 @@
-use Test::More tests => 10;
+use Test::More tests => 27;
-warn(`pwd`);
use_ok('DBI');
use_ok('DBD::CSV');
ok(my $dbh = DBI->connect("DBI:CSV:f_dir=test_db;csv_eol=\n"));
-ok(my $sth = $dbh->prepare("select id from study where interesting > 0"));
-ok($sth->execute());
-%x = (4 => 1, 6 => 1, 8 => 1, 9 => 1);
-while (my ($id) = $sth->fetchrow) {
- ok($x{$id}, "found item $id");
- delete $x{$id};
+check_table('study', qw(name study_id owner tree_id));
+check_table('matrices', qw(matrix_id name n_rows study_id));
+check_table('TREE', qw(TreeId name root_node_id));
+
+use_ok('CIPRES::TreeBase::TestObjects');
+
+# one test per column, plus four
+sub check_table {
+ my $table = shift;
+ my %expected_columns = map {$_ => 1} @_;
+ ok(my $sth = $dbh->prepare("select * from $table"));
+ ok($sth->execute());
+ ok(my $row = $sth->fetchrow_hashref);
+ for my $col (keys %$row) {
+ ok($expected_columns{$col}, "found expected column '$col' in table '$table'");
+ delete $expected_columns{$col};
+ }
+ is(keys(%expected_columns), 0, "all columns found in table '$table'");
}
-is(keys(%x), 0, "all items found");
Added: trunk/treebase-core/src/main/perl/t/02_table.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/02_table.t (rev 0)
+++ trunk/treebase-core/src/main/perl/t/02_table.t 2009-11-24 02:47:19 UTC (rev 300)
@@ -0,0 +1,15 @@
+
+use Test::More tests => 7;
+
+use_ok('CIPRES::TreeBase::TestObjects');
+
+is(Matrix->table, "matrices");
+is(Study->table, "study");
+is(Tree->table, "TREE");
+
+is(Matrix->id_attr, "matrix_id");
+is(Study->id_attr, "study_id");
+is(Tree->id_attr, "TreeId");
+
+
+
Added: trunk/treebase-core/src/main/perl/t/10_internal.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/10_internal.t (rev 0)
+++ trunk/treebase-core/src/main/perl/t/10_internal.t 2009-11-24 02:47:19 UTC (rev 300)
@@ -0,0 +1,5 @@
+
+# To test: attr_list
+# attr_hash
+
+use Test::More 'skip_all' => 'none yet';
\ No newline at end of file
Added: trunk/treebase-core/src/main/perl/t/20_study.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/20_study.t (rev 0)
+++ trunk/treebase-core/src/main/perl/t/20_study.t 2009-11-24 02:47:19 UTC (rev 300)
@@ -0,0 +1,13 @@
+use Test::More tests => 5;
+
+use lib '../blib/lib';
+use_ok('CIPRES::TreeBase::TestObjects');
+use DBI;
+my $dbh = DBI->connect("DBI:CSV:f_dir=test_db;csv_eol=\n");
+Study->set_db_connection($dbh);
+
+ok(my $s1 = Study->new(1));
+is($s1->name, 'study one');
+
+ok(my $s8 = Study->new(8));
+is($s8->owner, 'Otto');
Added: trunk/treebase-core/src/main/perl/t/test_db
===================================================================
--- trunk/treebase-core/src/main/perl/t/test_db (rev 0)
+++ trunk/treebase-core/src/main/perl/t/test_db 2009-11-24 02:47:19 UTC (rev 300)
@@ -0,0 +1 @@
+link ../test_db
\ No newline at end of file
Property changes on: trunk/treebase-core/src/main/perl/t/test_db
___________________________________________________________________
Added: svn:special
+ *
Added: trunk/treebase-core/src/main/perl/test_db/TREE
===================================================================
--- trunk/treebase-core/src/main/perl/test_db/TREE (rev 0)
+++ trunk/treebase-core/src/main/perl/test_db/TREE 2009-11-24 02:47:19 UTC (rev 300)
@@ -0,0 +1,8 @@
+TreeId,name,root_node_id
+1,tree i,
+2,tree ii,
+24,tree xxiv,
+120,tree cxx,
+5040,tree Vxl,
+40320,tree XLcccxx,
+119,tree cxix,
\ No newline at end of file
Added: trunk/treebase-core/src/main/perl/test_db/matrices
===================================================================
--- trunk/treebase-core/src/main/perl/test_db/matrices (rev 0)
+++ trunk/treebase-core/src/main/perl/test_db/matrices 2009-11-24 02:47:19 UTC (rev 300)
@@ -0,0 +1,7 @@
+matrix_id,name,n_rows,study_id
+1,matrix I,2,2
+16,matrix XVI,17,4
+4,matrix IV,5,2
+64,matrix LXIV,65,8
+25,matrix XXV,26,5
+49,matrix XLIX,50,7
Modified: trunk/treebase-core/src/main/perl/test_db/study
===================================================================
--- trunk/treebase-core/src/main/perl/test_db/study 2009-11-23 21:45:55 UTC (rev 299)
+++ trunk/treebase-core/src/main/perl/test_db/study 2009-11-24 02:47:19 UTC (rev 300)
@@ -1,10 +1,7 @@
-name,id,interesting
-cube,8,1
-even prime,2,0
-five,5,0
-seven,7,0
-sphenic,6,1
-square 3,9,1
-square,4,1
-three,3,0
-unit,1,0
+study_id,name,owner,tree_id
+1,study one,Juan,1
+4,study four,Balfour,24
+2,study two,Thieu,2
+8,study eight,Otto,40320
+5,study five,Quentin,120
+7,study seven,Septimus,5040
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
