GMeM -- a gtk2 memory monitor utlity module



Hi, thanks to muppet, I have a gtk2-perl version of my
memory monitoring utility. I use it when I want to watch
for memory gains in scripts.
  Just put GMeM.pm  in your PERL5LIB and put "use GMeM;"
in your script.
  It will autoclose when the calling script closes, or you can click it
to close it.
  I use an asmutils version of cat ( it's only 147 bytes :-) ), but you can
change it to use the system cat.
  I place it in the bottom right corner, because I keep my toolbar at the top.

GMeM.pm
####################################################
package GMeM;
use warnings;
use strict;

my $pid =$$; #gets the caller script's pid and
             #passes it thru the fork-&-exec below

#only gets created after fork and exec to prevent
#module's X socket connection from interfering with
#calling program's X socket connection
 
if ((defined  $ARGV[0]) and  ($ARGV[0] eq 'GMeM')) {
    use Gtk2 '-init';
    $pid = $ARGV[1];

   my $blueh = Gtk2::Gdk::Color->new (0,0xFFFF,0xFFFF);
   my $bluel = Gtk2::Gdk::Color->new (0,0xCCCC,0xFFFF);

Gtk2::Rc->parse_string(<<___EOS);
style "normal" {
  font_name ="Sans Bold 12"
}

widget "*" style "normal"
___EOS

    my $win = Gtk2::Window->new('popup');
    $win->signal_connect( 'destroy' => \&delete_event );
    
    my ($xscr, $yscr) = (Gtk2::Gdk->screen_width, Gtk2::Gdk->screen_height);
    $win->move($xscr - 180, $yscr - 20);
    
    my $but = Gtk2::Button->new("PID: $pid->       " );
    
    $but->modify_bg ('normal', $blueh);
    $but->modify_bg ('prelight', $bluel);
    
    $but->signal_connect( 'clicked' => \&delete_event );
            
    $win->add($but);
    $0 = "GMeM $pid";
    $win->show_all();
    
    &refresh($pid);
    my $repeater = Glib::Timeout->add(1000, sub{ refresh($pid) ; 1;} );

    Gtk2->main;
   ##################################### 
   sub delete_event { Gtk2->main_quit; return 0; }

   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;
        $but->set_label("PID: $pid -> $size");
        if ($size eq '') { exit }
    }
   ####################################

 } elsif (fork() == 0) { exec "$^X -MGMeM -e1 GMeM $pid"; }

1;
__END__


-- 
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]