BioPerl-DB

 view release on metacpan or  search on metacpan

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

 Returns : TRUE on success, and FALSE otherwise.
 Args    : The object to which to attach foreign key objects.
           A reference to an array of foreign key values, in the order of
           foreign keys returned by get_foreign_key_objects().


=cut

sub attach_foreign_key_objects{
    my ($self,$obj,$fks) = @_;
    my $ok = 1;
    
    # retrieve feature key and feature source by key
    my $fadp = $self->_term_adaptor();
    my $term;
    if($fks->[1]) {
	$term = $fadp->find_by_primary_key($fks->[1]);
	$obj->primary_tag($term->name()) if $term;
	$ok = $term && $ok;
    }
    if($fks->[2]) {
	$term = $fadp->find_by_primary_key($fks->[2]);
	$obj->source_tag($term->name()) if $term;
	$ok = $term && $ok;
    }
    return $ok ? 1 : 0;
}

=head2 store_children

 Title   : store_children
 Usage   :
 Function: Inserts or updates the child entities of the given object in the 
           datastore.

           Bio::SeqFeatureI has a location, annotation, and possibly
           sub-seqfeatures as children. The latter is not implemented yet.
 Example :
 Returns : TRUE on success, and FALSE otherwise
 Args    : The Bio::DB::PersistentObjectI implementing object for which the
           child objects shall be made persistent.


=cut

sub store_children{
    my ($self,$obj) = @_;
    my $ok = 1;
    
    # store the location(s)
    my $i = 0;
    my $loc = $obj->location();
    my @locs =
	$loc->isa("Bio::Location::SplitLocationI") ?
	$loc->sub_Location() : ($loc);
    foreach $loc (@locs) {
	$loc->rank(++$i) if $loc->can('rank');
	$ok = $loc->store(-fkobjs => [$obj]) && $ok;
    }
    # store the annotation and associate ourselves with it; we use an adaptor
    # to transparently access all annotation through the AnnotationCollectionI
    # interface
    my $ac = $self->_featann_adaptor();
    $ac->feature($obj);
    # we need to get an adaptor to store it (or make it persistent, which is
    # unnecessary overhead since $ac will go out of scope at the end of this
    # method)
    if($ac->get_num_of_annotations() > 0) {
	my $acadp = $self->_anncoll_adaptor();
	$ok = $acadp->create($ac) && $ok;
	$acadp->add_association(-objs => [$ac, $obj]);
    }    
    # done
    return $ok;
}

=head2 attach_children

 Title   : attach_children
 Usage   :
 Function: Possibly retrieve and attach child objects of the given object.

           This is needed when whole object trees are supposed to be
           built when a base object is queried for and returned. An
           example would be Bio::SeqI objects and all the annotation
           objects that hang off of it.

           This is called by the find_by_XXXX() methods once the base
           object has been built.

           For Bio::SeqFeatureIs, we need to get the location,
           tag/value pairs and other annotation, and possibly
           sub-seqfeatures. The latter is not implemented yet.

 Example :
 Returns : TRUE on success, and FALSE otherwise.

 Args    : The object for which to find and to which to attach the child
           objects.


=cut

sub attach_children{
    my ($self,$obj) = @_;
    my $ok = 1;

    # look up the location(s) for this feature by FK
    my $query = Bio::DB::Query::BioQuery->new(
                                   -datacollections => ["Bio::LocationI t1"],
		                   -where => ["t1.Bio::SeqFeatureI = ?"]);
    my $qres = $self->_loc_adaptor()->find_by_query(
				   $query,
				   -name => "FIND LOCATION BY FEATURE",
				   -values => [$obj->primary_key()]);
    my $locs = $qres->each_Object();
    if(@$locs == 1) {
	$obj->location($locs->[0]);
    } elsif(@$locs > 1) {
	$obj->location(Bio::Location::Split->new(-locations => $locs));
    }
    $ok = @$locs > 0;
    #
    # look up annotation for this feature by association
    #
    my $annadp = $self->_anncoll_adaptor();
    # we use an adaptor to transparently add all annotation through the
    # AnnotationCollectionI interface
    my $ac = $self->_featann_adaptor();
    $ac->feature($obj);
    # now have the adaptor find by association
    $qres = $annadp->find_by_association(-objs => [$ac,$obj]);
    # no need to attach the annotation collection to the feature - the
    # annotation adaptor added everything to the feature transparently
    $qres->next_object(); # remove it from the stack, just to be sure
    # 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 location 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;
    my $loc = $obj->location();
    my @locs = 
	$loc->isa("Bio::Location::SplitLocationI") ?
	$loc->sub_Location() : ($loc);
    foreach (@locs) {
	$_->primary_key(undef) if $_->isa("Bio::DB::PersistentObjectI");
    }
    return 1;
}

=head2 instantiate_from_row

 Title   : instantiate_from_row
 Usage   :
 Function: Instantiates the class this object is an adaptor for, and populates
           it with values from columns of the row.

           This implementation calls populate_from_row() to do the real job.
 Example :
 Returns : An object, or undef, if the row contains no values
 Args    : A reference to an array of column values. The first column
           is the primary key, the other columns are expected to be in
           the order returned by get_persistent_slots().  Optionally,
           a Bio::Factory::SequenceFactoryI compliant object to be
           used for creating the object.


=cut

sub instantiate_from_row{
    my ($self,$row,$fact) = @_;
    my $obj;

    if($row && @$row) {
	if($fact) {



( run in 1.114 second using v1.01-cache-2.11-cpan-437f7b0c052 )