# $Id$ package Bio::Phylo::Taxa::TaxonLinker; use Bio::Phylo::Mediators::TaxaMediator; use Bio::Phylo::Util::Exceptions; use Bio::Phylo::Util::CONSTANT qw(_TAXON_ looks_like_object); use strict; { my $TAXON_CONSTANT = _TAXON_; my $logger = Bio::Phylo->get_logger; =head1 NAME Bio::Phylo::Taxa::TaxonLinker - Superclass for objects that link to taxon objects. =head1 SYNOPSIS use Bio::Phylo::Forest::Node; use Bio::Phylo::Taxa::Taxon; my $node = Bio::Phylo::Forest::Node->new; my $taxon = Bio::Phylo::Taxa::Taxon->new; # just to show who's what if ( $node->isa('Bio::Phylo::Taxa::TaxonLinker') ) { $node->set_taxon( $taxon ); } # prints 'Bio::Phylo::Taxa::Taxon' print ref $node->get_taxon =head1 DESCRIPTION This module is a superclass for objects that link to L objects. =head1 METHODS =head2 MUTATORS =over =item set_taxon() Links the invocant object to a taxon object. Type : Mutator Title : set_taxon Usage : $obj->set_taxon( $taxon ); Function: Links the invocant object to a taxon object. Returns : Modified $obj Args : A Bio::Phylo::Taxa::Taxon object. =cut sub set_taxon { my ( $self, $taxon ) = @_; if ( $taxon and looks_like_object $taxon, $TAXON_CONSTANT ) { $logger->info("setting taxon '$taxon'"); Bio::Phylo::Mediators::TaxaMediator->set_link( '-one' => $taxon, '-many' => $self, ); } else { $logger->info("re-setting taxon link"); Bio::Phylo::Mediators::TaxaMediator->remove_link( '-many' => $self ); } return $self; } =item unset_taxon() Unlinks the invocant object from any taxon object. Type : Mutator Title : unset_taxon Usage : $obj->unset_taxon(); Function: Unlinks the invocant object from any taxon object. Returns : Modified $obj Args : NONE =cut sub unset_taxon { my $self = shift; $logger->debug("unsetting taxon"); $self->set_taxon(); return $self; } =back =head2 ACCESSORS =over =item get_taxon() Retrieves the Bio::Phylo::Taxa::Taxon object linked to the invocant. Type : Accessor Title : get_taxon Usage : my $taxon = $obj->get_taxon; Function: Retrieves the Bio::Phylo::Taxa::Taxon object linked to the invocant. Returns : Bio::Phylo::Taxa::Taxon Args : NONE Comments: =cut sub get_taxon { my $self = shift; $logger->info("getting taxon"); return Bio::Phylo::Mediators::TaxaMediator->get_link( '-source' => $self ); } sub _cleanup { my $self = shift; #$logger->debug("cleaning up '$self'"); } =back =head1 SEE ALSO =over =item L The datum object subclasses L. =item L The node object subclasses L. =item L Also see the manual: L and L. =back =head1 REVISION $Id$ =cut } 1;