Devel-Monitor
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Devel/Monitor.pm view on Meta::CPAN
Circular reference : 0
Internal circular reference : 1
Weak circular reference : 0
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
Checking circular references for ARRAY(0x814e370)
-------------------------------------------------------------------------------
Circular reference found : ARRAY(0x814e370)[3]
1 - Item : ARRAY(0x814e370)
2 - Source : [3]
Item : ARRAY(0x814e370)
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
Results for ARRAY(0x814e370)
Circular reference : 1
Internal circular reference : 0
Weak circular reference : 0
-------------------------------------------------------------------------------
=head1 TRACKING MEMORY LEAKS
=head2 How to remove Circular references in Perl
#------------------------------------------------------------------------------+
#
# Let's say we have this basic code :
#
#------------------------------------------------------------------------------+
#!/usr/bin/perl
#--------------------------------------------------------------------
# Little program
#--------------------------------------------------------------------
use strict;
use warnings;
use Devel::Monitor qw(:all);
{
my $a = ClassA->new();
my $b = $a->getClassB();
monitor('$b' => \$b);
$b->getClassA()->printSomething();
print "Leaving scope\n";
}
print "Scope left\n";
#--------------------------------------------------------------------
# ClassA (Just a class with the "printSomething" method)
#--------------------------------------------------------------------
package ClassA;
use strict;
use warnings;
use Scalar::Util qw(weaken isweak);
sub new {
my ($class) = @_;
my $self = {};
bless($self => $class);
return $self;
}
sub getClassB {
my $self = shift;
$self->{_classB} = ClassB->new($self);
return $self->{_classB};
}
sub printSomething {
print "Something\n";
}
#--------------------------------------------------------------------
# ClassB (A class that got a "parent" which is a ClassA instance)
#--------------------------------------------------------------------
package ClassB;
use strict;
use warnings;
use Scalar::Util qw(weaken isweak);
sub new {
my ($class, $classA) = @_;
my $self = {};
bless($self => $class);
$self->setClassA($classA);
return $self;
}
sub setClassA {
my ($self, $classA) = @_;
$self->{_classA} = $classA;
}
sub getClassA {
return shift->{_classA};
}
1;
#------------------------------------------------------------------------------+
#
# The output will be
#
#------------------------------------------------------------------------------+
MONITOR HASH : $b
Something
Leaving scope
Scope left
DESTROY HASH : $b
#------------------------------------------------------------------------------+
#
# We see that the object reference by $b isn't destroyed when leaving the scope
# because $a->{_classB} still use it. So, we got a circular reference here. We must
# weaken one side of the circular reference to help Perl disallocate memory.
#
#------------------------------------------------------------------------------+
#------------------------------------------------------------------------------+
# Wrong way to break circular references
#------------------------------------------------------------------------------+
sub getClassB {
my $self = shift;
$self->{_classB} = ClassB->new($self); #$self->{_classB} is the only
#reference to the objects
weaken($self->{_classB}); #we weaken the only reference,
#so, $self->{_classB} is DESTROYED HERE,
#which is very bad
print "\$self->{_classB} is now weaken\n" if isweak($self->{_classB});
return $self->{_classB};
}
#------------------------------------------------------------------------------+
# Good way
#------------------------------------------------------------------------------+
sub getClassB {
my $self = shift;
my $b = ClassB->new($self);
$self->{_classB} = $b; #we create a second reference to the object
weaken($self->{_classB}); #we weaken this reference, which is not deleted
#because thre is another reference
print "\$self->{_classB} is now weaken\n" if isweak($self->{_classB});
return $self->{_classB};
}
#------------------------------------------------------------------------------+
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.989 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )