This is another take on the idea in
ztk-visual-top-w-kill. This one, takes a single program , for which you want to watch the cpu and ram usage, over a few minutes. It then displays a running bar graph
of the app given as arg1 on the commandline. It has 2 threads, one to run the app, one to watch it's pid with top, and the Tk for display.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use threads;
use threads::shared;
# 1 setting for big or default font, see lines
my $prog : shared;
$prog = shift or die "Need a program to run a arg 1 $!\n";
#$prog = './float2';
#create threads first, to make Tk thread-safe
my $buf : shared;
my $thread0_die : shared;
my $thread0_go : shared;
$buf = '';
$thread0_die = 0;
$thread0_go = 0;
my $pid : shared;
my $thread1_go : shared;
$pid = '';
$thread1_go = 0;
my $thread0 = threads->new( \&monitor );
my $thread1 = threads->new( \&run );
my $pos = 0;
my $string1 = 'pid user ';
my $string2 = ' mem ';
my $string3 = ' cpu ';
my $string4 = 'program';
my $mouse = 0;
my $mw = new MainWindow;
$mw->protocol('WM_DELETE_WINDOW' => sub {
+
kill 9, $pid;
$thread0_die = 1;
$thread0->join;
$thread1->join;
exit;
+
});
my $tframe = $mw->Frame(-bg=>'black')->pack(-fill=>'x');
$tframe->Label(-text=> 'RAM ------',-bg=>'black',-fg=>'red')->pack(-si
+de=>'left');
$tframe->Label(-text=> 'CPU ------',-bg=>'black',-fg=>'green')->pack(-
+side=>'left');
my $sb;
$sb = $tframe->Button(-text=> 'Start',
-bg=>'white',
-fg=>'black',
-command =>sub{
if($sb->cget('-text') eq 'Start'){
$sb->configure(-text => 'Stop');
$thread1_go = 1;
$thread0_go = 1;
my $id = Tk::After->new($mw,100,'repeat',\&refresh);
}else{
kill 9, $pid;
$thread0_go = 0;
}
} )->pack(-side=>'right');
my $canvas0 = $mw->Canvas(
-bg =>'black',
-height => 20,
-width => 600,
)->pack(-expand=>0,-fill=>'x');
my $canvas = $mw->Scrolled('Canvas',
-bg =>'black',
-height => 300,
-width => 600,
-scrollregion => [0,0,1000,600],
-scrollbars => 'osoe',
)->pack(-expand=>1,-fill=>'both');
my $realcan = $canvas->Subwidget('scrolled');
#my $font = 'default';
my $font = $mw->fontCreate('font',
-family=>'arial',
-weight=>'bold',
-size=>int(-18*18/14));
my $fonttest = $canvas->createText(0,0,
-fill => 'black',
-text => 'W',
-font => $font,
);
my ($bx,$by,$bx1,$by1) = $canvas->bbox($fonttest);
my $f_w = $bx1 - $bx;
my $f_h = $by1 - $by;
$canvas->delete($fonttest);
my $text1 = $canvas0->createText($f_w, 0 ,
-fill => 'orange',
-text => $string1,
-font => $font,
-anchor => 'nw',
-justify => 'left',
-tags => ['slider']
);
my $text2 = $canvas0->createText(length($string1)* $f_w , 0,
-fill => 'red',
-text => $string2,
-font => $font,
-anchor => 'nw',
-justify => 'left',
-tags => ['slider']
);
my $text3 = $canvas0->createText( (length($string1)+length($string2))*
+ $f_w, 0,
-fill => 'green',
-text => $string3,
-font => $font,
-anchor => 'nw',
-justify => 'left',
-tags => ['slider']
);
my $text4 = $canvas0->createText(
(length($string1)+length($string2)+length($string3) )* $f
+_w, 0,
-fill => 'yellow',
-text => $string4,
-font => $font,
-anchor => 'nw',
-justify => 'left',
-tags => ['slider']
);
$canvas->createLine($f_w, $pos * $f_h + 1.5*$f_h,
$f_w + 1000 , $pos * $f_h + 1.5*$f_h ,
-fill => 'white',
-dash => '- -',
-width =>1,
);
$canvas->createLine($f_w, $pos * $f_h + 1.5*$f_h,
$f_w, 250 + $pos * $f_h + 1.5*$f_h ,
-fill => 'white',
-dash => '- -',
-width =>1,
);
my (undef,undef,$x,$y) = $realcan->bbox("all");
if( defined $x){
$realcan->configure(-scrollregion => [0,0,$x + 30, $y+30 ] );
}
$mw->waitVisibility;
#setup an autoscroll when active area is near righ edge
my $o_xscrollcommand = $realcan->cget( -xscrollcommand );
$realcan->configure( -xscrollcommand => sub {
if ( $_[1] > 0.95 ){
$canvas->xview('moveto',1)
}else{
$o_xscrollcommand->Call( @_ );
}
}
);
MainLoop;
sub refresh{
my @data = split(/\n/, $buf);
my ($user,$command,$mem,$cpu);
foreach my $line(@data){
$line =~ s/^\s+//;
if($line =~ /^\d+/){
my @p = split(/\s+/, $line);
$user = $p[1];
$command = $p[11];
$mem = $p[9];
$cpu = $p[8];
}
}
if(defined $user){
$string1 = $pid.' '.$user.' ';
$string2 = $mem.' ';
$string3 = $cpu.' ';
$string4 = $command;
$canvas0->itemconfigure($text1, -text=> $string1);
$canvas0->itemconfigure($text2, -text=> $string2);
$canvas0->itemconfigure($text3, -text=> $string3);
$canvas0->itemconfigure($text4, -text=> $string4);
$pos +=4;
#500 pixel max width, so 500 = 1.0 or 100%
$canvas->createLine($f_w + $pos, 1.5*$f_h ,
$f_w + $pos, 1.5*$f_h + $cpu * 2.5,
-fill => 'green',
-width =>4,
# -stipple =>'gray75',
);
$pos +=4;
$canvas->createLine( $f_w + $pos, 1.5* $f_h,
$f_w + $pos, 1.5*$f_h + $mem * 2.5,
-fill => 'red',
-width =>4,
-stipple =>'gray75',
);
}
if(($pos > 600) and ($thread0_go == 1)){
my (undef,undef,$x,$y) = $realcan->bbox("all");
if( defined $x){
$realcan->configure(-scrollregion => [0,0,$x + 30, $y+30 ] );
}
}
}
##################################################################
sub monitor{
$|++;
use IO::Select;
while(1){
if( $thread0_go == 1){
my $pid0 = open( READ, "top -b -d .1 -p $pid |");
waitpid($pid0, 1);
my $sel = new IO::Select();
$sel->add(\*READ);
while(1){
foreach my $h ($sel->can_read){
sysread(READ,$buf,4096);
}
if( $thread0_die == 1 ){return} #kill thread
}
}
select(undef,undef,undef,.5);
}
}
#####################################################################
sub run{
$|++;
while(1){ # stay in holding pattern until go is given
if( $thread1_go == 0){
select(undef,undef,undef,.1);
}else{ last }
}
$pid = open( RUN, "| $prog ");
print RUN ''; #hack to prevent harmless error message
waitpid($pid, 1);
}
#####################################################################
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.