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. |