GMeM -- a gtk2 memory monitor utlity module
- From: zentara <zentara zentara net>
- To: gtk-perl-list gnome org
- Subject: GMeM -- a gtk2 memory monitor utlity module
- Date: Sat, 7 May 2005 12:52:32 -0400
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]