Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

linux memory leak monitor

by zentara (Archbishop)
on Mar 15, 2004 at 22:05 UTC ( #336856=snippet: print w/ replies, xml ) Need Help??

Description: After starting to do Tk programming, I realized how easy it is to make a lousy design which leaks memory, especially with photo objects. So I got tired of running top and peeking back and forth, or repeatedly running ps.

After looking at all the alternatives, I settled on directly reading from /proc. It seemed to run the best out of all tried methods, which I monitored with strace. Look in the upper left corner.

UPDATE May-7-2005 added a MeM.pm version

UPDATE July 12 2011 fixed the way pid is obtained for Perl 5.14.1. $$ is gone, replaced with POSIX::getpid()

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use POSIX qw(getpid);  #update for Perl 5.14.1

##########################################################
# you can put it in your development programs like this:
# my $memmonitor = 1;
#  if($memmonitor){
#  my $pid = $$;
#    if(fork() == 0){exec("./memmonitor $pid")}
# }
######################################################


#my $pid = shift || $$;
my $pid = getpid();

my $mw = new MainWindow;
$mw->overrideredirect(1);
my $t = $mw->Label(-text=>'', -bg=>'black', -fg=>'yellow')->pack;

my $id = Tk::After->new($mw,1000,'repeat',\&refresh);

MainLoop;

sub refresh{
      my @size = split "\n", `cat /proc/$pid/status`;
      (my $vmsize) = grep {/VmSize/} @size;
      my (undef,$size) = split "\t",$vmsize;
      $t->configure(-text=>"PID: $pid ->  $size");
      if($size eq ''){Tk::exit}
}
__END__
#################################################

Here is a modular version, save the file below as MeM.pm
package MeM;
use warnings;
use strict;
use POSIX qw(getpid);

#my $pid =$$;
my $pid = getpid();

if (fork() == 0) {
    require Tk;
    my $mw = new MainWindow;
    $mw->overrideredirect(1);
    $mw->geometry('-0-0');
    my $t = $mw->Label(-text => '', -bg => 'black', -fg => 'yellow')->
+pack;
    $0 = 'MeM';
    my $id = Tk::After->new($mw, 1000, 'repeat', [ \&refresh, $pid ]);

    Tk::MainLoop();

    sub refresh {
        my $pid = shift;
        #asmutils version of cat 
       # my @size = split "\n", `/home/zentara/perl5lib/cat /proc/$pid
+/status`;
        my @size = split "\n", `cat /proc/$pid/status`; 

        (my $vmsize) = grep { /VmSize/ } @size;
        my (undef, $size) = split '   ', $vmsize;
        $t->configure(-text => "PID: $pid ->  $size");
        if ($size eq '') { exit }
    }
}

1;





Comment on linux memory leak monitor
Download Code
Re: linux memory leak monitor
by duelafn (Priest) on Mar 17, 2004 at 02:08 UTC
    You might want to change the extraction line so that your code still works for programs over 100MB.
    sub refresh{ my @size = split "\n", `cat /proc/$pid/status`; (my $vmsize) = grep {/VmSize/} @size; my ($size) = $vmsize =~ /VmSize:\s+(.*)$/; # Changed this $t->configure(-text=>"PID: $pid -> $size"); if($size eq ''){Tk::exit} }
Re: linux memory leak monitor
by onkhector (Novice) on Mar 17, 2004 at 03:15 UTC
    You can also monitor programs in (horror!) other languages by doing smething like this:
    my $command = shift; my $pid = fork(); unless (0 == $pid){ ...Tk code... }else{ exec($command); }
    You now pass the program name instead of the PID to the script.
Re: linux memory leak monitor
by zentara (Archbishop) on Mar 17, 2004 at 19:28 UTC
    duelafn said: You might want to change the extraction line so that your code still works for programs over 100MB.
    my ($size) = $vmsize =~ /VmSize:\s+(.*)$/;
    Good point, I looked at it with a hex editor, and it seems that it should be a tab
    (my $vmsize) = grep {/VmSize/} @size; my (undef,$size) = split "\t",$vmsize;

    I'm not really a human, but I play one on earth. flash japh

Back to Snippets Section

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (8)
As of 2014-10-24 10:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (131 votes), past polls