Menu
▾
▴
treebase-guts — Commit and tracker messages
You can subscribe to this list here.
| 2009 |
Jan
|
Feb
|
Mar
(1) |
Apr
(14) |
May
(36) |
Jun
(148) |
Jul
(33) |
Aug
(2) |
Sep
(17) |
Oct
(42) |
Nov
(137) |
Dec
(88) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2010 |
Jan
(89) |
Feb
(80) |
Mar
(217) |
Apr
(76) |
May
(5) |
Jun
(39) |
Jul
(35) |
Aug
(4) |
Sep
(7) |
Oct
(14) |
Nov
(12) |
Dec
(9) |
| 2011 |
Jan
(6) |
Feb
(4) |
Mar
(11) |
Apr
(55) |
May
(90) |
Jun
(39) |
Jul
(15) |
Aug
(15) |
Sep
(23) |
Oct
(12) |
Nov
(17) |
Dec
(20) |
| 2012 |
Jan
(22) |
Feb
(63) |
Mar
|
Apr
(1) |
May
(6) |
Jun
(3) |
Jul
(1) |
Aug
(1) |
Sep
|
Oct
|
Nov
|
Dec
|
| 2013 |
Jan
(3) |
Feb
(6) |
Mar
|
Apr
|
May
|
Jun
(4) |
Jul
(1) |
Aug
(1) |
Sep
|
Oct
|
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
|
Mar
|
Apr
(7) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <rv...@us...> - 2009-11-24 14:02:19
|
Revision: 316
http://treebase.svn.sourceforge.net/treebase/?rev=316&view=rev
Author: rvos
Date: 2009-11-24 14:02:09 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Removed Devel::StackTrace dependency
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/check/check
Modified: trunk/treebase-core/src/main/perl/check/check
===================================================================
--- trunk/treebase-core/src/main/perl/check/check 2009-11-24 12:20:10 UTC (rev 315)
+++ trunk/treebase-core/src/main/perl/check/check 2009-11-24 14:02:09 UTC (rev 316)
@@ -6,7 +6,7 @@
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
-use Devel::StackTrace; # XXX only for developing, delete me
+#use Devel::StackTrace; # XXX only for developing, delete me
use Carp 'croak';
our $indent = 0;
@@ -122,8 +122,8 @@
#print Dumper($attr);
if ( ref $attr eq 'ARRAY' ) {
print Dumper($attr);
- my $trace = Devel::StackTrace->new;
- print $trace->as_string; # like carp
+ #my $trace = Devel::StackTrace->new;
+ #print $trace->as_string; # like carp
return 1;
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-24 12:20:15
|
Revision: 315
http://treebase.svn.sourceforge.net/treebase/?rev=315&view=rev
Author: rvos
Date: 2009-11-24 12:20:10 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Removed dependency on Devel::StackTrace, lowercased hash lookup in subobject_class()
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm
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 12:19:15 UTC (rev 314)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm 2009-11-24 12:20:10 UTC (rev 315)
@@ -338,8 +338,8 @@
} elsif ($self->has_r_attr($attr)) {
return $self->get_r_subobject_no_check($attr, @_);
}
- my $trace = Devel::StackTrace->new;
- print $trace->as_string; # like carp
+# my $trace = Devel::StackTrace->new;
+# print $trace->as_string; # like carp
croak($self->class . " has no attribute named '$attr'");
}
@@ -572,7 +572,7 @@
sub subobject_class {
my ($self, $subobj) = @_;
my $subobj_class = \%{$self->class . "::subobject"};
- return $subobj_class->{$subobj} if exists $subobj_class->{$subobj};
+ return $subobj_class->{lc $subobj} if exists $subobj_class->{lc $subobj};
return $self->alias($subobj) || ucfirst(lc($subobj));
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-24 12:19:31
|
Revision: 314
http://treebase.svn.sourceforge.net/treebase/?rev=314&view=rev
Author: rvos
Date: 2009-11-24 12:19:15 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Added more %subobject entries
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm
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-24 12:15:09 UTC (rev 313)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm 2009-11-24 12:19:15 UTC (rev 314)
@@ -305,6 +305,7 @@
####################################################################################################
package AnalyzedData;
CIPRES::TreeBase::VeryBadORM->register();
+our %subobject = ('phylotree' => 'PhyloTree');
=head2 AnalyzedData
@@ -409,6 +410,10 @@
'rows' => 'MatrixRow',
'columns' => 'MatrixColumn',
);
+our %subobject = (
+ 'taxonlabelset' => 'TaxonLabelSet',
+ 'matrixkind' => 'MatrixKind',
+);
=head2 Matrix
@@ -564,6 +569,7 @@
####################################################################################################
package MatrixRow;
CIPRES::TreeBase::VeryBadORM->register();
+our %subobject = ('taxonlabel' => 'TaxonLabel');
=head2 MatrixRow
@@ -681,8 +687,9 @@
package PhyloTree;
CIPRES::TreeBase::VeryBadORM->register();
our %subobject = (
- 'rootnode' => 'PhyloTreeNode',
- 'treetype' => 'TreeType'
+ 'rootnode' => 'PhyloTreeNode',
+ 'treetype' => 'TreeType',
+ 'treeblock' => 'TreeBlock',
);
our %r_attr = ('treeblock' => 'TreeBlock');
@@ -843,9 +850,11 @@
package PhyloTreeNode;
CIPRES::TreeBase::VeryBadORM->register();
our %subobject = (
- 'child' => 'PhyloTreeNode',
- 'sibling' => 'PhyloTreeNode',
- 'parent' => 'PhyloTreeNode',
+ 'child' => 'PhyloTreeNode',
+ 'sibling' => 'PhyloTreeNode',
+ 'parent' => 'PhyloTreeNode',
+ 'taxonlabel' => 'TaxonLabel',
+ 'phylotree' => 'PhyloTree',
);
=head2 PhyloTreeNode
@@ -1348,6 +1357,7 @@
####################################################################################################
package TaxonLabel;
CIPRES::TreeBase::VeryBadORM->register();
+our %subobject = ( 'taxonvariant' => 'TaxonVariant' );
our %r_attr = ('treenodes' => 'PhyloTreeNode', 'rows' => 'MatrixRow');
our %r2_attr = ('taxonlabelsets' => ['taxonlabelset_taxonlabel', 'TaxonLabelSet']);
@@ -1553,6 +1563,7 @@
CIPRES::TreeBase::VeryBadORM->register();
our %r2_attr = ('submissions' => ['sub_treeblock', 'Submission']);
our %r_attr = ('trees' => 'PhyloTree');
+our %subobject = ( 'taxonlabelset' => 'TaxonLabelSet' );
=head2 TreeBlock
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-24 12:17:42
|
Revision: 313
http://treebase.svn.sourceforge.net/treebase/?rev=313&view=rev
Author: rvos
Date: 2009-11-24 12:15:09 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Removed some verbose data structure logging
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/check/check
Modified: trunk/treebase-core/src/main/perl/check/check
===================================================================
--- trunk/treebase-core/src/main/perl/check/check 2009-11-24 10:29:04 UTC (rev 312)
+++ trunk/treebase-core/src/main/perl/check/check 2009-11-24 12:15:09 UTC (rev 313)
@@ -119,7 +119,7 @@
# this is a handler that is passed around during consistency checks
sub attr_check {
my ($obj, $attr_name, $attr, $warnings) = @_;
- print Dumper($attr);
+ #print Dumper($attr);
if ( ref $attr eq 'ARRAY' ) {
print Dumper($attr);
my $trace = Devel::StackTrace->new;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-24 11:33:39
|
Revision: 311
http://treebase.svn.sourceforge.net/treebase/?rev=311&view=rev
Author: rvos
Date: 2009-11-24 10:12:09 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Changed unknown POD token from V to C at line 35
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm
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-24 10:11:32 UTC (rev 310)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm 2009-11-24 10:12:09 UTC (rev 311)
@@ -32,7 +32,7 @@
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
+C<ObjectClass::new(C<$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.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-24 10:29:13
|
Revision: 312
http://treebase.svn.sourceforge.net/treebase/?rev=312&view=rev
Author: rvos
Date: 2009-11-24 10:29:04 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Added POD to recdumper
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-11-24 10:12:09 UTC (rev 311)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/RecDumper.pm 2009-11-24 10:29:04 UTC (rev 312)
@@ -3,6 +3,24 @@
use File::Temp qw(tempfile);
use strict;
+=head1 CIPRES::TreeBase::RecDumper
+
+Writes the contents of a database table as CREATE and INSERT statements.
+Used by the C<sqldump> script.
+
+=head1 METHODS
+
+=over
+
+=item new()
+
+Record dumper constructor. Required named arguments:
+ * TABLE => name of table to dump
+ * FIELDS => columns to dump from the focal table
+ * TYPES => datatype names for FIELDS to dump
+
+=cut
+
# XXX LOB fields should be removed from fieldlist and handled separately
sub new {
my $class = shift;
@@ -25,11 +43,6 @@
return $self;
}
-sub set_output {
- my ($self, $fh) = @_;
- $self->{'OUT'} = $fh;
-}
-
sub _initialize {
my $self = shift;
my $fieldlist = join ", ", map qq{"$_"}, @{$self->{F}};
@@ -38,13 +51,36 @@
return;
}
+=item set_output()
+
+Set the invocant record dumper to write to the provided handle.
+
+=cut
+
+sub set_output {
+ my ($self, $fh) = @_;
+ $self->{'OUT'} = $fh;
+}
+
+=item print()
+
+Prints argument list. If set_output() has been called previously,
+this method prints to the handle provided there.
+
+=cut
+
# Print some text literally
sub print {
my $self = shift;
return print {$self->{'OUT'}} @_;
}
-# Format data into an insert statement and return (or write) the result
+=item rec()
+
+Format data into an insert statement and return (or write) the result
+
+=cut
+
sub rec {
my $self = shift;
@_ > @{$self->{F}}
@@ -58,19 +94,19 @@
else {
my ( %record, $dir, $path );
eval {
- my @fields = @{$self->{F}};
- %record = map { $fields[$_] => $_[$_] } ( 0 .. $#fields );
-# $dir = $self->{'D'} . '/' . $record{STUDY_ID};
-# mkdir $dir if not -d $dir;
-# $path = $dir . '/' . $record{FILENAME};
- my ( $fh, $filename ) = tempfile( DIR => $self->{'D'} );
- @values = ( $self->quote_data($record{STUDY_ID}), "lo_import('$filename')", $self->quote_data($record{FILENAME}) );
-# open my $nexfh, '>', $path or croak $!;
- print $fh substr( $record{NEXUS}, 1, length($record{NEXUS}) - 2 );
- close $fh;
- system('gzip','-9',$filename);
+ my @fields = @{$self->{F}};
+ %record = map { $fields[$_] => $_[$_] } ( 0 .. $#fields );
+ # $dir = $self->{'D'} . '/' . $record{STUDY_ID};
+ # mkdir $dir if not -d $dir;
+ # $path = $dir . '/' . $record{FILENAME};
+ my ( $fh, $filename ) = tempfile( DIR => $self->{'D'} );
+ @values = ( $self->quote_data($record{'STUDY_ID'}), "lo_import('$filename')", $self->quote_data($record{FILENAME}) );
+ # open my $nexfh, '>', $path or croak $!;
+ print $fh substr( $record{'NEXUS'}, 1, length($record{'NEXUS'}) - 2 );
+ close $fh;
+ system('gzip','-9',$filename);
};
- warn 'dir: ', $dir, ' path: ', $path, ' file: ', $record{FILENAME}, ' id: ', $record{STUDY_ID}, ' msg: ', $@ if $@;
+ warn 'dir: ', $dir, ' path: ', $path, ' file: ', $record{'FILENAME'}, ' id: ', $record{'STUDY_ID'}, ' msg: ', $@ if $@;
}
my $values = join ", ", @values;
my $insert = $self->{'PREFIX'} . $values . $self->{'SUFFIX'};
@@ -78,7 +114,12 @@
return $insert;
}
-# Format metadata into a create statement and return (or write) the result
+=item dump_create()
+
+Format metadata into a create statement and return (or write) the result
+
+=cut
+
sub dump_create {
my $self = shift;
my $create = qq{CREATE TABLE "$self->{'N'}";\n};
@@ -86,11 +127,19 @@
return $create;
}
+=item quote_data()
+
+For a provided list of record fields, looks up internally what the
+data types are and applies the correct quoting (e.g. numbers
+unquoted, strings quoted).
+
+=cut
+
sub quote_data {
my $self = shift;
my @d = @_;
- for my $i (0 .. $#{$self->{F}}) {
- my $t = $self->{T}[$i];
+ for my $i (0 .. $#{$self->{'F'}}) {
+ my $t = $self->{'T'}[$i];
local *_ = \$d[$i];
$_ = "NULL", next unless defined;
@@ -126,4 +175,12 @@
return @d;
}
+=back
+
+=head1 SEE ALSO
+
+sqldump
+
+=cut
+
1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-24 10:11:40
|
Revision: 310
http://treebase.svn.sourceforge.net/treebase/?rev=310&view=rev
Author: rvos
Date: 2009-11-24 10:11:32 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Skipping pod coverage test for TestObjects
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/t/pod-coverage.t
Modified: trunk/treebase-core/src/main/perl/t/pod-coverage.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/pod-coverage.t 2009-11-24 10:04:56 UTC (rev 309)
+++ trunk/treebase-core/src/main/perl/t/pod-coverage.t 2009-11-24 10:11:32 UTC (rev 310)
@@ -2,4 +2,9 @@
eval "use Test::Pod::Coverage";
plan skip_all => "Test::Pod::Coverage required for testing POD coverage"
if $@;
-all_pod_coverage_ok();
\ No newline at end of file
+pod_coverage_ok('CIPRES::TreeBase::DBILogin');
+pod_coverage_ok('CIPRES::TreeBase::DBIUtil');
+pod_coverage_ok('CIPRES::TreeBase::RecDumper');
+pod_coverage_ok('CIPRES::TreeBase::TreeBaseObjects');
+pod_coverage_ok('CIPRES::TreeBase::VeryBadORM');
+done_testing();
\ No newline at end of file
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-24 10:05:04
|
Revision: 309
http://treebase.svn.sourceforge.net/treebase/?rev=309&view=rev
Author: rvos
Date: 2009-11-24 10:04:56 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Added POD to DBIUtil
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm 2009-11-24 04:34:45 UTC (rev 308)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBIUtil.pm 2009-11-24 10:04:56 UTC (rev 309)
@@ -1,36 +1,89 @@
-
package CIPRES::TreeBase::DBIUtil;
use base 'Exporter';
use DBI;
@EXPORT = qw(print_aoh quick_select);
@EXPORT_OK = qw(get_colnames get_coltypes);
+=head1 CIPRES::TreeBase::DBIUtil
+
+Utility functions for database operations.
+
+=head1 SPECIAL VARIABLES
+
+=over
+
+=item @EXPORT
+
+Exports print_aoh and quick_select
+
+=item @EXPORT_OK
+
+Exports get_colnames and get_coltypes
+
+=back
+
+=head1 FUNCTIONS
+
+=over
+
+=item dbh()
+
+Creates and returns a database handle. Optional named arguments:
+ * user => database user name
+ * pass => database password
+ * dsn => DBI-compliant dsn template string (with optional
+ sprintf placeholders for user name and password)
+ * login_info_class => package name of a class that conforms
+ to the interface of CIPRES::TreeBase::DBILogin
+
+=cut
+
sub dbh {
my ($class) = shift;
my %opts = @_;
- my ($login_info_class) = $opts{login_info_class} || 'CIPRES::TreeBase::DBILogin';
+ my ($login_info_class) = $opts{'login_info_class'} || 'CIPRES::TreeBase::DBILogin';
my $login_info_file = $login_info_class;
$login_info_file =~ s{::}{/}g;
require "$login_info_file.pm";
- my $user = $opts{user} || $login_info_class->user;
- my $pass = $opts{pass} || $login_info_class->pass;
- my $dsn = $opts{dsn} ? sprintf $opts{dsn}, $user, $pass : $login_info_class->dsn($user, $pass);
+ my $user = $opts{'user'} || $login_info_class->user;
+ my $pass = $opts{'pass'} || $login_info_class->pass;
+ my $dsn = $opts{'dsn'} ? sprintf $opts{'dsn'}, $user, $pass : $login_info_class->dsn($user, $pass);
my $h = DBI->connect($dsn);
- $h->{private_cipres_treebase_dbiutil_username} = $user if $h;
+ $h->{'private_cipres_treebase_dbiutil_username'} = $user if $h;
return $h;
}
+=item get_user()
+
+Returns the TreeBASE database user name.
+
+=cut
+
sub get_user {
- return $_[0]{private_cipres_treebase_dbiutil_username};
+ return $_[0]{'private_cipres_treebase_dbiutil_username'};
}
+=item max()
+
+Utility function, returns the highest numerical value in the argument list.
+
+=cut
+
sub max {
my $max = shift;
$max = $max > $_ ? $max : $_ for @_;
$max;
}
+=item print_aoa()
+
+Utility function, prints an array of arrays provided as an array reference where the
+first row is a header row. Second argument is what is used to pad undefined values.
+Calls print_rows() internally.
+
+=cut
+
sub print_aoa {
my @aoa = @{shift()};
return if @aoa == 0;
@@ -39,6 +92,15 @@
print_rows(\@headers, \@aoa, $null);
}
+=item print_aoh()
+
+Utility function, prints an array of hashes provided as an array reference
+containing hash references where the keys of the first hash are used as the
+header row. Second argument is what is used to pad undefined values.
+Calls print_rows() internally.
+
+=cut
+
sub print_aoh {
my $aoh = shift;
return if @$aoh == 0;
@@ -48,31 +110,49 @@
print_rows(\@headers, \@rows, $null);
}
+=item print_rows()
+
+Internal function, called by print_aoa() and print_aoh().
+
+=cut
+
sub print_rows {
my ($headers, $rows, $null) = @_;
my @width = map length, @$headers;
for my $row (@$rows) {
- @$row = map defined() ? $_ : $null, @$row;
- s/ +$// for @$row;
- s/^ +// for @$row;
- s/([^[:print:]])/"\\x" . sprintf("%02x", ord($1))/ge for @$row;
- $width[$_] = max($width[$_], length $row->[$_]) for 0 .. $#$row;
+ @$row = map defined() ? $_ : $null, @$row;
+ s/ +$// for @$row;
+ s/^ +// for @$row;
+ s/([^[:print:]])/"\\x" . sprintf("%02x", ord($1))/ge for @$row;
+ $width[$_] = max($width[$_], length $row->[$_]) for 0 .. $#$row;
}
printcols($headers, \@width, " | ");
printhyphens(\@width, 3);
printcols($_, \@width, " | ") for @$rows;
}
+=item printcols()
+
+Internal function, called by print_rows()
+
+=cut
+
sub printcols {
my ($vals, $w, $fill) = @_;
for my $i (0 .. $#$vals) {
- my $v = $vals->[$i];
- print $v, " " x ($w->[$i] - length $v);
- print $fill unless $i == $#$vals;
+ my $v = $vals->[$i];
+ print $v, " " x ($w->[$i] - length $v);
+ print $fill unless $i == $#$vals;
}
print "\n";
}
+=item printhyphens()
+
+Internal function, called by print_rows()
+
+=cut
+
sub printhyphens {
my ($w, $x) = @_;
my $t = 0;
@@ -81,6 +161,16 @@
print "-" x $t, "\n";
}
+=item quick_select()
+
+Utility function, runs the provided query statement (second argument)
+on the provided database handle (first argument). Returns undef if
+multiple records are returned by the query (because that is considered
+an error). Otherwise returns an array or the first value of the array
+depending on context (array or scalar, respectively).
+
+=cut
+
sub quick_select {
my $dbh = shift;
my $q = shift;
@@ -91,6 +181,15 @@
return wantarray ? @rec : $rec[0];
}
+=item get_colnames()
+
+Given a database handle and a table name, returns the names
+of the columns in that table. Returns either a list or an
+array reference, depending on the context (array or scalar,
+respectively).
+
+=cut
+
# Maybe use new $dbh->table_info method instead.
sub get_colnames {
my $dbh = shift();
@@ -104,6 +203,15 @@
return wantarray() ? @$names : $names;
}
+=item get_coltypes()
+
+Given a database handle and a table name, returns the
+datatype names of the columns in the table. Returns
+either a list or an array reference, depending on the
+context (array or scalar, respectively).
+
+=cut
+
sub get_coltypes {
my $dbh = shift();
my $table = uc(shift());
@@ -117,4 +225,12 @@
return wantarray() ? @$names : $names;
}
+=back
+
+=head1 SEE ALSO
+
+L<CIPRES::TreeBase::DBILogin>, L<DBI>
+
+=cut
+
1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-24 04:34:52
|
Revision: 308
http://treebase.svn.sourceforge.net/treebase/?rev=308&view=rev
Author: mjdominus
Date: 2009-11-24 04:34:45 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
Started tests for reverse attributes.
For example, Tree has a reverse attribute of 'nodes'
which is generated by looking at the tree_id field
of the TreeNode class.
Bug fix: when the code neds to find the Foos that belong to Bar,
it used the name of Bar's primary key, rather than
the name of Foo's foreign key for Bar.
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm
Added Paths:
-----------
trunk/treebase-core/src/main/perl/t/22_reverse.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 04:01:45 UTC (rev 307)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm 2009-11-24 04:34:45 UTC (rev 308)
@@ -10,6 +10,7 @@
CIPRES::TreeBase::VeryBadORM->register();
%subobject = (root_node => 'TreeNode');
+%r_attr = (nodes => 'TreeNode');
sub table { "TREE" }
sub id_attr { "TreeId" }
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 04:01:45 UTC (rev 307)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm 2009-11-24 04:34:45 UTC (rev 308)
@@ -124,8 +124,8 @@
} elsif ($package->has_r2_attr($method)) {
return $obj->get_r2_subobject_no_check($method, @_);
} else {
- my $trace = Devel::StackTrace->new;
- print $trace->as_string; # like carp
+# my $trace = Devel::StackTrace->new;
+# print $trace->as_string; # like carp
croak("Unknown attribute '$method' in class '$package'");
}
}
@@ -195,7 +195,7 @@
sub foreign_key {
my $base = shift;
- my $subobj = lc(shift); # XXX
+ my $subobj = lc(shift());
return $subobj . "_id";
}
@@ -386,11 +386,10 @@
# and return a list of analysis objects
sub get_r_subobject_no_check {
my ($self, $attr) = @_;
- $attr = $attr;
my $target_class = $self->r_class($attr);
my $target_table = $target_class->table;
my $field = $target_class->id_attr;
- my $id_field = $self->id_attr;
+ my $id_field = $target_class->foreign_key($self->class);
my $q = "select $field from $target_table where $id_field = ?";
my $sth = $DBH->prepare_cached($q);
$sth->execute($self->id);
Added: trunk/treebase-core/src/main/perl/t/22_reverse.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/22_reverse.t (rev 0)
+++ trunk/treebase-core/src/main/perl/t/22_reverse.t 2009-11-24 04:34:45 UTC (rev 308)
@@ -0,0 +1,28 @@
+use Test::More tests => 3;
+
+use lib '../lib';
+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);
+
+my %x_names = map {$_ => 1} ('R' .. 'W');
+
+my @nodes_5040 = Tree->new(5040)->nodes;
+is (scalar(@nodes_5040), 6);
+{ my $RESULT = "";
+ for my $node (@nodes_5040) {
+ if ($node->tree_id != 5040) {
+ my $nid = $node->id; my $tid = $node->tree_id;
+ $RESULT = "Node $nid has treeid = $tid; s/b 5040";
+ last;
+ }
+ delete $x_names{$node->data};
+ }
+ if (%x_names) {
+ my $missing = each %x_names;
+ $RESULT = "Where is node '$missing'?";
+ }
+ ok($RESULT eq "", $RESULT || "Tested nodes of tree 5040");
+}
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-24 04:01:52
|
Revision: 307
http://treebase.svn.sourceforge.net/treebase/?rev=307&view=rev
Author: mjdominus
Date: 2009-11-24 04:01:45 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
rename test
Added Paths:
-----------
trunk/treebase-core/src/main/perl/t/20_scalar.t
Removed Paths:
-------------
trunk/treebase-core/src/main/perl/t/20_study.t
Copied: trunk/treebase-core/src/main/perl/t/20_scalar.t (from rev 306, trunk/treebase-core/src/main/perl/t/20_study.t)
===================================================================
--- trunk/treebase-core/src/main/perl/t/20_scalar.t (rev 0)
+++ trunk/treebase-core/src/main/perl/t/20_scalar.t 2009-11-24 04:01:45 UTC (rev 307)
@@ -0,0 +1,15 @@
+use Test::More tests => 7;
+
+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);
+
+ok(my $s1 = Study->new(1));
+is($s1->name, 'study one');
+
+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
Deleted: trunk/treebase-core/src/main/perl/t/20_study.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/20_study.t 2009-11-24 04:00:31 UTC (rev 306)
+++ trunk/treebase-core/src/main/perl/t/20_study.t 2009-11-24 04:01:45 UTC (rev 307)
@@ -1,15 +0,0 @@
-use Test::More tests => 7;
-
-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);
-
-ok(my $s1 = Study->new(1));
-is($s1->name, 'study one');
-
-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
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-24 04:00:38
|
Revision: 306
http://treebase.svn.sourceforge.net/treebase/?rev=306&view=rev
Author: mjdominus
Date: 2009-11-24 04:00:31 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
trivial change
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/t/20_study.t
Modified: trunk/treebase-core/src/main/perl/t/20_study.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/20_study.t 2009-11-24 03:59:19 UTC (rev 305)
+++ trunk/treebase-core/src/main/perl/t/20_study.t 2009-11-24 04:00:31 UTC (rev 306)
@@ -3,7 +3,7 @@
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);
+CIPRES::TreeBase::VeryBadORM->set_db_connection($dbh);
ok(my $s1 = Study->new(1));
is($s1->name, 'study one');
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-24 03:59:32
|
Revision: 305
http://treebase.svn.sourceforge.net/treebase/?rev=305&view=rev
Author: mjdominus
Date: 2009-11-24 03:59:19 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
test subobject chaining
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/t/21_subobject.t
Modified: trunk/treebase-core/src/main/perl/t/21_subobject.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/21_subobject.t 2009-11-24 03:56:01 UTC (rev 304)
+++ trunk/treebase-core/src/main/perl/t/21_subobject.t 2009-11-24 03:59:19 UTC (rev 305)
@@ -1,4 +1,4 @@
-use Test::More tests => 4;
+use Test::More tests => 11;
use_ok('CIPRES::TreeBase::TestObjects');
use DBI;
@@ -10,3 +10,11 @@
# root_node's class is defined by %Tree::subobject, not by the default behavior
is(Tree->new(24)->root_node->id, Tree->new(24)->root_node_id);
+
+# trace attributes through subobject and back again: make a tree
+# object, get is root_node object, then come back to the tree via
+# root_node:tree_id, and see if we ended in the same place
+for my $tid (1,2,24,119,120,5040,40320) {
+ is(Tree->new($tid)->root_node->tree->id, $tid);
+}
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-24 03:56:07
|
Revision: 304
http://treebase.svn.sourceforge.net/treebase/?rev=304&view=rev
Author: mjdominus
Date: 2009-11-24 03:56:01 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
register TreeNode; add test for explicit subobject specification
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm
trunk/treebase-core/src/main/perl/t/01_basic.t
trunk/treebase-core/src/main/perl/t/21_subobject.t
trunk/treebase-core/src/main/perl/test_db/node
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 03:50:24 UTC (rev 303)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TestObjects.pm 2009-11-24 03:56:01 UTC (rev 304)
@@ -9,6 +9,8 @@
package Tree;
CIPRES::TreeBase::VeryBadORM->register();
+%subobject = (root_node => 'TreeNode');
+
sub table { "TREE" }
sub id_attr { "TreeId" }
@@ -17,4 +19,9 @@
sub table { "matrices" }
+package TreeNode;
+CIPRES::TreeBase::VeryBadORM->register();
+
+sub table { "node" }
+
1;
Modified: trunk/treebase-core/src/main/perl/t/01_basic.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/01_basic.t 2009-11-24 03:50:24 UTC (rev 303)
+++ trunk/treebase-core/src/main/perl/t/01_basic.t 2009-11-24 03:56:01 UTC (rev 304)
@@ -9,7 +9,7 @@
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));
-check_table('node', qw(node_id tree_id left_child right_child data));
+check_table('node', qw(treenode_id tree_id left_child right_child data));
use_ok('CIPRES::TreeBase::TestObjects');
Modified: trunk/treebase-core/src/main/perl/t/21_subobject.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/21_subobject.t 2009-11-24 03:50:24 UTC (rev 303)
+++ trunk/treebase-core/src/main/perl/t/21_subobject.t 2009-11-24 03:56:01 UTC (rev 304)
@@ -1,4 +1,4 @@
-use Test::More tests => 3;
+use Test::More tests => 4;
use_ok('CIPRES::TreeBase::TestObjects');
use DBI;
@@ -8,4 +8,5 @@
is(Study->new(4)->Tree->name, "tree xxiv"); # use correct subobject name
is(Study->new(4)->tree->name, "tree xxiv"); # use alternate capitalization
-
+# root_node's class is defined by %Tree::subobject, not by the default behavior
+is(Tree->new(24)->root_node->id, Tree->new(24)->root_node_id);
Modified: trunk/treebase-core/src/main/perl/test_db/node
===================================================================
--- trunk/treebase-core/src/main/perl/test_db/node 2009-11-24 03:50:24 UTC (rev 303)
+++ trunk/treebase-core/src/main/perl/test_db/node 2009-11-24 03:56:01 UTC (rev 304)
@@ -1,4 +1,4 @@
-node_id,tree_id,left_child,right_child,data
+treenode_id,tree_id,left_child,right_child,data
8,2,,,D
28,119,,,CC
29,120,,,P
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-24 03:50:33
|
Revision: 303
http://treebase.svn.sourceforge.net/treebase/?rev=303&view=rev
Author: mjdominus
Date: 2009-11-24 03:50:24 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
add "node" data for trees
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/t/01_basic.t
trunk/treebase-core/src/main/perl/t/21_subobject.t
trunk/treebase-core/src/main/perl/test_db/TREE
Added Paths:
-----------
trunk/treebase-core/src/main/perl/test_db/node
Modified: trunk/treebase-core/src/main/perl/t/01_basic.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/01_basic.t 2009-11-24 03:34:05 UTC (rev 302)
+++ trunk/treebase-core/src/main/perl/t/01_basic.t 2009-11-24 03:50:24 UTC (rev 303)
@@ -1,5 +1,5 @@
-use Test::More tests => 27;
+use Test::More tests => 36;
use_ok('DBI');
use_ok('DBD::CSV');
@@ -9,6 +9,7 @@
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));
+check_table('node', qw(node_id tree_id left_child right_child data));
use_ok('CIPRES::TreeBase::TestObjects');
Modified: trunk/treebase-core/src/main/perl/t/21_subobject.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/21_subobject.t 2009-11-24 03:34:05 UTC (rev 302)
+++ trunk/treebase-core/src/main/perl/t/21_subobject.t 2009-11-24 03:50:24 UTC (rev 303)
@@ -5,5 +5,7 @@
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");
+is(Study->new(4)->Tree->name, "tree xxiv"); # use correct subobject name
+is(Study->new(4)->tree->name, "tree xxiv"); # use alternate capitalization
+
+
Modified: trunk/treebase-core/src/main/perl/test_db/TREE
===================================================================
--- trunk/treebase-core/src/main/perl/test_db/TREE 2009-11-24 03:34:05 UTC (rev 302)
+++ trunk/treebase-core/src/main/perl/test_db/TREE 2009-11-24 03:50:24 UTC (rev 303)
@@ -1,8 +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
+1,tree i,105
+2,tree ii,178
+24,tree xxiv,55
+120,tree cxx,145
+5040,tree Vxl,51
+40320,tree XLcccxx,156
+119,tree cxix,28
\ No newline at end of file
Added: trunk/treebase-core/src/main/perl/test_db/node
===================================================================
--- trunk/treebase-core/src/main/perl/test_db/node (rev 0)
+++ trunk/treebase-core/src/main/perl/test_db/node 2009-11-24 03:50:24 UTC (rev 303)
@@ -0,0 +1,30 @@
+node_id,tree_id,left_child,right_child,data
+8,2,,,D
+28,119,,,CC
+29,120,,,P
+51,5040,172,147,R
+55,24,65,,E
+65,24,131,,F
+77,5040,,,V
+92,120,,,N
+103,40320,,106,Y
+105,1,,,A
+106,40320,198,,Z
+107,120,,,Q
+131,24,,,G
+132,120,,,O
+142,120,,132,L
+145,120,149,153,H
+147,5040,,77,T
+149,120,151,142,I
+151,120,92,,K
+153,120,185,,J
+156,40320,103,,X
+169,5040,,171,U
+171,5040,,,W
+172,5040,169,,S
+174,40320,,,BB
+176,2,,,C
+178,2,176,8,B
+185,120,29,107,M
+198,40320,174,,AA
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-24 03:35:02
|
Revision: 302
http://treebase.svn.sourceforge.net/treebase/?rev=302&view=rev
Author: mjdominus
Date: 2009-11-24 03:34:05 +0000 (Tue, 24 Nov 2009)
Log Message:
-----------
remove t/1-init.t, which is redundant with t/01_basic.t
Removed Paths:
-------------
trunk/treebase-core/src/main/perl/t/1-init.t
Deleted: trunk/treebase-core/src/main/perl/t/1-init.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/1-init.t 2009-11-24 03:33:05 UTC (rev 301)
+++ trunk/treebase-core/src/main/perl/t/1-init.t 2009-11-24 03:34:05 UTC (rev 302)
@@ -1,5 +0,0 @@
-use Test::More tests => 2;
-BEGIN {
- use_ok('CIPRES::TreeBase::DBIUtil');
- use_ok('CIPRES::TreeBase::TreeBaseObjects');
-}
\ No newline at end of file
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-24 03:33:12
|
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.
|
|
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.
|
|
From: <yo...@us...> - 2009-11-23 21:46:11
|
Revision: 299
http://treebase.svn.sourceforge.net/treebase/?rev=299&view=rev
Author: youjun
Date: 2009-11-23 21:45:55 +0000 (Mon, 23 Nov 2009)
Log Message:
-----------
fix bug on test template
Modified Paths:
--------------
trunk/oai-pmh_data_provider/data_provider_web/src/main/java/org/treebase/oai/web/controller/OAIPMHController.java
trunk/oai-pmh_data_provider/data_provider_web/src/test/java/org/treebase/oai/web/controller/OAIPMHControllerTest.java
trunk/oai-pmh_data_provider/data_provider_web/src/test/resources/GetRecord.vm
trunk/oai-pmh_data_provider/data_provider_web/src/test/resources/oai_dc_record.vm
Modified: trunk/oai-pmh_data_provider/data_provider_web/src/main/java/org/treebase/oai/web/controller/OAIPMHController.java
===================================================================
--- trunk/oai-pmh_data_provider/data_provider_web/src/main/java/org/treebase/oai/web/controller/OAIPMHController.java 2009-11-23 19:25:47 UTC (rev 298)
+++ trunk/oai-pmh_data_provider/data_provider_web/src/main/java/org/treebase/oai/web/controller/OAIPMHController.java 2009-11-23 21:45:55 UTC (rev 299)
@@ -247,7 +247,10 @@
}catch(NullPointerException e){
//study 253 citation= null, data should be fixed
System.err.println("study "+study.getId()+
- " citation= "+e.getMessage());}
+ " citation= "+e.getMessage());
+ map.put("identifier", "treebase.org/study/TB2:s"+study.getId());
+ map.put("datestamp", study.getReleaseDate());
+ }
//map.put("type", "text");
//map.put("language", "en");
Modified: trunk/oai-pmh_data_provider/data_provider_web/src/test/java/org/treebase/oai/web/controller/OAIPMHControllerTest.java
===================================================================
--- trunk/oai-pmh_data_provider/data_provider_web/src/test/java/org/treebase/oai/web/controller/OAIPMHControllerTest.java 2009-11-23 19:25:47 UTC (rev 298)
+++ trunk/oai-pmh_data_provider/data_provider_web/src/test/java/org/treebase/oai/web/controller/OAIPMHControllerTest.java 2009-11-23 21:45:55 UTC (rev 299)
@@ -155,12 +155,11 @@
}
-public void testListRecords() {
-
+public void testListRecords() {
OAIPMHCommand params=new OAIPMHCommand();
params.setVerb("ListRecords");
- //params.setFrom("2005-11-15T06:16:15Z");
- params.setUntil("1996-11-04T06:16:15Z");
+ params.setFrom("2008-05-05T01:01:01Z");
+ //params.setUntil("1996-11-04T06:16:15Z");
params.setMetadataPrefix("oai_dc");
Map model=new HashMap();
model.put("identify",identify );
@@ -168,14 +167,12 @@
ModelAndView mav=controller.ListRecords(params, model);
String result=vu.runTemplate(mav);
this.assertNotNull(result);
- //System.out.println("---------test ListRecord---------");
- //System.out.print(result);
-
+ System.out.println("---------test ListRecord---------");
+ System.out.print(result);
}
public void testListIdentifiers()
- {
-
+ {
OAIPMHCommand params=new OAIPMHCommand();
params.setVerb("ListIdentifiers");
params.setFrom("2005-11-15T06:16:15Z");
Modified: trunk/oai-pmh_data_provider/data_provider_web/src/test/resources/GetRecord.vm
===================================================================
--- trunk/oai-pmh_data_provider/data_provider_web/src/test/resources/GetRecord.vm 2009-11-23 19:25:47 UTC (rev 298)
+++ trunk/oai-pmh_data_provider/data_provider_web/src/test/resources/GetRecord.vm 2009-11-23 21:45:55 UTC (rev 299)
@@ -1,6 +1,7 @@
#parse("head.vm")
<GetRecord>
#if($!model.params.metadataPrefix=="oai_dc")
+#set($record=$model.record)
#parse("oai_dc_record.vm")
#end
</GetRecord>
Modified: trunk/oai-pmh_data_provider/data_provider_web/src/test/resources/oai_dc_record.vm
===================================================================
--- trunk/oai-pmh_data_provider/data_provider_web/src/test/resources/oai_dc_record.vm 2009-11-23 19:25:47 UTC (rev 298)
+++ trunk/oai-pmh_data_provider/data_provider_web/src/test/resources/oai_dc_record.vm 2009-11-23 21:45:55 UTC (rev 299)
@@ -1,7 +1,7 @@
<record>
<header>
- <identifier>${model.record.identifier}</identifier>
- <datestamp>$!model.record.datestamp</datestamp>
+ <identifier>${record.identifier}</identifier>
+ <datestamp>$!record.datestamp</datestamp>
</header>
<metadata>
<oai_dc:dc
@@ -10,52 +10,52 @@
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://www.openarchives.org/OAI/2.0/oai_dc/
http://www.openarchives.org/OAI/2.0/oai_dc.xsd">
- #if($model.record.title)
- <dc:title>${model.record.title}</dc:title>
+ #if($record.title)
+ <dc:title>${record.title}</dc:title>
#end
- #if($model.record.creator)
- #foreach ($person in $model.record.creator)
+ #if($record.creator)
+ #foreach ($person in $record.creator)
<dc:creator>${person.lastName}, ${person.firstName}</dc:creator>
#end
#end
- #if($model.record.subject)
- <dc:subject>${model.record.subject}</dc:subject>
+ #if($record.subject)
+ <dc:subject>${record.subject}</dc:subject>
#end
- #if($model.record.description)
- <dc:description>${model.record.description}</dc:description>
+ #if($record.description)
+ <dc:description>${record.description}</dc:description>
#end
- #if($model.record.publisher)
- <dc:publisher>${model.record.publisher}</dc:publisher>
+ #if($record.publisher)
+ <dc:publisher>${record.publisher}</dc:publisher>
#end
- #if($model.record.contributor)
- <dc:contributor>${model.record.contributor}</dc:contributor>
+ #if($record.contributor)
+ <dc:contributor>${record.contributor}</dc:contributor>
#end
- #if($model.record.date)
- <dc:date>${model.record.date}</dc:date>
+ #if($record.date)
+ <dc:date>${record.date}</dc:date>
#end
- #if($model.record.type)
- <dc:type>${model.record.type}</dc:type>
+ #if($record.type)
+ <dc:type>${record.type}</dc:type>
#end
- #if($model.record.format)
- <dc:format>${model.record.format}</dc:format>
+ #if($record.format)
+ <dc:format>${record.format}</dc:format>
#end
-##if($model.record.identifier)
-##<dc:identifier>${model.record.identifier}</dc:identifier>
+##if($record.identifier)
+##<dc:identifier>${record.identifier}</dc:identifier>
##end
- #if($model.record.source)
- <dc:source>{model.record.source}</dc:source>
+ #if($record.source)
+ <dc:source>{record.source}</dc:source>
#end
- #if($model.record.language)
- <dc:language>${model.record.language}</dc:language>
+ #if($record.language)
+ <dc:language>${record.language}</dc:language>
#end
- #if($model.record.relation)
- <dc:relation>${model.record.relation}</dc:relation>
+ #if($record.relation)
+ <dc:relation>${record.relation}</dc:relation>
#end
- #if($model.record.coverage)
- <dc:coverage>${model.record.coverage}</dc:coverage>
+ #if($record.coverage)
+ <dc:coverage>${record.coverage}</dc:coverage>
#end
- #if($model.record.rights)
- <dc:rights>${model.record.rights}</dc:rights>
+ #if($record.rights)
+ <dc:rights>${record.rights}</dc:rights>
#end
</oai_dc:dc>
</metadata>
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-23 19:26:39
|
Revision: 298
http://treebase.svn.sourceforge.net/treebase/?rev=298&view=rev
Author: mjdominus
Date: 2009-11-23 19:25:47 +0000 (Mon, 23 Nov 2009)
Log Message:
-----------
add trivial test using DBD::CSV
Added Paths:
-----------
trunk/treebase-core/src/main/perl/t/01_basic.t
trunk/treebase-core/src/main/perl/test_db/
trunk/treebase-core/src/main/perl/test_db/study
Added: trunk/treebase-core/src/main/perl/t/01_basic.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/01_basic.t (rev 0)
+++ trunk/treebase-core/src/main/perl/t/01_basic.t 2009-11-23 19:25:47 UTC (rev 298)
@@ -0,0 +1,18 @@
+
+use Test::More tests => 10;
+
+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};
+}
+is(keys(%x), 0, "all items found");
+
Added: trunk/treebase-core/src/main/perl/test_db/study
===================================================================
--- trunk/treebase-core/src/main/perl/test_db/study (rev 0)
+++ trunk/treebase-core/src/main/perl/test_db/study 2009-11-23 19:25:47 UTC (rev 298)
@@ -0,0 +1,10 @@
+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
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: SourceForge.net <no...@so...> - 2009-11-23 18:31:18
|
Bugs item #2902650, was opened at 2009-11-23 13:31 Message generated for change (Tracker Item Submitted) made by sfrgpiel You can respond by visiting: https://sourceforge.net/tracker/?func=detail&atid=1126676&aid=2902650&group_id=248804 Please note that this message will contain a full copy of the comment thread, including the initial issue submission, for this request, not just the latest update. Category: ui Group: None Status: Open Priority: 7 Private: No Submitted By: William Piel (sfrgpiel) Assigned to: Nobody/Anonymous (nobody) Summary: Book titles don't appear under study tab Initial Comment: When searching on a study, under the study tab there is a column called "Title" which lists the titles for publications. Journal article titles are fine, but this column ought to also list the title of books, but it does not (that column is blank for books). In the event of book sections, this column should show the title of the chapter in the book. For example, see study_id 253 or tb_study_id S9x6x96c10c10c17 for a book title that does not appear in the column. However, if you look at the study details (e.g. http://treebasedb-dev.nescent.org:6666/treebase-web/search/study/summary.html?id=253) the citation is written properly. The book title is also missing from the BibTeX and RIS output. ---------------------------------------------------------------------- You can respond by visiting: https://sourceforge.net/tracker/?func=detail&atid=1126676&aid=2902650&group_id=248804 |
|
From: <rv...@us...> - 2009-11-23 17:42:34
|
Revision: 297
http://treebase.svn.sourceforge.net/treebase/?rev=297&view=rev
Author: rvos
Date: 2009-11-23 17:42:25 +0000 (Mon, 23 Nov 2009)
Log Message:
-----------
Adding test script for module loading
Added Paths:
-----------
trunk/treebase-core/src/main/perl/t/1-init.t
Added: trunk/treebase-core/src/main/perl/t/1-init.t
===================================================================
--- trunk/treebase-core/src/main/perl/t/1-init.t (rev 0)
+++ trunk/treebase-core/src/main/perl/t/1-init.t 2009-11-23 17:42:25 UTC (rev 297)
@@ -0,0 +1,5 @@
+use Test::More tests => 2;
+BEGIN {
+ use_ok('CIPRES::TreeBase::DBIUtil');
+ use_ok('CIPRES::TreeBase::TreeBaseObjects');
+}
\ No newline at end of file
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-23 17:24:41
|
Revision: 296
http://treebase.svn.sourceforge.net/treebase/?rev=296&view=rev
Author: rvos
Date: 2009-11-23 17:24:32 +0000 (Mon, 23 Nov 2009)
Log Message:
-----------
Added pod to DBILogin.pm
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBILogin.pm
Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBILogin.pm
===================================================================
--- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBILogin.pm 2009-11-23 17:13:57 UTC (rev 295)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/DBILogin.pm 2009-11-23 17:24:32 UTC (rev 296)
@@ -1,26 +1,88 @@
-
package CIPRES::TreeBase::DBILogin;
-my $user=$ENV{TREEBASE_DB_USER};
-my $pass=$ENV{TREEBASE_DB_PASS};
-my $dsn =$ENV{TREEBASE_DB_DSN};
+my $user=$ENV{'TREEBASE_DB_USER'};
+my $pass=$ENV{'TREEBASE_DB_PASS'};
+my $dsn =$ENV{'TREEBASE_DB_DSN'};
unless ($user && $pass && $dsn) {
die "You must define \$user, \$pass, and \$dsn";
}
+=head1 NAME
+
+CIPRES::TreeBase::DBILogin
+
+=head1 DESCRIPTION
+
+Provides TreeBASE login credentials
+
+=head1 PACKAGE VARIABLES
+
+=over
+
+=item $user
+
+The database user name. This package copies the value from the $ENV{'TREEBASE_DB_USER'}
+environment variable.
+
+=item $pass
+
+The database password. This package copies the value from the $ENV{'TREEBASE_DB_PASS'}
+environment variable.
+
+=item $dsn
+
+A template for a L<DBI>-compliant dsn string. This package copies the value from
+the $ENV{'TREEBASE_DB_DSN'} environment variable. The template can contain placeholders
+as used by sprintf (i.e. of the format C<%s>) within which the user name and password
+can be interpolated (in that order).
+
+=back
+
+=head1 PACKAGE METHODS
+
+=over
+
+=item user()
+
+Returns the value of the private $user package variable
+
+=cut
+
sub user {
return $user;
}
+=item pass()
+
+Returns the value of the private $pass package variable
+
+=cut
+
sub pass {
return $pass;
}
+=item dsn()
+
+Constructs a L<DBI>-compliant dsn string by using the private $dsn package
+variable as a template within which it interpolates the $user and $pass private
+variables using sprintf().
+
+=cut
+
sub dsn {
my ($self, $user, $pass) = @_;
sprintf $dsn, $user, $pass;
}
+=back
+
+=head1 SEE ALSO
+
+L<DBIUtils>
+
+=cut
+
1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-23 17:14:07
|
Revision: 295
http://treebase.svn.sourceforge.net/treebase/?rev=295&view=rev
Author: rvos
Date: 2009-11-23 17:13:57 +0000 (Mon, 23 Nov 2009)
Log Message:
-----------
Added POD to VeryBadORM.pm
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm
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 14:59:51 UTC (rev 294)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm 2009-11-23 17:13:57 UTC (rev 295)
@@ -1,4 +1,3 @@
-
package CIPRES::TreeBase::VeryBadORM;
use Carp 'croak';
use strict 'vars';
@@ -7,14 +6,75 @@
our %dbh;
our $DBH;
+=head1 NAME
+
+CIPRES::TreeBase::VeryBadORM
+
+=head1 DESCRIPTION
+
+Superclass for TreeBASE objects. This class is subclassed by packages in TreeBaseObjects.
+
+=head1 PACKAGE VARIABLES
+
+=over
+
+=item %dbh
+
+This hash holds cached (in theory different) database handles keyed on class names.
+
+=item $DBH
+
+Holds a singleton database handle
+
+=back
+
+=head1 PACKAGE METHODS
+
+=over
+
+=item set_db_connection()
+
+Sets the database handle for the invoking child class. Called as a package method.
+
+=cut
+
sub set_db_connection { my $class = shift; $DBH = $dbh{$class} = shift; }
+
+=item get_db_connection()
+
+Gets the database handle for the invoking child class. Called as a package method.
+
+=cut
+
sub get_db_connection { my $class = shift; return $dbh{$class}; }
+=back
+
+=head1 INSTANCE METHODS
+
+=over
+
+=item prepare_cached()
+
+Prepares a query on the singleton database handle, returns statement handler.
+
+=cut
+
sub prepare_cached {
my ($self, $q) = @_;
return $DBH->prepare_cached($q);
}
+=item new()
+
+Instantiates an instance of one of the classes defined in TreeBaseObjects. This constructor
+requires that the singleton database handle $CIPRES::TreeBase::VeryBadORM::DBH has been defined
+and that a valid ID is supplied as argument. Instantiated objects are cached in the private
+%cache hash as $cache{$class}{$id}. Returned objects are simply blessed hash references that
+contain the ID as { 'id' => $id }
+
+=cut
+
my %cache;
sub new {
my ($class, $id) = @_;
@@ -31,6 +91,15 @@
return $obj;
}
+=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
+get_no_check(), get_subobject_no_check(), get_r_subobject_no_check() or get_r2_subobject_no_check()
+respectively. Croaks otherwise.
+
+=cut
+
# Maybe add some caching here at some point
sub AUTOLOAD {
my $obj = shift;
@@ -51,36 +120,85 @@
}
}
+=item has_attr()
+
+Checks to see if the invocant's class defines the supplied attribute. It does this by calling
+attr_hash() and doing a lookup for the supplied attribute in the returned hash.
+
+=cut
+
sub has_attr {
my $base = shift;
my $class = ref($base) || $base;
return $class->attr_hash()->{shift()};
}
+=item has_r_attr()
+
+Checks to see if the invocant's class defines the supplied "reverse attribute" (see
+L<TreeBaseObjects> for the description of the %r_attr hash). It does this by returning whatever
+is returned by r_class() whilst passing it the supplied "reverse attribute"'s name.
+
+=cut
+
sub has_r_attr {
my $base = shift;
my $class = ref($base) || $base;
return $class->r_class(shift());
}
+=item has_r2_attr()
+
+Checks to see if the invocant's class defines the supplied "reverse attribute through
+intersection table" (see L<TreeBaseObjects> for the description of the %r2_attr hash). It does this
+by returning whatever is returned by r2_class() whilst passing it the supplied "reverse
+attribute through intersection table"'s name.
+
+=cut
+
sub has_r2_attr {
my $base = shift;
my $class = ref($base) || $base;
return $class->r2_class(shift());
}
+=item has_subobject()
+
+Checks to see if the invocant is associated with the supplied subobject. It does this by
+first turning the subobject's name into a foreign key column (by calling foreign_key()) and then
+checking whether that column is available as an attribute (by calling has_attr()).
+
+=cut
+
sub has_subobject {
my $base = shift;
my $subobj = shift;
return $base->has_attr($base->foreign_key($subobj));
}
+=item foreign_key()
+
+Turns the supplied argument into a foreign key column. It does this by lower casing the
+argument string and appending '_id'.
+
+=cut
+
sub foreign_key {
my $base = shift;
my $subobj = lc(shift); # XXX
return $subobj . "_id";
}
+=item attr_hash()
+
+Returns a hash reference of all available attributes for the invocant. It does this by first
+checking to see if there is an %attr hash defined in the invocant's class (and returns
+a reference to that if it's there). Otherwise it calls attr_list, uses its contents as keys
+(values are 1) and adds the class name . '_id', i.e. a lookup of the primary key. On subsequent
+calls the output is cached due to the autovivification of the package hash.
+
+=cut
+
sub attr_hash {
my $base = shift;
my $class = ref($base) || $base;
@@ -90,40 +208,69 @@
my $attr_list = $base->attr_list;
if (@$attr_list) {
%$attr_hash = map { $_ => 1 } @$attr_list;
- $attr_hash->{"$class\_id"} = 1;
+ $attr_hash->{"$class\_id"} = 1; # XXX case correct?
return $attr_hash;
}
return;
}
+=item attr_list()
+
+Returns an array reference of available attributes. It does this by checking if there is an
+array ref $attr available in the invocant's class (and returns that). Otherwise it checks
+the invocant's mapped database table and collects the returned column names and returns those.
+On subsequent calls the output is cached due to the autovivification of the package array.
+
+=cut
+
sub attr_list {
my $base = shift;
my $class = ref($base) || $base;
my $attr_list = \@{"$class\::attr"};
return $attr_list if @$attr_list;
- my $q = "select * from " . $base->table . " fetch first 1 rows only";
+ my $q = "select * from " . $base->table . " fetch first 1 rows only"; # XXX case correct?
my $sth = $DBH->prepare_cached($q);
$sth->execute();
while (my $row = $sth->fetchrow_hashref) {
- @$attr_list = keys %$row;
+ @$attr_list = keys %$row;
}
$sth->finish;
return $attr_list;
}
+=item r_attr_hash()
+
+Returns the %r_attr hash defined in the invocant's class (see TreeBaseObjects for a description
+of what that hash is for).
+
+=cut
+
sub r_attr_hash {
my $base = shift;
my $class = ref($base) || $base;
return my $r_attr_hash = \%{"$class\::r_attr"};
}
+=item r2_attr_hash()
+
+Returns the %r2_attr hash defined in the invocant's class (see TreeBaseObjects for a description
+of what that hash is for).
+
+=cut
+
sub r2_attr_hash {
my $base = shift;
my $class = ref($base) || $base;
return my $r_attr_hash = \%{"$class\::r2_attr"};
}
+=item reify()
+
+Populates the invocant object's attributes from the database.
+
+=cut
+
sub reify {
my $obj = shift;
return $obj if $obj->reified;
@@ -134,40 +281,76 @@
$sth->execute($id_value);
my $rows = 0;
while (my $row = $sth->fetchrow_hashref()) {
- %$obj = %$row;
- $obj->{ID} = $obj->{$id_attr};
- $obj->set_reified();
- if (++$rows > 1) {
- croak("Table '$table' has multiple entries for $id_attr = $id_value");
- }
+ %$obj = %$row;
+ $obj->{'id'} = $obj->{$id_attr};
+ $obj->set_reified();
+ if (++$rows > 1) {
+ croak("Table '$table' has multiple entries for $id_attr = $id_value");
+ }
}
return $obj;
}
-sub reified { $_[0]{reified} }
-sub set_reified { $_[0]{reified} = 1 }
+=item reified()
+Returns whether the invocant has been reified (see reify()).
+
+=cut
+
+sub reified { $_[0]{'reified'} }
+
+=item set_reified()
+
+Flags that the invocant object has been reified.
+
+=cut
+
+sub set_reified { $_[0]{'reified'} = 1 }
+
+=item get()
+
+Given an invocant and a supplied attribute name, returns the attribute value. What the attribute
+actually is, is decided by first checking has_attr(), has_subobject(), has_r_attr() and returns
+the output of either get_no_check(), get_subobject_no_check() or get_r_subobject_no_check()
+respectively. B<This method is probably never used and therefore probably buggy.>
+
+=cut
+
sub get {
my ($self, $attr) = @_;
if ($self->has_attr($attr)) {
- return $self->get_no_check($attr);
+ return $self->get_no_check($attr);
} elsif ($self->has_subobject($attr)) {
- return $self->get_subobject_no_check($attr, @_);
+ return $self->get_subobject_no_check($attr, @_);
} elsif ($self->has_r_attr($attr)) {
- return $self->get_r_subobject_no_check($attr, @_);
+ return $self->get_r_subobject_no_check($attr, @_);
}
my $trace = Devel::StackTrace->new;
print $trace->as_string; # like carp
croak($self->class . " has no attribute named '$attr'");
}
+=item get_no_check()
+
+Returns the value of the supplied attribute name as applies to the invocant object. This will
+most likely just return scalar, non-reference values such as titles and labels.
+
+=cut
+
sub get_no_check {
my ($self, $attr) = @_;
- return $self->id if $attr eq "id";
+ return $self->id if $attr eq 'id';
return $self->{$attr} if exists $self->{$attr};
return $self->{$attr} = $self->reify->{$attr};
}
+=item get_subobject_no_check()
+
+Treats the supplied attribute name as either a true attribute or name from which a subobject
+(in one-to-one relation) is instantiated. See description of %subobject hash in TreeBaseObjects.
+
+=cut
+
sub get_subobject_no_check {
my ($self, $attr) = @_;
return $self->{$attr} if exists $self->{$attr};
@@ -176,6 +359,13 @@
return $self->{$attr} = $self->subobject_class($attr)->new($id);
}
+=item get_r_subobject_no_check()
+
+Treats the supplied attribute name as either a true attribute or name from which a subobject
+(in many-to-one relation) is instantiated. See description of %r_attr hash in TreeBaseObjects.
+
+=cut
+
# Example: Studies have analyses as a subobject
# $study->get_r_subobject_no_check("analyses")
# should query
@@ -198,6 +388,13 @@
return @results;
}
+=item get_r2_subobject_no_check()
+
+Treats the supplied attribute name as either a true attribute or name from which a subobject
+(in many-to-one relation) is instantiated. See description of %r2_attr hash in TreeBaseObjects.
+
+=cut
+
# Example: Treeblocks have submissions as subobjects
# and vice versa
# $treeblock->get_r2_subobject_no_check("submission")
@@ -206,7 +403,7 @@
# and return a list of submission objects
sub get_r2_subobject_no_check {
my ($self, $attr) = @_;
- $attr = uc $attr;
+# $attr = uc $attr;
my $q = $self->r2_subobject_query($attr);
my $target_class = $self->r2_class($attr);
my $sth = $self->prepare_cached($q);
@@ -217,6 +414,19 @@
}
return @results;
}
+
+=item r2_subobject_query()
+
+Creates a SQL statement to resolve the many-to-many relationship (through intersection table)
+between the invocant object and the supplied attribute. It does this by looking up the class
+name to instantiate from (by calling r2_class()), the intersection table to look up the relation
+(by calling r2_table()) and the field name of the id column in the intersection table (by calling
+r2_id_attr()).
+
+See description of %r2_attr hash in TreeBaseObjects.
+
+=cut
+
sub r2_subobject_query {
my ($self, $attr) = @_;
@@ -228,65 +438,183 @@
return $q;
}
+=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.
+
+See description of %r2_attr hash in TreeBaseObjects. This method returns the 3rd element (index 2)
+in the value array ref.
+
+=cut
+
sub r2_id_attr {
my ($self, $attr) = @_;
- $self->r2_attr_hash()->{uc $attr}->[2] || $self->r2_class($attr)->id_attr;
+ $self->r2_attr_hash()->{$attr}->[2] || $self->r2_class($attr)->id_attr;
}
+=item to_str()
+
+Stringification method. Returns at least the invocant's class name and its ID number, possibly
+augmented by other attributes (as implemented in child classes).
+
+=cut
+
sub to_str { my $self = shift;
my %attr = @_;
return $self->class . " #" . $self->id; }
+=item id()
+
+Returns the invocant's identifier number.
+
+=cut
+
sub id { $_[0]{'id'} }
+
+=item id_attr()
+
+Returns the name of the column that contains the primary key for instances of the invocant class.
+
+=cut
+
sub id_attr { return lc($_[0]->class . "_id") };
+
+=item class()
+
+Returns the invocant class name.
+
+=cut
+
sub class { return ref($_[0]) || $_[0]; }
my %known_class;
+=item known_class_hash()
+
+Returns a reference to the private %known_class hash, in which child classes register themselves.
+
+=cut
+
sub known_class_hash { return \%known_class; }
+
+=item register()
+
+Called by child classes in the package body. Causes these classes to be registered in the
+%known_class hash. Can be called with arguments, in which case the arguments are considered
+class names to register, or without any, in which case the class name is deduced by using
+caller().
+
+=cut
+
sub register {
my $my_class = shift;
my @classes = @_;
@classes = scalar(caller()) unless @classes;
for my $class (@classes) {
push @{"$class\::ISA"}, $my_class;
- $class->known_class_hash->{uc $class} = $class;
+ $class->known_class_hash->{uc $class} = $class; # XXX casing correct?
}
}
+=item alias()
+
+Returns a registered alias for the supplied class name.
+
+=cut
+
sub alias {
my ($base, $class) = @_;
return $base->known_class_hash->{$class};
}
+=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.
+
+=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));
+ return $self->alias($subobj) || $subobj;#ucfirst(lc($subobj)); # XXX really?
}
+=item get_id_pair()
+
+Returns the name of the column that contains the primary key in the table onto which the invocant's
+class is mapped, and the value of the id for the invocant instance.
+
+=cut
+
sub get_id_pair {
my $self = shift;
return ($self->id_attr, $self->id);
}
-sub table { return $_[0]->class; }
+=item table()
+
+Returns the name of the table onto which the invocant's class is mapped.
+
+=cut
+
+sub table { return $_[0]->class; } # XXX case correct?
+
+=item r_class()
+
+Returns the class name for the supplied attribute. This is a value in the %r_attr hash.
+
+=cut
+
sub r_class {
my ($self, $r_attr) = @_;
return $self->r_attr_hash()->{$r_attr};
}
+=item r2_table()
+
+Returns the name of the intersection table that connects instances of invocant's class to other
+objects in a many-to-many relation.
+
+See a description of the %r2_attr hash in TreeBaseObjects. This method returns the first field
+(index 0) in the value array reference.
+
+=cut
+
sub r2_table {
my ($self, $r_attr) = @_;
return $self->r2_attr_hash()->{$r_attr}->[0];
}
+=item r2_class()
+
+Returns the class name for objects that are in a many-to-many relationship with the invocant
+object through an intersection table.
+
+See a description of the %r2_attr hash in TreeBaseObjects. This method returns the second field
+(index 1) in the value array reference.
+
+=cut
+
sub r2_class {
my ($self, $r_attr) = @_;
return $self->r2_attr_hash()->{$r_attr}->[1];
}
+=item dump()
+
+Traverses invocant, executes supplied handlers as defined by the named 'action' argument. The
+'action' argument provides a subroutine reference whose first argument is the invocant, remaining
+arguments are a pass-through of @_. The dump method recurses through the invocant, an operation
+whose depth can be limited by providing a named 'maxdepth' argument.
+
+=cut
+
sub dump {
my $self = shift();
my %attr = @_;
@@ -303,10 +631,44 @@
delete $attr{$class};
}
+=item recurse()
+
+Empty placeholder method. Implemented by child classes in TreeBaseObjects.
+
+=cut
+
sub recurse { }
+
+=item consistent()
+
+Empty placeholder method. Implemented by child classes in TreeBaseObjects. Returns true by default.
+
+=cut
+
sub consistent { 1; }
+
+=item is_nested()
+
+Empty placeholder method. Implemented by child classes in TreeBaseObjects. Returns false by default.
+
+=cut
+
sub is_nested { 0; }
+=item DESTROY()
+
+Empty destructor, needed here so that it's not dispatched to AUTOLOAD
+
+=cut
+
sub DESTROY { }
+=back
+
+=head1 SEE ALSO
+
+L<TreeBaseObjects>
+
+=cut
+
1;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <mjd...@us...> - 2009-11-23 15:00:49
|
Revision: 294
http://treebase.svn.sourceforge.net/treebase/?rev=294&view=rev
Author: mjdominus
Date: 2009-11-23 14:59:51 +0000 (Mon, 23 Nov 2009)
Log Message:
-----------
adding AUTHOR section to manual to test subversion commit
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/check/check
Modified: trunk/treebase-core/src/main/perl/check/check
===================================================================
--- trunk/treebase-core/src/main/perl/check/check 2009-11-23 14:45:44 UTC (rev 293)
+++ trunk/treebase-core/src/main/perl/check/check 2009-11-23 14:59:51 UTC (rev 294)
@@ -62,6 +62,10 @@
specified class. For example, "check Study 1234" prints out study #1234
and all of its trees, matrices, analyses, etc., and their contents.
+=head1 AUTHOR
+
+Mark Jason Dominus (mj...@pl...)
+
=cut
my $TERMINAL;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <rv...@us...> - 2009-11-23 14:45:52
|
Revision: 293
http://treebase.svn.sourceforge.net/treebase/?rev=293&view=rev
Author: rvos
Date: 2009-11-23 14:45:44 +0000 (Mon, 23 Nov 2009)
Log Message:
-----------
Added POD
Modified Paths:
--------------
trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm
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 14:10:51 UTC (rev 292)
+++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/TreeBaseObjects.pm 2009-11-23 14:45:44 UTC (rev 293)
@@ -8,14 +8,50 @@
=head1 DESCRIPTION
+=head1 PACKAGE VARIABLES
+
=over
=item %r_attr
+This hash specifies which other classes refer to the specifying class in a many-to-one relationship.
+For example:
+
+ %Analysis::r_attr = ( 'analysissteps' => 'AnalysisStep' );
+
+Specifies that multiple AnalysisStep objects may refer to an invocant Analysis object, and that
+these AnalysisStep objects can be instantiated by calling the Analysis::analysissteps() method.
+
=item %r2_attr
+This hash specifies associated objects which are linked to instances of the specifying class
+through an intersection table. For example:
+
+ %Citation::r2_attr = (
+ 'authors' => ['citation_author', 'Person', 'authors_person_id']
+ );
+
+Specifies that associated instances of the Person class can be fetched by calling the
+Citation::authors() method which will look in the citation_author table and instantiate
+Person objects passing the values in the authors_person_id column to the Person
+constructor.
+
=item %subobject
+This hash specifies associated classes which are identified by foreign keys in the table that is
+mapped onto the specifying class. For example:
+
+ %PhyloTree::subobject = (
+ 'rootnode' => 'PhyloTreeNode',
+ 'treetype' => 'TreeType'
+ );
+
+Specifies that an associated instance (one-to-one) of the PhyloTree's root node (instantiated
+as a PhyloTreeNode) and of the tree type (instantiates as a TreeType object) can be
+created by calling the rootnode() and treetype() methods, respectively. Calls to those methods
+will look in phylotree.rootnode_id and phylotree.treetype_id in the row of the invocant object
+and create the right associated objects.
+
=back
=head1 PACKAGE METHODS
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
1 message has been excluded from this view by a project administrator.
