Permalink
Browse files

[bug 2092]

* commit Sendu's patch
* comment out lines in SpeciesAdaptor that munge genus/species names (old behavior)
* 02species.t tests now failing, checking to see what the problem is

svn path=/bioperl-db/trunk/; revision=15997
  • Loading branch information...
1 parent cc427ed commit 3e7e0b7ee3c059a6dbc76dd3174d743920746064 cjfields committed Aug 25, 2009
Showing with 37 additions and 14 deletions.
  1. +26 −11 lib/Bio/DB/BioSQL/SpeciesAdaptor.pm
  2. +11 −3 t/08genbank.t
@@ -96,6 +96,7 @@ use strict;
use Bio::DB::BioSQL::BasePersistenceAdaptor;
use Bio::DB::PersistentObjectI;
use Bio::Species;
+use Data::Dumper;
@ISA = qw(Bio::DB::BioSQL::BasePersistenceAdaptor);
@@ -263,26 +264,36 @@ sub populate_from_row{
$obj->ncbi_taxid($rows->[3]) if $rows->[3];
# get the classification array in a separate query
my $clf = $self->get_classification($rows->[0]);
- if($clf && @$clf) {
+ if($clf && ref $clf eq 'ARRAY') {
# for the species object we do not maintain the nodes that don't
# correspond to a standard rank, so remove them (e.g., 'root')
while($clf->[0]->[1] && ($clf->[0]->[1] eq "no rank")) {
shift(@$clf);
}
# in the species object we store the species element without the
# genus, and similarly for the sub-species and variant
- for(my $i = scalar(@$clf)-2; $i >= 0; $i--) {
- # if this node's name matches the start of the previous one,
- # remove this portion from the previous one's name
- if(index($clf->[$i+1]->[0], $clf->[$i]->[0]) == 0) {
- $clf->[$i+1]->[0] = substr($clf->[$i+1]->[0],
- length($clf->[$i]->[0])+1);
- }
- # don't do this stuff beyond genus and species
- last if $clf->[$i]->[1] eq "genus";
- }
+
+ # Commented out: 8-24-09 cjfields, re: bug 2092
+ # explanation : Bio::Species (and BioPerl after 1.5.2) don't munge
+ # the genus/species names if at all possible
+
+ # for(my $i = scalar(@$clf)-2; $i >= 0; $i--) {
+ # # if this node's name matches the start of the previous one,
+ # # remove this portion from the previous one's name
+ # if(index($clf->[$i+1]->[0], $clf->[$i]->[0]) == 0) {
+ # $clf->[$i+1]->[0] = substr($clf->[$i+1]->[0],
+ # length($clf->[$i]->[0])+1);
+ # }
+ # # don't do this stuff beyond genus and species
+ # last if $clf->[$i]->[1] eq "genus";
+ # }
+
# we do not store the variant nor subspecies etc in the species
# object's classification array, so we need to sort those out
+
+ # TODO: this needs to be clarified in re: to the new behavior of
+ # Bio::Species -- cjfields 8-24-09
+
my $rank = $clf->[scalar(@$clf)-1]->[1];
while(grep { $rank eq $_; } keys %rank_attr_map) {
my $meth = $rank_attr_map{$rank};
@@ -293,6 +304,10 @@ sub populate_from_row{
# done massaging, store away
$obj->classification([reverse(map { $_->[0]; } @$clf)], "FORCE");
}
+ # cases where no node is found (or taxonomy isn't loaded)
+
+ # TODO: do we still do the following based on current Species behavior?
+ # -- cjfields 8/24/09
if($rows->[4] && (! $obj->classification)) {
# poor man's binomial
my @clf = split(' ',$rows->[4]);
View
@@ -1,24 +1,30 @@
# -*-Perl-*-
# $Id$
+use strict;
+use warnings;
+
BEGIN {
use lib 't';
use Bio::Root::Test;
- test_begin(-tests => 21);
+ test_begin(-tests => 23);
use_ok('DBTestHarness');
use_ok('Bio::SeqIO');
use_ok('Bio::DB::Persistent::BioNamespace');
}
-$biosql = DBTestHarness->new("biosql");
-$db = $biosql->get_DBAdaptor();
+my $biosql = DBTestHarness->new("biosql");
+my $db = $biosql->get_DBAdaptor();
ok $db;
my $seqio = Bio::SeqIO->new('-format' => 'genbank',
'-file' => test_input_file('parkin.gb'));
my $seq = $seqio->next_seq();
ok $seq;
+my $sn = $seq->species->scientific_name;
+my $sc = join(", ", $seq->species->classification);
+
my $pseq = $db->create_persistent($seq);
$pseq->namespace("mytestnamespace");
$pseq->store();
@@ -43,6 +49,8 @@ eval {
is ($dbseq->seq_version, $seq->seq_version);
is ($dbseq->version, 1);
is ($dbseq->version, $seq->version);
+ is ($dbseq->species->scientific_name, $sn);
+ is (join(", ", $dbseq->species->classification), $sc);
};
print STDERR $@ if $@;

0 comments on commit 3e7e0b7

Please sign in to comment.