I haven't tested this under mod_perl, but I have used the following in FastCGI environment. It uses the Devel::Leak module.
It does not give you the exact size of the memory allocated, rather gives you a number indicating a count of "things", where things mean scalar values, array and hash values etc. Check the man page for Devel::Leak for more info.
package MemLeak;
use strict;
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK = qw(mlprint mlprintc);
=head1 NAME
MemLeak - Helper functions to track memory leaks
=head1 SYNOPSIS
use MemLeak qw(mlprint mlprintc);
mlprint('BEGIN');
my $a = 5;
mlprint('after $a');
my @a = (1..10);
mlprintc('BEGIN', 'after @a');
my %a;
@a{@a} = @a;
mlprintc('BEGIN', 'after %a');
=cut
use Devel::Leak;
sub _time_now
{
my ($sec, $min, $hour, $day, $mon, $year) = localtime(time);
return sprintf "%02d:%02d:%02d %02d/%02d/%02d",
$hour, $min, $sec, $mon + 1, $day, $year - 100;
}
my $last_count = 0;
my %CHECK_POINTS = (
_LAST => 0,
);
sub _get_counts
{
my ($chkpt) = @_;
my $handle;
my $count = Devel::Leak::NoteSV($handle);
my $delta = $count - $CHECK_POINTS{_LAST};
$CHECK_POINTS{_LAST} = $count;
my $delta_cp;
if ($chkpt) {
if (exists $CHECK_POINTS{$chkpt}) {
$delta_cp = $count - $CHECK_POINTS{$chkpt};
delete $CHECK_POINTS{$chkpt};
} else {
$CHECK_POINTS{$chkpt} = $count;
}
}
return ($count, $delta, $delta_cp);
}
=head1 DESCRIPTION
=head2 mlprint(@args)
print current SV count and change since last count
=cut
sub mlprint
{
my (@args) = @_;
my ($count, $delta) = _get_counts;
my $msg = join "", @args;
chomp $msg if $msg;
warn sprintf "[%d - %s] SV# = %d (%+d); %s\n",
$$, _time_now, $count, $delta, $msg;
}
=pod
=head2 mlprintc($chkpt, @args)
print current SV count and changes since last count
and since the checkpoint specified
=cut
sub mlprintc
{
my ($check_pt, @args) = @_;
my ($count, $delta, $delta_cp) = _get_counts($check_pt);
my $msg = join "", @args;
chomp $msg if $msg;
if (defined $delta_cp) {
warn sprintf "[%d - %s] SV# = %d (%+d/%s: %+d); %s\n",
$$, _time_now, $count, $delta, $check_pt, $delta_cp, $msg;
} else {
warn sprintf "[%d - %s] SV# = %d (%+d); %s: %s\n",
$$, _time_now, $count, $delta, $check_pt, $msg;
}
}
1;
Here's the output of the test snippet shown under SYNOPSIS above (on my debian GNU/Linux system):
[32134 - 13:56:14 03/21/02] SV# = 4418 (+4418); BEGIN
[32134 - 13:56:14 03/21/02] SV# = 4418 (+0); after $a
[32134 - 13:56:14 03/21/02] SV# = 4428 (+10); BEGIN: after @a
[32134 - 13:56:14 03/21/02] SV# = 4439 (+11/BEGIN: +11); after %a
Add calls to mlprint and mlprintc at strategic places in your code to find out where memory is being allocated most.
HTH, /prakash |