branch-1-6/Bio/Taxon.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Taxon
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Sendu Bala <bix@sendu.me.uk>
   8 #
   9 # Copyright Sendu Bala, based heavily on a module by Jason Stajich
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12
  13 # POD documentation - main docs before the code
  14
  15 =head1 NAME
  16
  17 Bio::Taxon - A node in a represented taxonomy
  18
  19 =head1 SYNOPSIS
  20
  21   use Bio::Taxon;
  22
  23   # Typically you will get a Taxon from a Bio::DB::Taxonomy object
  24   # but here is how you initialize one
  25   my $taxon = Bio::Taxon->new(-name      => $name,
  26                              -id        => $id,
  27                              -rank      => $rank,
  28                              -division  => $div);
  29
  30   # Get one from a database
  31   my $dbh = Bio::DB::Taxonomy->new(-source   => 'flatfile',
  32                                   -directory=> '/tmp',
  33                                   -nodesfile=> '/path/to/nodes.dmp',
  34                                   -namesfile=> '/path/to/names.dmp');
  35   my $human = $dbh->get_taxon(-name => 'Homo sapiens');
  36   $human = $dbh->get_taxon(-taxonid => '9606');
  37
  38   print "id is ", $human->id, "\n"; # 9606
  39   print "rank is ", $human->rank, "\n"; # species
  40   print "scientific name is ", $human->scientific_name, "\n"; # Homo sapiens
  41   print "division is ", $human->division, "\n"; # Primates
  42
  43   my $mouse = $dbh->get_taxon(-name => 'Mus musculus');
  44
  45   # You can quickly make your own lineages with the list database
  46   my @ranks = qw(superkingdom class genus species);
  47   my @h_lineage = ('Eukaryota', 'Mammalia', 'Homo', 'Homo sapiens');
  48   my $list_dbh = Bio::DB::Taxonomy->new(-source => 'list', -names => \@h_lineage,
  49                                                           -ranks => \@ranks);
  50   $human = $list_dbh->get_taxon(-name => 'Homo sapiens');
  51   my @names = $human->common_names; # @names is empty
  52   $human->common_names('woman');
  53   @names = $human->common_names; # @names contains woman
  54
  55   # You can switch to another database when you need more information
  56   my $entrez_dbh = Bio::DB::Taxonomy->new(-source => 'entrez');
  57   $human->db_handle($entrez_dbh);
  58   @names = $human->common_names; # @names contains woman, human, man
  59
  60   # Since Bio::Taxon implements Bio::Tree::NodeI, we have access to those
  61   # methods (and can manually create our own taxa and taxonomy without the use
  62   # of any database)
  63   my $homo = $human->ancestor;
  64
  65   # Though be careful with each_Descendent - unless you add_Descendent()
  66   # yourself, you won't get an answer because unlike for ancestor(), Bio::Taxon
  67   # does not ask the database for the answer. You can ask the database yourself
  68   # using the same method:
  69   ($human) = $homo->db_handle->each_Descendent($homo);
  70
  71   # We can also take advantage of Bio::Tree::Tree* methods:
  72   # a) some methods are available with just an empty tree object
  73   use Bio::Tree::Tree;
  74   my $tree_functions = Bio::Tree::Tree->new();
  75   my @lineage = $tree_functions->get_lineage_nodes($human);
  76   my $lca = $tree_functions->get_lca($human, $mouse);
  77
  78   # b) for other methods, create a tree using your Taxon object
  79   my $tree = Bio::Tree::Tree->new(-node => $human);
  80   my @taxa = $tree->get_nodes;
  81   $homo = $tree->find_node(-rank => 'genus');
  82
  83   # Normally you can't get the lca of a list-database derived Taxon and an
  84   # entrez or flatfile-derived one because the two different databases might
  85   # have different roots and different numbers of ranks between the root and the
  86   # taxa of interest. To solve this, make a tree of the Taxon with the more
  87   # detailed lineage and splice out all the taxa that won't be in the lineage of
  88   # your other Taxon:
  89   my $entrez_mouse = $entrez_dbh->get_taxon(-name => 'Mus musculus');
  90   my $list_human = $list_dbh->get_taxon(-name => 'Homo sapiens');
  91   my $mouse_tree = Bio::Tree::Tree->new(-node => $entrez_mouse);
  92   $mouse_tree->splice(-keep_rank => \@ranks);
  93   $lca = $mouse_tree->get_lca($entrez_mouse, $list_human);
  94
  95 =head1 DESCRIPTION
  96
  97 This is the next generation (for Bioperl) of representing Taxonomy
  98 information. Previously all information was managed by a single
  99 object called Bio::Species. This new implementation allows
 100 representation of the intermediate nodes not just the species nodes
 101 and can relate their connections.
 102
 103 =head1 FEEDBACK
 104
 105 =head2 Mailing Lists
 106
 107 User feedback is an integral part of the evolution of this and other
 108 Bioperl modules. Send your comments and suggestions preferably to
 109 the Bioperl mailing list.  Your participation is much appreciated.
 110
 111   bioperl-l@bioperl.org                  - General discussion
 112   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 113
 114 =head2 Support
 115
 116 Please direct usage questions or support issues to the mailing list:
 117
 118 I<bioperl-l@bioperl.org>
 119
 120 rather than to the module maintainer directly. Many experienced and
 121 reponsive experts will be able look at the problem and quickly
 122 address it. Please include a thorough description of the problem
 123 with code and data examples if at all possible.
 124
 125 =head2 Reporting Bugs
 126
 127 Report bugs to the Bioperl bug tracking system to help us keep track
 128 of the bugs and their resolution. Bug reports can be submitted via
 129 the web:
 130
 131   http://bugzilla.open-bio.org/
 132
 133 =head1 AUTHOR - Sendu Bala
 134
 135 Email bix@sendu.me.uk
 136
 137 =head1 CONTRIBUTORS
 138
 139 Jason Stajich,    jason-at-bioperl-dot-org (original Bio::Taxonomy::Node)
 140 Juguang Xiao,     juguang@tll.org.sg
 141 Gabriel Valiente, valiente@lsi.upc.edu
 142
 143 =head1 APPENDIX
 144
 145 The rest of the documentation details each of the object methods.
 146 Internal methods are usually preceded with a _
 147
 148 =cut
 149
 150 package Bio::Taxon;
 151 use strict;
 152
 153 use Bio::DB::Taxonomy;
 154
 155 use base qw(Bio::Tree::Node Bio::IdentifiableI);
 156
 157 =head2 new
 158
 159  Title   : new
 160  Usage   : my $obj = Bio::Taxonomy::Node->new();
 161  Function: Builds a new Bio::Taxonomy::Node object
 162  Returns : an instance of Bio::Taxonomy::Node
 163  Args    : -dbh               => a reference to a Bio::DB::Taxonomy object
 164                                  [no default]
 165            -name              => a string representing the taxon name
 166                                  (scientific name)
 167            -id                => human readable id - typically NCBI taxid
 168            -ncbi_taxid        => same as -id, but explicitely say that it is an
 169                                  NCBI taxid
 170            -rank              => node rank (one of 'species', 'genus', etc)
 171            -common_names      => array ref of all common names
 172            -division          => 'Primates', 'Rodents', etc
 173            -genetic_code      => genetic code table number
 174            -mito_genetic_code => mitochondrial genetic code table number
 175            -create_date       => date created in database
 176            -update_date       => date last updated in database
 177            -pub_date          => date published in database
 178
 179 =cut
 180
 181 sub new {
 182     my ($class, @args) = @_;
 183     my $self = $class->SUPER::new(@args);
 184     my ($name, $id, $objid, $rank, $div, $dbh, $ncbitaxid, $commonname,
 185         $commonnames, $gcode, $mitocode, $createdate, $updatedate, $pubdate,
 186         $parent_id) = $self->_rearrange([qw(NAME ID OBJECT_ID RANK DIVISION DBH
 187                                             NCBI_TAXID COMMON_NAME COMMON_NAMES
 188                                             GENETIC_CODE MITO_GENETIC_CODE
 189                                             CREATE_DATE UPDATE_DATE PUB_DATE
 190                                             PARENT_ID)], @args);
 191
 192     if (defined $id && (defined $ncbitaxid && $ncbitaxid ne $id || defined $objid && $objid ne $id)) {
 193         $self->warn("Only provide one of -id, -object_id or -ncbi_taxid, using $id\n");
 194     }
 195     elsif(!defined $id) {
 196         $id = $objid || $ncbitaxid;
 197     }
 198     defined $id && $self->id($id);
 199     $self->{_ncbi_tax_id_provided} = 1 if $ncbitaxid;
 200
 201     defined $rank && $self->rank($rank);
 202     defined $name && $self->node_name($name);
 203
 204     my @common_names;
 205     if ($commonnames) {
 206         $self->throw("-common_names takes only an array reference") unless $commonnames
 207             && ref($commonnames) eq 'ARRAY';
 208         @common_names = @{$commonnames};
 209     }
 210     if ($commonname) {
 211         my %c_names = map { $_ => 1 } @common_names;
 212         unless (exists $c_names{$commonname}) {
 213             unshift(@common_names, $commonname);
 214         }
 215     }
 216     @common_names > 0 && $self->common_names(@common_names);
 217
 218     defined $gcode      && $self->genetic_code($gcode);
 219     defined $mitocode   && $self->mitochondrial_genetic_code($mitocode);
 220     defined $createdate && $self->create_date($createdate);
 221     defined $updatedate && $self->update_date($updatedate);
 222     defined $pubdate    && $self->pub_date($pubdate);
 223     defined $div        && $self->division($div);
 224     defined $dbh        && $self->db_handle($dbh);
 225
 226     # deprecated and will issue a warning when method called,
 227     # eventually to be removed completely as option
 228     defined $parent_id  && $self->parent_id($parent_id);
 229
 230     # some things want to freeze/thaw Bio::Species objects, but
 231     # _root_cleanup_methods contains a CODE ref, delete it.
 232     delete $self->{_root_cleanup_methods};
 233
 234     return $self;
 235 }
 236
 237 =head1 Bio::IdentifiableI interface
 238
 239 Also see L<Bio::IdentifiableI>
 240
 241 =head2 version
 242
 243  Title   : version
 244  Usage   : $taxon->version($newval)
 245  Returns : value of version (a scalar)
 246  Args    : on set, new value (a scalar or undef, optional)
 247
 248 =cut
 249
 250 sub version {
 251     my $self = shift;
 252     return $self->{'version'} = shift if @_;
 253     return $self->{'version'};
 254 }
 255
 256 =head2 authority
 257
 258  Title   : authority
 259  Usage   : $taxon->authority($newval)
 260  Returns : value of authority (a scalar)
 261  Args    : on set, new value (a scalar or undef, optional)
 262
 263 =cut
 264
 265 sub authority {
 266     my $self = shift;
 267     return $self->{'authority'} = shift if @_;
 268     return $self->{'authority'};
 269 }
 270
 271 =head2 namespace
 272
 273  Title   : namespace
 274  Usage   : $taxon->namespace($newval)
 275  Returns : value of namespace (a scalar)
 276  Args    : on set, new value (a scalar or undef, optional)
 277
 278 =cut
 279
 280 sub namespace {
 281     my $self = shift;
 282     return $self->{'namespace'} = shift if @_;
 283     return $self->{'namespace'};
 284 }
 285
 286 =head1 Bio::Taxonomy::Node implementation
 287
 288 =head2 db_handle
 289
 290  Title   : db_handle
 291  Usage   : $taxon->db_handle($newval)
 292  Function: Get/Set Bio::DB::Taxonomy Handle
 293  Returns : value of db_handle (a scalar) (Bio::DB::Taxonomy object)
 294  Args    : on set, new value (a scalar, optional) Bio::DB::Taxonomy object
 295
 296 Also see L<Bio::DB::Taxonomy>
 297
 298 =cut
 299
 300 sub db_handle {
 301     my $self = shift;
 302     if (@_) {
 303         my $db = shift;
 304
 305         if (! ref($db) || ! $db->isa('Bio::DB::Taxonomy')) {
 306             $self->throw("Must provide a valid Bio::DB::Taxonomy object to db_handle()");
 307         }
 308         if (!$self->{'db_handle'} || ($self->{'db_handle'} && $self->{'db_handle'} ne $db)) {
 309             my $new_self = $self->_get_similar_taxon_from_db($self, $db);
 310             $self->_merge_taxa($new_self) if $new_self;
 311         }
 312
 313         # NB: The Bio::DB::Taxonomy modules access this data member directly
 314         # to avoid calling this method and going infinite
 315         $self->{'db_handle'} = $db;
 316     }
 317     return $self->{'db_handle'};
 318 }
 319
 320 =head2 rank
 321
 322  Title   : rank
 323  Usage   : $taxon->rank($newval)
 324  Function: Get/set rank of this Taxon, 'species', 'genus', 'order', etc...
 325  Returns : value of rank (a scalar)
 326  Args    : on set, new value (a scalar or undef, optional)
 327
 328 =cut
 329
 330 sub rank {
 331     my $self = shift;
 332     return $self->{'rank'} = shift if @_;
 333     return $self->{'rank'};
 334 }
 335
 336 =head2 id
 337
 338  Title   : id
 339  Usage   : $taxon->id($newval)
 340  Function: Get/Set id (NCBI Taxonomy ID in most cases); object_id() and
 341            ncbi_taxid() are synonyms of this method.
 342  Returns : id (a scalar)
 343  Args    : none to get, OR scalar to set
 344
 345 =cut
 346
 347 sub id {
 348     my $self = shift;
 349     return $self->SUPER::id(@_);
 350 }
 351
 352 *object_id = \&id;
 353
 354 =head2 ncbi_taxid
 355
 356  Title   : ncbi_taxid
 357  Usage   : $taxon->ncbi_taxid($newval)
 358  Function: Get/Set the NCBI Taxonomy ID; This actually sets the id() but only
 359            returns an id when ncbi_taxid has been explictely set with this
 360            method.
 361  Returns : id (a scalar)
 362  Args    : none to get, OR scalar to set
 363
 364 =cut
 365
 366 sub ncbi_taxid {
 367     my ($self, $id) = @_;
 368
 369     if ($id) {
 370         $self->{_ncbi_tax_id_provided} = 1;
 371         return $self->SUPER::id($id);
 372     }
 373
 374     if ($self->{_ncbi_tax_id_provided}) {
 375         return $self->SUPER::id;
 376     }
 377     return;
 378 }
 379
 380 =head2 parent_id
 381
 382  Title   : parent_id
 383  Usage   : $taxon->parent_id()
 384  Function: Get parent ID, (NCBI Taxonomy ID in most cases);
 385            parent_taxon_id() is a synonym of this method.
 386  Returns : value of parent_id (a scalar)
 387  Args    : none
 388  Status  : deprecated
 389
 390 =cut
 391
 392 sub parent_id {
 393     my $self = shift;
 394     if (@_) {
 395         $self->warn("You can no longer set the parent_id - use ancestor() instead");
 396     }
 397     my $ancestor = $self->ancestor() || return;
 398     return $ancestor->id;
 399 }
 400
 401 *parent_taxon_id = \&parent_id;
 402
 403 =head2 genetic_code
 404
 405  Title   : genetic_code
 406  Usage   : $taxon->genetic_code($newval)
 407  Function: Get/set genetic code table
 408  Returns : value of genetic_code (a scalar)
 409  Args    : on set, new value (a scalar or undef, optional)
 410
 411 =cut
 412
 413 sub genetic_code {
 414     my $self = shift;
 415     return $self->{'genetic_code'} = shift if @_;
 416     return $self->{'genetic_code'};
 417 }
 418
 419 =head2 mitochondrial_genetic_code
 420
 421  Title   : mitochondrial_genetic_code
 422  Usage   : $taxon->mitochondrial_genetic_code($newval)
 423  Function: Get/set mitochondrial genetic code table
 424  Returns : value of mitochondrial_genetic_code (a scalar)
 425  Args    : on set, new value (a scalar or undef, optional)
 426
 427 =cut
 428
 429 sub mitochondrial_genetic_code {
 430     my $self = shift;
 431     return $self->{'mitochondrial_genetic_code'} = shift if @_;
 432     return $self->{'mitochondrial_genetic_code'};
 433 }
 434
 435 =head2 create_date
 436
 437  Title   : create_date
 438  Usage   : $taxon->create_date($newval)
 439  Function: Get/Set Date this node was created (in the database)
 440  Returns : value of create_date (a scalar)
 441  Args    : on set, new value (a scalar or undef, optional)
 442
 443 =cut
 444
 445 sub create_date {
 446     my $self = shift;
 447     return $self->{'create_date'} = shift if @_;
 448     return $self->{'create_date'};
 449 }
 450
 451 =head2 update_date
 452
 453  Title   : update_date
 454  Usage   : $taxon->update_date($newval)
 455  Function: Get/Set Date this node was updated (in the database)
 456  Returns : value of update_date (a scalar)
 457  Args    : on set, new value (a scalar or undef, optional)
 458
 459 =cut
 460
 461 sub update_date {
 462     my $self = shift;
 463     return $self->{'update_date'} = shift if @_;
 464     return $self->{'update_date'};
 465 }
 466
 467 =head2 pub_date
 468
 469  Title   : pub_date
 470  Usage   : $taxon->pub_date($newval)
 471  Function: Get/Set Date this node was published (in the database)
 472  Returns : value of pub_date (a scalar)
 473  Args    : on set, new value (a scalar or undef, optional)
 474
 475 =cut
 476
 477 sub pub_date {
 478     my $self = shift;
 479     return $self->{'pub_date'} = shift if @_;
 480     return $self->{'pub_date'};
 481 }
 482
 483 =head2 ancestor
 484
 485  Title   : ancestor
 486  Usage   : my $ancestor_taxon = $taxon->ancestor()
 487  Function: Retrieve the ancestor taxon. Normally the database is asked what the
 488            ancestor is.
 489
 490            If you manually set the ancestor (or you make a Bio::Tree::Tree with
 491            this object as an argument to new()), the database (if any) will not
 492            be used for the purposes of this method.
 493
 494            To restore normal database behaviour, call ancestor(undef) (which
 495            would remove this object from the tree), or request this taxon again
 496            as a new Taxon object from the database.
 497
 498  Returns : Bio::Taxon
 499  Args    : none
 500
 501 =cut
 502
 503 sub ancestor {
 504     my $self = shift;
 505     my $ancestor = $self->SUPER::ancestor(@_);
 506     my $dbh = $self->db_handle || return $ancestor;
 507
 508     if ($ancestor) {
 509         return $ancestor;
 510     }
 511     else {
 512         #*** could avoid the db lookup if we knew our current id was definitely
 513         #    information from the db...
 514         my $definitely_from_dbh = $self->_get_similar_taxon_from_db($self);
 515         return $dbh->ancestor($definitely_from_dbh);
 516     }
 517 }
 518
 519 =head2 get_Parent_Node
 520
 521  Title   : get_Parent_Node
 522  Function: Synonym of ancestor()
 523  Status  : deprecated
 524
 525 =cut
 526
 527 sub get_Parent_Node {
 528     my $self = shift;
 529     $self->warn("get_Parent_Node is deprecated, use ancestor() instead");
 530     return $self->ancestor(@_);
 531 }
 532
 533 =head2 each_Descendent
 534
 535  Title   : each_Descendent
 536  Usage   : my @taxa = $taxon->each_Descendent();
 537  Function: Get all the descendents for this Taxon (but not their descendents,
 538            ie. not a recursive fetchall). get_Children_Nodes() is a synonym of
 539            this method.
 540
 541            Note that this method never asks the database for the descendents;
 542            it will only return objects you have manually set with
 543            add_Descendent(), or where this was done for you by making a
 544            Bio::Tree::Tree with this object as an argument to new().
 545
 546            To get the database descendents use
 547            $taxon->db_handle->each_Descendent($taxon).
 548
 549  Returns : Array of Bio::Taxon objects
 550  Args    : optionally, when you have set your own descendents, the string
 551            "height", "creation", "alpha", "revalpha", or coderef to be used to
 552            sort the order of children nodes.
 553
 554 =cut
 555
 556 # implemented by Bio::Tree::Node
 557
 558 =head2 get_Children_Nodes
 559
 560  Title   : get_Children_Nodes
 561  Function: Synonym of each_Descendent()
 562  Status  : deprecated
 563
 564 =cut
 565
 566 sub get_Children_Nodes {
 567     my $self = shift;
 568     $self->warn("get_Children_Nodes is deprecated, use each_Descendent() instead");
 569     return $self->each_Descendent(@_);
 570 }
 571
 572 =head2 name
 573
 574   Title:    name
 575   Usage:    $taxon->name('scientific', 'Homo sapiens');
 576             $taxon->name('common', 'human', 'man');
 577             my @names = @{$taxon->name('common')};
 578   Function: Get/set the names. node_name(), scientific_name() and common_names()
 579             are shorthands to name('scientific'), name('scientific') and
 580             name('common') respectively.
 581   Returns:  names (a array reference)
 582   Args:     Arg1 => the name_class. You can assign any text, but the words
 583                 'scientific' and 'common' have the special meaning, as
 584                 scientific name and common name, respectively. 'scientific' and
 585                 'division' are treated specially, allowing only the first value
 586                 in the Arg2 list to be set.
 587             Arg2 .. => list of names
 588
 589 =cut
 590
 591 sub name {
 592     my ($self, $name_class, @names) = @_;
 593     $self->throw('No name class specified') unless defined $name_class;
 594
 595     if (@names) {
 596         if ($name_class =~ /scientific|division/i) {
 597             delete $self->{'_names_hash'}->{$name_class};
 598             @names = (shift(@names));
 599         }
 600         push @{$self->{'_names_hash'}->{$name_class}}, @names;
 601     }
 602     return $self->{'_names_hash'}->{$name_class} || return;
 603 }
 604
 605 =head2 node_name
 606
 607  Title   : node_name
 608  Usage   : $taxon->node_name($newval)
 609  Function: Get/set the name of this taxon (node), typically the scientific name
 610            of the taxon, eg. 'Primate' or 'Homo'; scientific_name() is a synonym
 611            of this method.
 612  Returns : value of node_name (a scalar)
 613  Args    : on set, new value (a scalar or undef, optional)
 614
 615 =cut
 616
 617 sub node_name {
 618     my $self = shift;
 619     my @v = @{$self->name('scientific', @_) || []};
 620     return pop @v;
 621 }
 622
 623 *scientific_name = \&node_name;
 624
 625 =head2 common_names
 626
 627  Title   : common_names
 628  Usage   : $taxon->common_names($newval)
 629  Function: Get/add the other names of this taxon, typically the genbank common
 630            name and others, eg. 'Human' and 'man'. common_name() is a synonym
 631            of this method.
 632  Returns : array of names in list context, one of those names in scalar context
 633  Args    : on add, new list of names (scalars, optional)
 634
 635 =cut
 636
 637 sub common_names {
 638     my $self = shift;
 639     my @v = @{$self->name('common', @_) || []};
 640     return ( wantarray ) ? @v : pop @v;
 641 }
 642
 643 *common_name = \&common_names;
 644
 645 =head2 division
 646
 647  Title   : division
 648  Usage   : $taxon->division($newval)
 649  Function: Get/set the division this taxon belongs to, eg. 'Primates' or
 650            'Bacteria'.
 651  Returns : value of division (a scalar)
 652  Args    : on set, new value (a scalar or undef, optional)
 653
 654 =cut
 655
 656 sub division {
 657     my $self = shift;
 658     my @v = @{$self->name('division',@_) || []};
 659     return pop @v;
 660 }
 661
 662 # get a node from the database that is like the supplied node
 663 sub _get_similar_taxon_from_db {
 664     #*** not really happy with this having to be called so much; there must be
 665     #    a better way...
 666     my ($self, $taxon, $db) = @_;
 667     $self->throw("Must supply a Bio::Taxon") unless ref($taxon) && $taxon->isa("Bio::Taxon");
 668     ($self->id || $self->node_name) || return;
 669     $db ||= $self->db_handle || return;
 670
 671     my $db_taxon = $db->get_taxon(-taxonid => $taxon->id) if $taxon->id;
 672     unless ($db_taxon) {
 673         my @try_ids = $db->get_taxonids($taxon->node_name) if $taxon->node_name;
 674
 675         my $own_rank = $taxon->rank || 'no rank';
 676         foreach my $try_id (@try_ids) {
 677             my $try = $db->get_taxon(-taxonid => $try_id);
 678             my $try_rank = $try->rank || 'no rank';
 679             if ($own_rank eq 'no rank' || $try_rank eq 'no rank' || $own_rank eq $try_rank) {
 680                 $db_taxon = $try;
 681                 last;
 682             }
 683         }
 684     }
 685
 686     return $db_taxon;
 687 }
 688
 689 # merge data from supplied Taxon into self
 690 sub _merge_taxa {
 691     my ($self, $taxon) = @_;
 692     $self->throw("Must supply a Bio::Taxon object") unless ref($taxon) && $taxon->isa('Bio::Taxon');
 693     return if ($taxon eq $self);
 694
 695     foreach my $attrib (qw(scientific_name version authority namespace genetic_code mitochondrial_genetic_code create_date update_date pub_date division id)) {
 696         my $own = $self->$attrib();
 697         my $his = $taxon->$attrib();
 698         if (!$own && $his) {
 699             $self->$attrib($his);
 700         }
 701     }
 702
 703     my $own = $self->rank || 'no rank';
 704     my $his = $taxon->rank || 'no rank';
 705     if ($own eq 'no rank' && $his ne 'no rank') {
 706         $self->rank($his);
 707     }
 708
 709     my %own_cnames = map { $_ => 1 } $self->common_names;
 710     my %his_cnames = map { $_ => 1 } $taxon->common_names;
 711     foreach (keys %his_cnames) {
 712         unless (exists $own_cnames{$_}) {
 713             $self->common_names($_);
 714         }
 715     }
 716
 717     #*** haven't merged the other things in names() hash, could do above much easier with direct access to object data
 718 }
 719
 720 =head2 remove_Descendent
 721
 722  Title   : remove_Descendent
 723  Usage   : $node->remove_Descedent($node_foo);
 724  Function: Removes a specific node from being a Descendent of this node
 725  Returns : nothing
 726  Args    : An array of Bio::Node::NodeI objects which have been previously
 727            passed to the add_Descendent call of this object.
 728
 729 =cut
 730
 731 sub remove_Descendent {
 732     # need to override this method from Bio::Tree::Node since it casually
 733     # throws away nodes if they don't branch
 734     my ($self,@nodes) = @_;
 735     my $c= 0;
 736     foreach my $n ( @nodes ) {
 737         if ($self->{'_desc'}->{$n->internal_id}) {
 738             $self->{_removing_descendent} = 1;
 739             $n->ancestor(undef);
 740             $self->{_removing_descendent} = 0;
 741             $self->{'_desc'}->{$n->internal_id}->ancestor(undef);
 742             delete $self->{'_desc'}->{$n->internal_id};
 743             $c++;
 744         }
 745     }
 746     return $c;
 747 }
 748
 749 1;