view release on metacpan or  search on metacpan

lib/Bio/Phylo/Mediators/TaxaMediator.pm  view on Meta::CPAN

            # to it
            if ( $taxa_id ) {
                my @others = keys %{ $one_to_many{$taxa_id} };
                if ( @others == 1 ) {
                    weaken $object[$taxa_id] unless isweak $object[$taxa_id];
                }
                delete $one_to_many{$taxa_id}->{$id};
            }            
            
            # remove from object cache
            if ( exists $object[$id] ) {
                delete $object[$id];
            }            
            
            # remove from one-to-one mapping
            if ( exists $one_to_one{$id} ) {
                delete $one_to_one{$id};
            }
            
            # remove from one-to-many mapping if I am taxa
            if ( exists $one_to_many{$id} ) {
                delete $one_to_many{$id};    
            }
            
        }
        return $self;
    }

=item set_link()

Creates link between objects.

 Type    : Method
 Title   : set_link
 Usage   : $mediator->set_link( -one => $obj1, -many => $obj2 );
 Function: Creates link between objects
 Returns : $self
 Args    : -one  => $obj1 (source of a one-to-many relationship)
           -many => $obj2 (target of a one-to-many relationship)
 Comments: This method is called from within, for example, set_taxa
           method calls. A call like $taxa->set_matrix( $matrix ),
           and likewise a call like $matrix->set_taxa( $taxa ), are 
           both internally rerouted to:

           $mediator->set_link( 
                -one  => $taxa, 
                -many => $matrix 
           );

=cut

    sub set_link {
        my $self = shift;
        my %opt  = @_;
        my ( $one, $many ) = ( $opt{'-one'}, $opt{'-many'} );
        my ( $one_id, $many_id ) = ( $one->get_id, $many->get_id );
        $one_to_one{$many_id} = $one_id;
        $one_to_many{$one_id} = {} unless $one_to_many{$one_id};

        # once other objects start referring to the taxon we want
        # these references to keep the taxon "alive" until all other
        # objects pointing to it have gone out of scope, in which
        # case the reference must be weakened again, so that it
        # might get cleaned up also
        if (isweak($object[$one_id]) ) {
            my $strong = $object[$one_id];
            $object[$one_id] = $strong;
        }
        
        $one_to_many{$one_id}->{$many_id} = $many->_type;
        return $self;
    }

=item get_link()

Retrieves link between objects.

 Type    : Method
 Title   : get_link
 Usage   : $mediator->get_link( 
               -source => $obj, 
               -type   => _CONSTANT_,
           );
 Function: Retrieves link between objects
 Returns : Linked object
 Args    : -source => $obj (required, the source of the link)
           -type   => a constant from Bio::Phylo::Util::CONSTANT

           (-type is optional, used to filter returned results in 
           one-to-many query).

 Comments: This method is called from within, for example, get_taxa
           method calls. A call like $matrix->get_taxa()
           and likewise a call like $forest->get_taxa(), are 
           both internally rerouted to:

           $mediator->get_link( 
               -source => $self # e.g. $matrix or $forest           
           );

           A call like $taxa->get_matrices() is rerouted to:

           $mediator->get_link( -source => $taxa, -type => _MATRIX_ );

=cut

    sub get_link {
        my $self = shift;
        my %opt  = @_;
        my $id   = $opt{'-source'}->get_id;

        # have to get many objects,
        # i.e. source was a taxon/taxa
        if ( defined $opt{'-type'} ) {            
            my $type = $opt{'-type'};
            my @ids = grep { $one_to_many{$id}->{$_} == $type } keys %{ $one_to_many{$id} };
            my @result = @object[@ids];
            return \@result;
        }
        
        # have to get one object, i.e. source