Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re: taking memory snapshots with perl

by PrakashK (Pilgrim)
on Mar 21, 2002 at 19:04 UTC ( #153387=note: print w/ replies, xml ) Need Help??


in reply to taking memory snapshots with perl

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


Comment on Re: taking memory snapshots with perl
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://153387]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (10)
As of 2015-07-28 21:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (259 votes), past polls