http://perlmonks.org?node_id=594531
Reputation: 0

Description: I wanted to monitor the cpu and ram usage of some test apps, and found it hard to follow the jumping pid sort of top. So I run top in a thread in batch mode, and present it's output sorted by pid (so it dosn't jump ) and made crude, but usable, bar graphs for the cpu and mem.

It dosn't use too much cpu at the rates i've built-in, which is .5 seconds for top and 1 second for the Tk display. You can speed things up if desired, but at the expense of increasing cpu usage to over a few percent.

There is one unexplained bug I've found, related to running top in -b (batch mode). One of my apps, "/home/zentara/bin/claws" ( a mail program), shows up as the number 3 as a command name in batch mode. I can't explain it, and figure it's a small bug in top? Otherwise it works fine.

A mouse button 1 click on an app, will present a kill dialog for that pid.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Dialog;
use threads;
use threads::shared;

# 1 setting for big or default font, see lines 41 - 42

#mouse button 1 click on an app, will ask if you want to kill it

#create thread first, to make Tk thread-safe
my $buf : shared;
my $thread_die : shared;
$buf = '';
$thread_die = 0;
my $thread = threads->new( \&work );

#my %pid; #global to hold pid data

my $mw = new MainWindow;
$mw->protocol('WM_DELETE_WINDOW' => sub {                             
+                    
                $thread_die = 1;
        $thread->join;                                  
                exit;                                                 
+                    
           });        

my $tframe = $mw->Frame(-bg=>'black')->pack(-fill=>'x');
$tframe->Label(-text=> 'CPU ------',-bg=>'black',-fg=>'green')->pack(-
+side=>'left');
$tframe->Label(-text=> 'RAM ------',-bg=>'black',-fg=>'red')->pack(-si
+de=>'left');

my $canvas = $mw->Scrolled('Canvas',
          -bg =>'black',
          -height => 500,
      -width => 600,
          -scrollregion => [0,0,400,500],
      -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 $id = Tk::After->new($mw, 1000,'repeat',\&refresh);

MainLoop;

sub refresh{

  my %pid;
  $canvas->delete('all');
   
#  print "$buf\n";
  my @data = split(/\n/, $buf);

  foreach my $line(@data){
          $line =~ s/^\s+//;
          if($line =~ /^\d+/){ 
            my @p = split(/\s+/, $line); 
        my $pid = $p[0];
        $pid{$pid}{'user'} = $p[1];
        $pid{$pid}{'command'} = $p[11];
        $pid{$pid}{'mem'} = $p[9];
        $pid{$pid}{'cpu'} = $p[8];
     }
     }
   
    my $count = 1;
    foreach my $key(sort {$a<=>$b} keys %pid){
     
     my $string = ' ' x ( 7 - length( $key ) ) . $key;
     
     $pid{$key}{'user'} .=  ' ' x ( 15 - length( $pid{$key}{'user'} ) 
+);
                 
     $string .= '   '.$pid{$key}{'user'}.'  '.$pid{$key}{'mem'}.'   '.
             $pid{$key}{'cpu'}.'   '.$pid{$key}{'command'};

    my $text = $canvas->createText(0, $count * $f_h ,
                -fill    => 'orange',
                -text => $string,
            -font => $font,
                -anchor => 'nw',
        -justify => 'left',
            -tags => [$key,'string'],
          );

     #500 pixel max width, so 500 = 1.0 or 100%
    $canvas->createLine($f_w, $count * $f_h - 2, 
                        $f_w + $pid{$key}{'cpu'} * 5  ,  $count * $f_h
+ - 2 ,  
                -fill    => 'green',  
        -width =>5,
    #    -stipple =>'gray75',
          );

    $canvas->createLine($f_w, $count * $f_h + $f_h , 
                        $f_w + $pid{$key}{'mem'} * 5  , $count * $f_h 
++ $f_h ,
                -fill    => 'red',
                -width =>5,
    #    -stipple =>'gray75',
          );

    $canvas->createLine($f_w, $count * $f_h + 1.5*$f_h, 
                         $f_w + 500  , $count * $f_h + 1.5*$f_h ,  
                -fill   => 'white',
        -dash   => '- -',
        -width  =>1,
          );
   
   $count +=2;
   }

   $canvas->CanvasBind("<Button-1>",sub{
      my ($tag) = grep /\d+/, $canvas->gettags("current");
           if( defined $tag){ &do_dialog($tag) }
       } );


   $canvas->bind( 'string', '<Enter>' => sub{
       my ($tag) = grep /\d+/, $canvas->gettags("current");
        if( defined $tag){      
            my ($current) = $canvas->find('withtag','current');
        $canvas->itemconfigure($current,-fill=>'white');
          }
      });

   $canvas->bind( 'string', '<Leave>' => sub{
       my ($tag) = grep /\d+/, $canvas->gettags("current");
        if( defined $tag){      
            my ($current) = $canvas->find('withtag','current');
        $canvas->itemconfigure($current,-fill=>'orange');
          }
      });
   

     my (undef,undef,$x,$y) = $realcan->bbox("all");

     if( defined $x){
       $realcan->configure(-scrollregion => [0,0,$x + 30, $y+30 ] ); 
      }
    
}
##################################################################
sub work{
   $|++;
   use IPC::Open3;
   use IO::Select;
   my $pid1 = open3(0, \*READ, 0,"top -b -d .5");
  
   my $sel = new IO::Select();
   $sel->add(\*READ);
 
  while(1){
    foreach my $h ($sel->can_read){
         sysread(READ,$buf,8192);
         # print "$buf\n\n";
     }
  if( $thread_die == 1 ){return} #kill thread
  }

}
#####################################################################
sub do_dialog {
 my $pid = shift;
 $pid += 0; #make numeric
 my $dlg = $mw->Dialog(
  -title=>"Kill pid # $pid?",
  -buttons => ["Cancel", "No", "Yes"],
  -default_button => "No",
  -text => "Kill pid # $pid ?",
  -font => "Helvetica"
  );
 my $result = $dlg->Show();

 if($result eq 'Yes'){ kill 9, $pid } 
 
 }
#####################################################################

Edit your snippet here
Comment on ztk-visual-top-w-kill
Download Code -- Send private /msg to zentara

Back to Snippets Section