[Bioperl-guts-l] bioperl-live/Bio Species.pm,1.46,1.47
Senduran Balasubramaniam
sendu at dev.open-bio.org
Fri Dec 1 13:51:48 EST 2006
Update of /home/repository/bioperl/bioperl-live/Bio
In directory dev.open-bio.org:/tmp/cvs-serv13874/Bio
Modified Files:
Species.pm
Log Message:
possible fix for problem similar to bug 2092
Index: Species.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Species.pm,v
retrieving revision 1.46
retrieving revision 1.47
diff -C2 -d -r1.46 -r1.47
*** Species.pm 25 Nov 2006 21:19:39 -0000 1.46
--- Species.pm 1 Dec 2006 18:51:46 -0000 1.47
***************
*** 162,170 ****
# make sure the lineage contains us as first or second element
! # (lineage may have subspeces, species, genus ...)
my $name = $self->node_name;
! if ($name && ($name ne $vals[0] && $name ne $vals[1]) &&
! $name ne "$vals[1] $vals[0]") {
! $self->throw("The supplied lineage does not start near '$name'");
}
--- 162,177 ----
# make sure the lineage contains us as first or second element
! # (lineage may have subspecies, species, genus ...)
my $name = $self->node_name;
! if ($name && ($name ne $vals[0] && $name ne $vals[1]) && $name ne "$vals[1] $vals[0]") {
! if ($name =~ /^$vals[1] $vals[0]\s*(.+)/) {
! # just assume the problem is someone tried to make a Bio::Species starting at subspecies
! #*** no idea if this is appropriate! just a possible fix related to bug 2092
! $self->sub_species($1);
! $name = $self->node_name("$vals[1] $vals[0]");
! }
! else {
! $self->throw("The supplied lineage does not start near '$name' (I was supplied '".join(" | ", @vals)."')");
! }
}
***************
*** 195,199 ****
unshift(@vals, $node->scientific_name || next);
}
! weaken($self->{tree}->{'_rootnode'});
return @vals;
}
--- 202,206 ----
unshift(@vals, $node->scientific_name || next);
}
! weaken($self->{tree}->{'_rootnode'}) unless isweak($self->{tree}->{'_rootnode'});
return @vals;
}
More information about the Bioperl-guts-l
mailing list