[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