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};
    }
    #------------------------------------------------------------------------------+