Commit b8d0c2db authored by Graham McVicker's avatar Graham McVicker
Browse files

removed Bio::EnsEMBL::Container module

parent c8c4d317
=head1 NAME - Bio::EnsEMBL::DBSQL::DBAdaptorHolder
=head1 SYNOPSIS
$container = new Bio::EnsEMBL::Container($obj);
=head1 DESCRIPTION
This object is a hack necessary to work around perls circular reference
memory leak problems. Its sole purpose is to channel calls to the
object which is held onto by the container and to invoke the objects deleteObj
method to breaks all circular memory references at the correct time.
=head1 CONTACT
Post questions to the EnsEMBL developer mailing list: <ensembl-dev@ebi.ac.uk>
=head1 METHODS
=cut
use strict;
package Bio::EnsEMBL::Container;
use Bio::EnsEMBL::Utils::Exception qw(throw warning);
use vars ('$AUTOLOAD');
=head2 new
Arg [1] : Bio::EnsEMBL::DBAdaptor $dba
The dbadaptor to wrap this holder around.
Example : $dba_holder = new Bio::EnsEMBL::DBSQL::DBAdaptorHolder($dba);
Description: Creates a new DBAdaptor holder object that forwards calls to
$dba and breaks circular references to $dba upon destruction.
Returntype : Bio::EnsEMBL::Container
Exceptions : none
Caller : Bio::EnsEMBL::DBAdaptor
=cut
sub new {
my ($class, $object) = @_;
unless($object) {
throw("object argument is required");
}
return bless {'_obj' => $object}, $class;
}
=head2 _obj
Arg [1] : Generic Object $obj (optional)
Example : $object = $self->_obj;
Description: PRIVATE Getter/Setter for the object held by this container.
Returntype : Generic Object
Exceptions : none
Caller : internal
=cut
sub _obj {
my ($self, $obj) = @_;
if($obj) {
$self->{_obj} = $obj;
}
return $self->{_obj};
}
=head2 isa
Arg [1] : string $module
Example : none
Description: Overrides the base perl object isa so that this object is
also considered to be the contained object. Very sneaky
and a bit of a hack, but necessary to make this container
completely transparent.
Returntype : boolean
Exceptions : none
Caller : general
=cut
sub isa {
my ($self, $module) = @_;
if($module eq ref $self) {
return 1;
}
if($self->_obj()->isa($module)) {
return 1;
}
return $self->SUPER::isa($module);
}
=head2 can
Arg [1] : string $method
Example : none
Description: Like the isa method above, calls can on the contained
_obj. Without this can fails because it gets trapped
by the AUTOLOAD method.
Returntype : boolean
Exceptions : none
Caller : general
=cut
sub can {
my( $self, $method ) = @_;
return $self->_obj->can($method);
}
=head2 AUTOLOAD
Arg [1] : @args list of arguments
Example : none
Description: Automatically called to forward calls to the object in this
container
Returntype : arbitrary
Exceptions : none
Caller : perl
=cut
sub AUTOLOAD {
my ($self, @args) = @_;
my $method = $AUTOLOAD;
$method =~ s/.*:://;
# call the method on the contained object
if ($self->_obj->can($method)) {
# update the symbol table so AUTOLOAD is not called
# the next time this method is called (faster this way)
no strict 'refs';
*{$AUTOLOAD} =
sub {
my ($self, @args) = @_;
return $self->_obj->$method(@args);
};
return $self->_obj->$method(@args);
} else {
# Method does not exist
throw("method '$method' does not exist in '". ref($self->_obj) ."'");
}
}
=head2 DESTROY
Arg [1] : none
Example : none
Description: Automatically called when there are no more references to
this container. This container calls deleteObj on the
contained object to break the circular
references contained within the object which would otherwise
prevent the garbage collection of the object and objects
referenced by the object.
Returntype : none
Exceptions : none
Caller : perl
=cut
sub DESTROY {
my $self = shift;
#print STDERR "Container::DESTROY : Breaking circular references:\n";
my $obj = $self->_obj;
if(!$obj) {
warning("Bio::EnsEMBL::Container: potential memory leak, contained"
. " object is not defined during garbage collection.");
} elsif($obj->can('deleteObj')) {
$obj->deleteObj();
}
$self->{_obj} = undef;
}
1;
......@@ -202,50 +202,6 @@ sub db{
}
sub DESTROY{
my ($self)= @_;
$self->{'_db'} = undef;
}
=head2 deleteObj
Arg [1] : none
Example : none
Description: Cleans up circular reference loops so proper garbage collection
can occur.
Returntype : none
Exceptions : none
Caller : DBAdaptorContainer::DESTROY
=cut
sub deleteObj {
my $self = shift;
#print "called deleteObj on DBAdaptor\n";
#clean up external feature adaptor references
if(exists $self->{'_xf_adaptors'}) {
foreach my $key (keys %{$self->{'_xf_adaptors'}}) {
delete $self->{'_xf_adaptors'}->{$key};
}
}
if(exists $self->{'generic_feature_adaptors'}) {
foreach my $name (keys %{$self->{'generic_feature_adaptors'}}) {
my $adaptor = $self->{'generic_feature_adaptors'}->{$name};
if(ref($adaptor) && $adaptor->can('deleteObj')) {
$adaptor->deleteObj();
}
delete $self->{'generic_feature_adaptors'}->{$name};
}
delete $self->{'generic_feature_adaptors'};
}
}
=head2 add_db_adaptor
......@@ -886,6 +842,10 @@ sub AUTOLOAD {
die("No such method: $AUTOLOAD\n");
}
sub DESTROY {} # required due to AUTOLOAD
#########################
# sub DEPRECATED METHODS
#########################
......
......@@ -42,7 +42,6 @@ package Bio::EnsEMBL::DBSQL::DBConnection;
use vars qw(@ISA);
use strict;
#use Bio::EnsEMBL::Container; ## Container no longer needed here
use Bio::EnsEMBL::Registry;
my $reg = "Bio::EnsEMBL::Registry";
use Bio::EnsEMBL::Root;
......@@ -542,7 +541,7 @@ sub prepare {
$self->connect();
}
#info("SQL(".$self->dbname."):$string");
# print STDERR "SQL(".$self->dbname."):$string\n";
my $sth = $self->db_handle->prepare($string);
......
......@@ -32,7 +32,7 @@ use Bio::EnsEMBL::Utils::Exception qw(warning stack_trace_dump);
use DBD::mysql;
use DBI;
#use Time::HiRes qw(time);
# use Time::HiRes qw(time);
@ISA = qw(DBI::st);
......
......@@ -148,13 +148,8 @@ sub ensembl_db {
my ($self, $value) = @_;
if($value) {
#avoid potentially nasty memory leaks
if(ref $value && $value->isa("Bio::EnsEMBL::Container")) {
$self->{'ensembl_db'} = $value->_obj;
} else {
$self->{'ensembl_db'} = $value;
}
}
$self->{'ensembl_db'} = $value;
}
return $self->{'ensembl_db'};
}
......
use strict;
use warnings;
BEGIN { $| = 1;
use Test;
plan tests => 9;
}
use Bio::EnsEMBL::Container;
#
#1 TEST - Container Compiles
#
ok(1);
#
#2-5 TEST new and isa
#
my $test_obj = new TestObj;
ok(!$test_obj->deleteObj_called);
my $container = new Bio::EnsEMBL::Container($test_obj);
ok($container->isa('TestObj'));
ok(!$container->isa('Cruft'));
ok($container->isa('Bio::EnsEMBL::Container'));
#
# 6 TEST _obj method
#
ok($container->_obj == $test_obj);
#
# 7-8 TEST AUTOLOAD (and symbol table caching mechanism)
#
ok($container->test_method(5) == 5);
ok($container->test_method(6) == 6);
#
# 9 test destroy
#
$container = undef;
#sleep(1);
ok($test_obj->deleteObj_called);
package TestObj;
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->{'deleteObjCalled'} = 0;
return $self;
}
sub test_method {
my ($self, $val) = @_;
return $val;
}
sub deleteObj_called {
my $self = shift;
return $self->{'deleteObjCalled'};
}
sub deleteObj {
my $self = shift;
$self->{'deleteObjCalled'} = 1;
}
1;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment