NAME

Devel::Monitor - Monitor your variables/objects for memory leaks

SYNOPSIS

   use Devel::Monitor;

   #-----------------------------------------------------------------------------
   # Monitor scalars, arrays, hashes, references, constants                      
   #-----------------------------------------------------------------------------
   my ($a,$b) = (Foo::Bar->new(), Foo::Bar->new());
   my ($c, @d, %e);
   use constant F => [1,2];
   monitor('name for a' => \$a,
           'name for b' => \$b,
           'name for c' => \$c,
           'name for d' => \@d,
           'name for e' => \%e,
           'name for F' => \&F); #NOTE : Dont add parentheses to the end of the constant (\&F())

   #-----------------------------------------------------------------------------
   # Unmonitor, not yet tested, but useless anyway
   #-----------------------------------------------------------------------------
   # unmonitor($a, $b, \$c, \@d, \%e);

   #-----------------------------------------------------------------------------
   # Print circular references                                                   
   #-----------------------------------------------------------------------------
   # NOTE : You cannot use printCircularRef on a monitored/tied variable 
   #        (See "We cannot use tied objects references because it reuse memory space" doc)
   printCircularRef(\$a);
   printCircularRef(\$b);
   printCircularRef(\$c);
   printCircularRef(\@d);
   printCircularRef(\%e);
   printCircularRef(\&F); #NOTE : Dont add parentheses to the end of the constant (\&F())

METHOD EXAMPLES : monitor

Example with circular references

+----------------------+
| Code                 |
+----------------------+
{
    my @a;
    monitor('a' => \@a);
    $a[0] = \@a; #Add a circular reference
    print STDERR "Leaving scope\n";
}
print STDERR "Scope left\n";
 
+----------------------+
| Output               |
+----------------------+
MONITOR ARRAY a
Leaving scope
Scope left                       
DESTROY ARRAY a
 
+----------------------+
| Meaning              |
+----------------------+
The line "DESTROY ARRAY a" should be between scope prints.
@a were deleted on program exit.

Example without circular references

   +----------------------+
   | Code                 |
   +----------------------+
   {
       my @a;
       monitor('a' => \@a);
       print STDERR "Leaving scope\n";
   }
   print STDERR "Scope left\n";
    
   +----------------------+
   | Output               |
   +----------------------+
   MONITOR ARRAY a
   Leaving scope
   DESTROY ARRAY a
   Scope left
    
   +----------------------+
   | Meaning              |
   +----------------------+
   Everything is ok

METHOD EXAMPLES : printCircularRef

Example

   +----------------------+
   | Code                 |
   +----------------------+
   my (@a, @b);
   $a[0] = 'asdf';
   $a[1] = \@b;
   $b[3] = \@b;
   printCircularRef(\@a);
   printCircularRef(\@b);

   +----------------------+
   | Output               |
   +----------------------+
   -------------------------------------------------------------------------------
   Checking circular references for ARRAY(0x814e358)
   -------------------------------------------------------------------------------
   Internal circular reference found : ARRAY(0x814e358)[1][3] on ARRAY(0x814e370)
   1 - Item     : ARRAY(0x814e358)
   2 - Source   : [1]
       Item     : ARRAY(0x814e370)
   3 - Source   : [3]
       Item     : ARRAY(0x814e370)
   -------------------------------------------------------------------------------
   -------------------------------------------------------------------------------
   Results for ARRAY(0x814e358)
   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
   -------------------------------------------------------------------------------

DESCRIPTION

See http://www.infocopter.com/perl/monitored-variables.htm (Monitor.pm) for original source code I've made a lot of modifications, debug, tweaks, whatever, using the Tie package. It also handle more features.

VERY IMPORTANT THINGS YOU SHOULD BE AWARE

Loop vars are passed by references

   +----------------------+
   | Code                 |
   +----------------------+
   {
       my @list = (1,2,3);
       print STDERR join(", ",@list)."\n";
       for my $item (@list) {
           monitor("item $item" => \$item);
           $item+=1000;
           print "$item\n";
       }
       print STDERR join(", ",@list)."\n";
       print "Leaving scope\n";
   }
   print "Scope left\n";
    
   +------------------------+
   | What you might want    |
   |(Or something like that)|
   +------------------------+
   1, 2, 3
   MONITOR SCALAR : item 1
   1001
   DESTROY SCALAR : item 1
   MONITOR SCALAR : item 2
   1002
   DESTROY SCALAR : item 2
   MONITOR SCALAR : item 3
   1003
   DESTROY SCALAR : item 3
   1, 2, 3
   Leaving scope
   Scope left

   +----------------------+
   | Real Output          |
   +----------------------+
   1, 2, 3
   MONITOR SCALAR : item 1
   1001
   MONITOR SCALAR : item 2
   1002
   MONITOR SCALAR : item 3
   1003
   1001, 1002, 1003
   Leaving scope
   DESTROY SCALAR : item 3
   DESTROY SCALAR : item 2
   DESTROY SCALAR : item 1
   Scope left
    
   +----------------------+
   | Meaning              |
   +----------------------+
   Perl passes variables by reference within for/foreach, so the variables you are using
   are the original ones. (You can print the scalar adresses to be sure)
   The difference is that normaly, Perl passes variables by value.
   So, if you monitor those variables, they won't be destroyed until the initial declaration is.

You cannot use references from a tied object because it reuse memory space

+----------------------+
| Code                 |
+----------------------+
my $self = {'a' => 1,
            'b' => 2};
monitor('self' => \$self);
print STDERR \($self->{'a'})."\n";
print STDERR \($self->{'b'})."\n";
print STDERR \($self->{'a'}).\($self->{'b'})."\n";
foreach my $key (keys %$self) {
    my $keyRef = \$key;
    my $value = $self->{$key};
    my $valueRef = \($self->{$key});
    print STDERR "KEY:$key, KEY REF:$keyRef, VALUE:$value, VALUE REF:$valueRef\n";
}   

+----------------------+
| Output               |
+----------------------+
MONITOR HASH : self
SCALAR(0x8141384)
SCALAR(0x8141384)
SCALAR(0x8141384)SCALAR(0x81413cc)
KEY:a, KEY REF:SCALAR(0x8141420), VALUE:1, VALUE REF:SCALAR(0x824becc)
KEY:b, KEY REF:SCALAR(0x81413cc), VALUE:2, VALUE REF:SCALAR(0x824becc)
DESTROY HASH : self

+----------------------+
| Code 2               |
+----------------------+
my %self;
#monitor('self' => \$self);
tie %self, 'Devel::Monitor::TestHash';
$self{a} = 1;
$self{b} = 2;
print STDERR \($self{a})."\n";
print STDERR \($self{b})."\n";
print STDERR \($self{a}).\($self{b})."\n";
foreach my $key (keys %self) {
    my $keyRef = \$key;
    my $value = $self{$key};
    my $valueRef = \($self{$key});
    print STDERR "KEY:$key, KEY REF:$keyRef, VALUE:$value, VALUE REF:$valueRef\n";
}  

+----------------------+
| Output 2             |
+----------------------+
SCALAR(0x8141378)
SCALAR(0x8141378)
SCALAR(0x8141378)SCALAR(0x8248fe8)
KEY:a, KEY REF:SCALAR(0x81413cc), VALUE:1, VALUE REF:SCALAR(0x825567c)
KEY:b, KEY REF:SCALAR(0x825564c), VALUE:2, VALUE REF:SCALAR(0x825567c)
Devel::Monitor::TestHash::DESTROY : Devel::Monitor::TestHash=HASH(0x81412e8)

+----------------------+
| Meaning              |
+----------------------+
Hash keys refering 1 and 2 can't be the same reference. But we see the
opposite on these small examples. It seems like tied objects reuse memory space
instead of refering to the original value from the untied object.

You cannot weaken a tied object

Proof 01 : Devel::Peek

+----------------------+
| Code                 |
+----------------------+
#!/usr/bin/perl

use Scalar::Util qw(weaken isweak);
my (@a, @b);
tie @a, 'Monitor::TestArray';
tie @b, 'Monitor::TestArray';
$a[0] = \@b;
$b[0] = \@a;
weaken($b[0]);
if (isweak($a[0])) {
   print "\$a[0] is weak\n";
} else {
   print "\$a[0] is not weak\n";
}  
if (isweak($b[0])) {
   print "\$b[0] is weak\n";
} else {
   print "\$b[0] is not weak\n";
}    
package Monitor::TestArray;
use Tie::Array;
use base 'Tie::StdArray';

sub DESTROY { "Monitor::TestArray::DESTROY : $_[0]\n"; }

1; 

+----------------------+
| Wanted output        |
+----------------------+
$a[0] is not weak
$b[0] is weak

+----------------------+
| Real output          |
+----------------------+
$a[0] is not weak
$b[0] is not weak

+----------------------+
| Meaning              |
+----------------------+
We still have this output if we remove one of the "tie" call. But, if we remove those
two "tie", it works and we get the wanted output. So there is a problem.

+----------------------+
| Note                 |
+----------------------+
I'm pretty sure this is a perl bug (Tested with 5.8.6 and 5.8.3).
The code for Scalar::Util::weaken and Scalar::Util::isweak is written in XS

void
weaken(sv)
   SV *sv
PROTOTYPE: $
CODE:
#ifdef SvWEAKREF
   sv_rvweaken(sv);
#else
   croak("weak references are not implemented in this release of perl");
#endif
       
void
isweak(sv)
   SV *sv
PROTOTYPE: $
CODE:
#ifdef SvWEAKREF
   ST(0) = boolSV(SvROK(sv) && SvWEAKREF(sv));
   XSRETURN(1);
#else
   croak("weak references are not implemented in this release of perl");
#endif 

I don't see any problems in this code. Normally when you weaken a variable, it
set the SvWEAKREF flag. You can visualize this behavior with this code :

+----------------------+
| Visualize weak var   |
| with Devel::Peek     |
+----------------------+
use Devel::Peek;
Dump($yourVariable);

However, when using tied variables, nothing is modified. So i believe that
the code behind sv_rvweaken (XS) called by weaken (Perl) does not handle variables 
with SvTYPE at SVt_PVLV. I believe this is a perl bug (C++ code behind sv_rvweaken).

Let's look at the differences we get when a reference is weakened.
If we have this code :

+----------------------+
| Code                 |
+----------------------+
#!/usr/bin/perl
use strict;
use warnings;
use Devel::Peek;
use Scalar::Util qw(weaken isweak);

my (@a, @b);
$a[0] = \@b;
print STDERR "Dump before weaken\n";
Dump(\$a[0]);
weaken($a[0]);
print STDERR "Dump after weaken\n";
Dump(\$a[0]);

+----------------------+
| Output               |
+----------------------+
Dump before weaken
SV = RV(0x818274c) at 0x81411c8
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x814127c
  SV = RV(0x8182760) at 0x814127c
    REFCNT = 2
    FLAGS = (ROK)
    RV = 0x814e894
    SV = PVAV(0x81426f8) at 0x814e894
      REFCNT = 2
      FLAGS = (PADBUSY,PADMY)
      IV = 0
      NV = 0
      ARRAY = 0x0
      FILL = -1
      MAX = -1
      ARYLEN = 0x0
      FLAGS = (REAL)
Dump after weaken
SV = RV(0x818274c) at 0x81412e8
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x814127c
  SV = RV(0x8182760) at 0x814127c
    REFCNT = 2
    FLAGS = (ROK,WEAKREF,IsUV)
    RV = 0x814e894
    SV = PVAV(0x81426f8) at 0x814e894
      REFCNT = 1
      FLAGS = (PADBUSY,PADMY,RMG)
      IV = 0
      NV = 0
      MAGIC = 0x8208e80
        MG_VIRTUAL = &PL_vtbl_backref
        MG_TYPE = PERL_MAGIC_backref(<)
        MG_FLAGS = 0x02
          REFCOUNTED
        MG_OBJ = 0x81411c8
        SV = PVAV(0x8142724) at 0x81411c8
          REFCNT = 2
          FLAGS = ()
          IV = 0
          NV = 0
          ARRAY = 0x825ec28
          FILL = 0
          MAX = 3
          ARYLEN = 0x0
          FLAGS = (REAL)
          Elt No. 0
          SV = RV(0x8182760) at 0x814127c
            REFCNT = 2
            FLAGS = (ROK,WEAKREF,IsUV)
            RV = 0x814e894
      ARRAY = 0x0
      FILL = -1
      MAX = -1
      ARYLEN = 0x0
      FLAGS = (REAL)

+----------------------+
| Meaning              |
+----------------------+
The important part is the WEAKREF flag which say that the reference is weaken.
Refer to perlapi, perlguts, and any other perl core documentation further informations.

Proof 02 : mod_perl

+----------------------+
| Code                 |
+----------------------+
+------------+
| test.pl    |
+------------+
#!/usr/bin/perl
use strict;
use warnings;
use Scalar::Util qw(weaken);
use Devel::Monitor;
use Util::Junk;

my (@a, $b);
#tie @a, 'Devel::Monitor::TestArray';
$a[0] = \$b;
$b = \@a;
$a[1] = Util::Junk::_20M();
weaken($a[0]);

+------------+
| Util::Junk |
+------------+
package Util::Junk;
use strict;
use warnings;

sub _20M() { 'A 20 megs string here filled with zeros' }

1;

+----------------------+
| wget-test.pl         |
+----------------------+
#!/usr/bin/perl

use strict;
use warnings;

my $baseUrl = 'http://localhost/perl/test.pl';

my $i = 0;
while (1) {
    print "Loop ".++$i."\n";
    
    system('wget "'.$baseUrl.'" -O /dev/null') == 0
        or die "\nwget failed or has been interrupted : $?\n";
}

+----------------------+
| Test 01              |
+----------------------+
Now that we got a program and a caller (and mod_perl on our apache server), we can start the program.

perl wget-test.pl

When @a is not tied (See the commented tie in test.pl), after loading the page like ten times, the
page will be in cache in every apache processes and other loading will be VERY fast. You'll also
notice that memory is stable.

However, if you uncomment the tie call in test.pl, you'll see your memory being filled to death and
every page loaded will be as long as at the beginning

Conclusion

It is actually impossible to weaken a tied variable

Variable using constants are destroyed when the constant is destroyed

+----------------------+
| Code                 |
+----------------------+
#!/usr/bin/perl
use strict;
use warnings;
use Devel::Monitor;

use constant CONST => [1,2,3]; 
#monitor('CONST', \&CONST);
print &CONST."\n";
{
    my $item = CONST();
    monitor('item', \$item);
    print $item."\n";
    print "Leaving scope\n";
}
print "Scope left\n";

+------------------------+
| What you might want    |
|(Or something like that)|
+------------------------+
ARRAY(0x81c503c)
MONITOR ARRAY : item
ARRAY(0x1234567)
Leaving scope
DESTROY ARRAY : item
Scope left

+----------------------+
| Real Output          |
+----------------------+
ARRAY(0x81c503c)
MONITOR ARRAY : item
ARRAY(0x81c503c)
Leaving scope
Scope left
DESTROY ARRAY : item

+----------------------+
| Meaning              |
+----------------------+
It looks like your variable is not destroyed ! But in fact, $item is the same
reference that CONST is. So, you are monitoring CONST directly ! If you
absolutely want to monitor this code, you must uncomment the 
"#monitor('CONST', \&CONST);" line in code.

+----------------------+
| Output with monitor  |
| on \&CONST           |
+----------------------+
MONITOR CODE SCALAR : CONST [0]
MONITOR CODE SCALAR : CONST [1]
MONITOR CODE SCALAR : CONST [2]
MONITOR CODE ARRAY : CONST
ARRAY(0x81c4e30)
Array from item is already tied by CONST
ARRAY(0x81c4e30)
Leaving scope
Scope left
DESTROY CODE SCALAR : CONST [0]
DESTROY CODE SCALAR : CONST [1]
DESTROY CODE SCALAR : CONST [2]
DESTROY CODE ARRAY : CONST

