BioPerl-DB

 view release on metacpan or  search on metacpan

lib/Bio/DB/BioSQL/ClusterAdaptor.pm  view on Meta::CPAN

    my $ok = 1;

    # cluster size becomes a qualifier/value association, which essentially
    # is a SimpleValue annotation
    my $sizeann = $self->_object_slot('cluster size',$obj->size());
    $sizeann = $sizeann->create();
    # since we don't (can't very well due to the difficult definition of
    # alternative keys) update associations, first remove the old size
    # slot (value() won't be considered here)
    $ok = $sizeann->adaptor->remove_association(-objs => [$sizeann, $obj],
						-values => {"rank" => 1});
    # add the new size
    $ok = $sizeann->adaptor->add_association(-objs => [$sizeann, $obj],
					     -values => {"rank" => 1});

    # we need to store the annotations, and associate ourselves with them
    if($obj->can('annotation')) {
	my $ac = $obj->annotation();
	# the annotation object might just have been created on the fly, and
	# hence may not be a PersistentObjectI (if that's the case we'll
	# assume it's empty, and there's no point storing anything)
	if($ac->isa("Bio::DB::PersistentObjectI")) {
	    $ok = $ac->store(-fkobjs => [$obj]) && $ok;
	    $ok = $ac->adaptor()->add_association(-objs => [$ac, $obj]) && $ok;
	}
    }

    # finally, store the members
    #
    # obtain the type term for the association upfront
    my $assoctype = $self->_ontology_term('cluster member',
					  'Relationship Type Ontology',
					  'FIND IT');
    $assoctype->create() unless $assoctype->primary_key();
    foreach my $mem ($obj->get_members()) {
	# each member needs to be persistent object
	if(! $mem->isa("Bio::DB::PersistentObjectI")) {
	    $mem = $self->db->create_persistent($mem);
	}
	# each member needs to have a primary key
	if(! $mem->primary_key()) {
	    if(my $found = $mem->adaptor->find_by_unique_key($mem, 
                                                             -flat_only =>1)) {
		$mem->primary_key($found->primary_key());
	    } else {
		$ok = $mem->create() && $ok;
	    }
	}
	# associate the cluster with the member
	$mem->adaptor->add_association(-objs =>    [$obj, $mem, $assoctype],
				       -contexts =>["subject","object",undef]);
    }
    # done
    return $ok;
}

=head2 remove_children

 Title   : remove_children
 Usage   :
 Function: This method is to cascade deletes in maintained objects.

           We need to undefine the primary keys of all contained
           annotation objects here.

 Example :
 Returns : TRUE on success and FALSE otherwise
 Args    : The persistent object that was just removed from the database.
           Additional (named) parameter, as passed to remove().


=cut

sub remove_children{
    my $self = shift;
    my $obj = shift;

    # annotation collection
    if($obj->can('annotation')) {
	my $ac = $obj->annotation();
	if($ac->isa("Bio::DB::PersistentObjectI")) {
	    $ac->primary_key(undef);
	    $ac->adaptor()->remove_children($ac);
	}
    }
    # done
    return 1;
}

=head2 remove_members

 Title   : remove_members
 Usage   :
 Function: Dissociates all cluster members from this cluster. 

           Note that this method does not delete the members
           themselves, it only removes the association between them
           and this cluster.

 Example :
 Returns : TRUE on success and FALSE otherwise
 Args    : The persistent object for which to remove the members


=cut

sub remove_members{
    my $self = shift;
    my $obj = shift;

    my $assoctype = $self->_ontology_term('cluster member',
					  'Relationship Type Ontology',
					  'FIND IT');
    my $ok = 1;
    # if the association type isn't known yet, there can't be any
    # members either
    if($assoctype) {
	$ok = $self->remove_association(-objs => [$obj,"Bio::SeqI",$assoctype],
					-contexts=>["subject","object",undef]);
    }
    return $ok;



( run in 0.683 second using v1.01-cache-2.11-cpan-39bf76dae61 )