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 )