+----------------------+
| Meaning              |
+----------------------+
You monitored a constant and you cannot monitor twice a variable, so $item won't
be monitored. This way, you can see that there is no memory leak.

TRACKING MEMORY LEAKS

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;
 
{
    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};
}
#------------------------------------------------------------------------------+
# Be careful ! With this code, it won't work
#------------------------------------------------------------------------------+
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});
    } #$b is destroyed here, and the other reference $self->{_classB} is a weak reference,
      #so the ClassB instance is destroyed, $self->{_classB} now equal undef
    return $self->{_classB};
}
#------------------------------------------------------------------------------+
# Good way
#------------------------------------------------------------------------------+
sub getClassB {
    my $self = shift;
    my $b;
    {
        $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});
    } #$b is still not destroyed, so we didn't lose our not weak reference
    return $self->{_classB}; #We return the object, someone on the other side will now keep
                             #the reference, so we don't care if $b lose the reference.
                             #Our job is done !
}
#------------------------------------------------------------------------------+
#
# Conclusion : You must be sure that you keep a non weak reference to the object
#
#------------------------------------------------------------------------------+
 
#------------------------------------------------------------------------------+
#
# The output (Using the good way) will be
#
#------------------------------------------------------------------------------+
 
$self->{_classB} is now weaken
MONITOR HASH : $b
Something
Leaving scope
DESTROY HASH : $b
Scope left
 
#------------------------------------------------------------------------------+
#
# There is no circular references now...
#
#------------------------------------------------------------------------------+
 
#------------------------------------------------------------------------------+
#
# IMPORTANT : Always weaken the caller's reference because someone may use the
# child objects (ClassB) this way. Let's see what can happen if you don't.
#
# If we get the following code
#
#------------------------------------------------------------------------------+
my $b;
{
    my $a = ClassA->new();
    monitor('$a' => \$a);
    $b = ClassB->new($a);
    $b->getClassA()->printSomething();
    print "Leaving scope\n";
}
print "Scope left\n";
$b->getClassA()->printSomething();
 
#------------------------------------------------------------------------------+
#
# And the sub setClassA
#
#------------------------------------------------------------------------------+
sub setClassA {
    my ($self, $classA) = @_;
    $self->{_classA} = $classA;
    weaken($self->{_classA});
    print "\$self->{_classA} is now weaken\n" if isweak($self->{_classA});
}
 
#------------------------------------------------------------------------------+
#
# You'll get this error
#
#------------------------------------------------------------------------------+
MONITOR HASH : $a
$self->{_classA} is now weaken
Something
Leaving scope
DESTROY HASH : $a
Scope left
Can't call method "printSomething" on an undefined value at test3.pl line 29.
 
#------------------------------------------------------------------------------+
#
# $a is destroyed when leaving the scope, and the other reference to this variable
# is weaken, so this one is destroyed too. This clearly demonstrate that you must
# weaken the caller's reference.
#
#------------------------------------------------------------------------------+

CHECKING MODULES SYNTAX

Redirect stderr to stdout and grep it

perl -c MyModule.pm 2>&1 | grep -iv '^(DESTROY|MONITOR|Scalar constant)'

WHAT THIS MODULE CAN'T DO FOR YOU

Even if your modules are memory leak free, it doesn't mean that external modules that you are using don't have it. So, before running your application on mod_perl, you should be sure that EVERY modules are ok. (In particular those perl extensions calling C++ code)

MODULES THAT PRODUCE MEMORY LEAKS

You must destroy them when you don't need anymore those object instances

+----------------------+
| Bio::Graphics::Panel |
+----------------------+
my $panel = Bio::Graphics::Panel->new(%options);
...
$panel->finished();
  
+----------------------+
| XML::DOM             |
+----------------------+
my $parser  = new XML::DOM::Parser;
my $doc = $parser->parsefile ("file.xml");
...
$doc->dispose();

NOTE : I suggest that you use XML::LibXML instead

CAVEATS

TODO

BUGS