$species = Bio::Species->new(-classification => [@classification]);
                                    # Can also pass classification
                                    # array to new as below

    $species->classification(qw( sapiens Homo Hominidae
                                 Catarrhini Primates Eutheria
                                 Mammalia Vertebrata Chordata
                                 Metazoa Eukaryota ));

    $genus = $species->genus();

    $bi = $species->binomial();     # $bi is now "Homo sapiens"

    # For storing common name
    $species->common_name("human");

    # For storing subspecies
    $species->sub_species("accountant");

    my($class, @args) = @_;
    
    my $self = $class->SUPER::new(@args);
    
    my ($org, $sp, $var, $classification) =
        $self->_rearrange([qw(ORGANELLE
					       SUB_SPECIES
					       VARIANT
					       CLASSIFICATION)], @args);
    
    if (defined $classification && ref($classification) eq "ARRAY" && @{$classification}) {
        $self->classification(@$classification);
    }
    else {
        # store a tree on ourselves so we can use Tree methods
        $self->{tree} = new Bio::Tree::Tree();
        
        # some things want to freeze/thaw Bio::Species objects, but
        # _root_cleanup_methods contains a CODE ref, delete it.
        # delete $self->{tree}->{_root_cleanup_methods};
    }
    
    defined $org && $self->organelle($org);
    defined $sp  && $self->sub_species($sp); 
    defined $var && $self->variant($var);
    
    return $self;

    my ($self, @vals) = @_;

    if (@vals) {
        if (ref($vals[0]) eq 'ARRAY') {
            @vals = @{$vals[0]};
        }
        
        # 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)."')");
            }
        }
        
        # create a lineage for ourselves
        my $db = Bio::DB::Taxonomy->new(-source => 'list', -names => [reverse @vals]);
        unless ($self->scientific_name) {
            # assume we're supposed to be the leaf of the supplied lineage
            $self->scientific_name($vals[0]);
        }
        unless ($self->rank) {
            # and that we are rank species
            $self->rank('species');
        }
        
        $self->db_handle($db);

        $self->{tree} = Bio::Tree::Tree->new(-node => $self);
        # some things want to freeze/thaw Bio::Species objects, but tree's
        # _root_cleanup_methods contains a CODE ref, delete it.
        #*** even if we don't delete the cleanup methods, we still get memory
        #    leak-like symtoms, and the actual cleanup causes a mass of
        #    warnings... needs investigation!
        delete $self->{tree}->{_root_cleanup_methods};
    }
    
    @vals = ();
    foreach my $node ($self->{tree}->get_lineage_nodes($self), $self) {
        unshift(@vals, $node->scientific_name || next);
    }
    weaken($self->{tree}->{'_rootnode'}) unless isweak($self->{tree}->{'_rootnode'});
    return @vals;

    my ($self, $species) = @_;
    
	if ($species) {
		$self->{_species} = $species;
	}
	
	unless (defined $self->{_species}) {
		# work it out from our nodes
		my $species_taxon = $self->{tree}->find_node(-rank => 'species');
		unless ($species_taxon) {
			# just assume we are rank species
			$species_taxon = $self;
		}
		
		$species = $species_taxon->scientific_name;
		
		#
		# munge it like the Bio::SeqIO modules used to do
		# (more or less copy/pasted from old Bio::SeqIO::genbank, hence comments
		#  referring to 'ORGANISM' etc.)
		#
		
		my $root = $self->{tree}->get_root_node;
		unless ($root) {
            $self->{tree} = new Bio::Tree::Tree(-node => $species_taxon);
            delete $self->{tree}->{_root_cleanup_methods};
            $root = $self->{tree}->get_root_node;
        }
        
		my @spflds = split(' ', $species);
		if (@spflds > 1 && $root->node_name ne 'Viruses') {
			$species = undef;
			
			# does the next term start with uppercase?
			# yes: valid genus; no then unconventional
			# e.g. leaf litter basidiomycete sp. Collb2-39
			my $genus;
			if ($spflds[0] =~ m/^[A-Z]/) {
				$genus = shift(@spflds);
			}
			else {
				undef $genus;
			}
			
			my $sub_species;
			if (@spflds) {
				while (my $fld = shift @spflds) {
					$species .= "$fld ";
					# does it have subspecies or varieties?
					last if ($fld =~ m/(sp\.|var\.)/);
				}
				chop $species;	# last space
				$sub_species = join ' ',@spflds if(@spflds);
			}
			else {
				$species = 'sp.';
			}
			
			# does ORGANISM start with any words which make its genus undefined?
			# these are in @unkn_genus	
			# this in case species starts with uppercase so isn't caught above. 
			# alter common name if required
			my $unconv = 0; # is it unconventional species name?
			my @unkn_genus = ('unknown','unclassified','uncultured','unidentified');
			foreach (@unkn_genus) {
				if ($genus && $genus =~ m/$_/i)	{
					$species = $genus . " " . $species;
					undef $genus;
					$unconv = 1;
					last;
				}
				elsif ($species =~ m/$_/i)	{
					$unconv = 1;
					last;
				}
			}
			if (!$unconv && !$sub_species && $species =~ s/^(\w+)\s(\w+)$/$1/)	{
				# need to extract subspecies from conventional ORGANISM format.  
				# Will the 'word' in a two element species name
				# e.g. $species = 'thummi thummi' => $species='thummi' & 
				# $sub_species='thummi'
				$sub_species = $2;
			}
			
			$self->genus($genus) if $genus;
			$self->sub_species($sub_species) if $sub_species;
		}
		
		$self->{_species} = $species;
	}
	
	return $self->{_species};

    my ($self, $genus) = @_;
    
	if ($genus) {
        $self->{_genus} = $genus;
    }
	
	unless (defined $self->{_genus}) {
		my $genus_taxon = $self->{tree}->find_node(-rank => 'genus');
		unless ($genus_taxon) {
			# just assume our ancestor is rank genus
			$genus_taxon = $self->ancestor;
		}
		
		$self->{_genus} = $genus_taxon->scientific_name if $genus_taxon;
	}
	
	return $self->{_genus};

    my ($self, $sub) = @_;
    
    unless (defined $self->{'_sub_species'}) {
        my $ss_taxon = $self->{tree}->find_node(-rank => 'subspecies');
        if ($ss_taxon) {
            if ($sub) {
                $ss_taxon->scientific_name($sub);
            }
            return $ss_taxon->scientific_name;
        }
    }
    
    # fall back to direct storage on self
    $self->{'_sub_species'} = $sub if $sub;
    return $self->{'_sub_species'};

    my ($self, $var) = @_;
    
    unless (defined $self->{'_variant'}) {
        my $var_taxon = $self->{tree}->find_node(-rank => 'variant');
        if ($var_taxon) {
            if ($var) {
                $var_taxon->scientific_name($var);
            }
            return $var_taxon->scientific_name;
        }
    }
    
    # fall back to direct storage on self
    $self->{'_variant'} = $var if $var;
    return $self->{'_variant'};

    my ($self, $full) = @_;
    my $rank = $self->rank || 'no rank';
    
    my ($species, $genus) = ($self->species, $self->genus);
    unless (defined $species) {
        $species = 'sp.';
        $self->warn("requested binomial but classification was not set");
    }
    $genus = '' unless( defined $genus);
    
    $species =~ s/$genus\s+//;
    
    my $bi = "$genus $species";
    if (defined($full) && $full =~ /full/i) { 
        my $ssp = $self->sub_species;
        if ($ssp) {
            $ssp =~ s/$bi\s+//;
            $ssp =~ s/$species\s+//;
            $bi .= " $ssp";
        }
    }
    return $bi;

    my( $self, $string ) = @_;

    return 1 if $string eq "sp.";
	return 1 if $string =~ /strain/;
    return 1 if $string =~ /^[a-z][\w\s-]+$/i;
    $self->throw("Invalid species name '$string'");

    return 1;

    my($self) = shift;
    return $self->{'_organelle'} = shift if @_;
    return $self->{'_organelle'};

    my $self = shift;
    $self->{tree}->cleanup_tree if $self->{tree};
    delete $self->{tree};
    $self->node_cleanup;

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  http://bugzilla.open-bio.org/

 Title   : ncbi_taxid
 Usage   : $obj->ncbi_taxid($newval)
 Function: Get/set the NCBI Taxon ID
 Returns : the NCBI Taxon ID as a string
 Args    : newvalue to set or undef to unset (optional)

 Title   : common_name
 Usage   : $self->common_name( $common_name );
           $common_name = $self->common_name();
 Function: Get or set the common name of the species
 Example : $self->common_name('human')
 Returns : The common name in a string
 Args    : String, which is the common name (optional)

 Title   : division
 Usage   : $obj->division($newval)
 Function: Genbank Division for a species
 Returns : value of division (a scalar)
 Args    : value of division (a scalar)