BioPerl-DB
view release on metacpan or search on metacpan
lib/Bio/DB/BioSQL/SeqAdaptor.pm view on Meta::CPAN
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) {
# we need to create at least Bio::SeqI implementing objects here;
# as a default catch-all we upgrade that to Bio::Seq::RichSeqI
$fact = Bio::Seq::SeqFactory->new(-type => "Bio::Seq::RichSeq");
}
$obj = $fact->create_object();
$self->populate_from_row($obj, $row);
}
return $obj;
}
=head2 populate_from_row
Title : populate_from_row
Usage :
Function: Populates an object with values from columns of the row.
Example :
Returns : The object populated, or undef, if the row contains no values
Args : The object to be populated.
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().
=cut
sub populate_from_row{
my ($self,$obj,$rows) = @_;
$obj = $self->SUPER::populate_from_row($obj,$rows);
if($obj && $rows && @$rows && $obj->isa("Bio::Seq::RichSeqI")) {
$obj->division($rows->[6]) if $rows->[6];
}
return $obj;
}
=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
feature 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;
# features
foreach my $feat ($obj->top_SeqFeatures()) {
if($feat->isa("Bio::DB::PersistentObjectI")) {
$feat->primary_key(undef);
# cascade to feature's children
$self->_feat_adaptor->remove_children($feat);
}
}
# annotation collection
my $ac = $obj->annotation();
if($ac->isa("Bio::DB::PersistentObjectI")) {
$ac->primary_key(undef);
$ac->adaptor()->remove_children($ac);
}
# done
return 1;
}
=head1 Internal methods
These are mostly private or 'protected.' Methods which are in the
latter class have this explicitly stated in their
documentation. 'Protected' means you may call these from derived
classes, but not from outside.
Most of these methods cache certain adaptors or otherwise reduce call
path and object creation overhead. There's no magic here.
=cut
=head2 _feat_adaptor
Title : _feat_adaptor
Usage : $obj->_feat_adaptor($newval)
Function: Get/set cached persistence adaptor for a Bio::SeqFeatureI object
In OO speak, consider the access class of this method protected.
I.e., call from descendants, but not from outside.
Example :
Returns : value of _feat_adaptor (a Bio::DB::PersistenceAdaptorI
instance)
Args : new value (a Bio::DB::PersistenceAdaptorI instance, optional)
=cut
sub _feat_adaptor{
my ($self,$adp) = @_;
if( defined $adp) {
$self->{'_feat_adaptor'} = $adp;
}
if(! exists($self->{'_feat_adaptor'})) {
$self->{'_feat_adaptor'} =
$self->db()->get_object_adaptor("Bio::SeqFeatureI");
}
return $self->{'_feat_adaptor'};
}
1;
( run in 0.605 second using v1.01-cache-2.11-cpan-39bf76dae61 )