UPDATE: 15 Oct 2010 This script is very buggy. I leave it here as a lesson in bugginess. :-) Please see the script in the reply below, which works better. This didn't need threads, nor IO::Select, but it was a hack I came up with while learning. Top output is hard to process completely. Either you get only the top few pids, depending on the size of the terminal you are using, or you get leftover fragments from the previous run in the pipe.

The improved version below, gets all pids, at the expense of forking off top on every refresh.

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=> 'RAM ------',-bg=>'black',-fg=>'red')->pack(-si
+de=>'left');
$tframe->Label(-text=> 'CPU ------',-bg=>'black',-fg=>'green')->pack(-
+side=>'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");
   waitpid($pid1, 1);
   
   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 } 
 
 }
#####################################################################

[download]

Replies are listed 'Best First'.
Re: ztk-visual-top-w-kill
by zentara (Cardinal) on Oct 15, 2010 at 21:19 UTC
    Here is an improved version. It has a small annoying bug, in that the vertical progress bar may stutter while the update occurs.... just an annoying lack of smoothness in the scroll. But it is a usable tool. 
    #!/usr/bin/perl
use warnings;
use strict;
use IO::Pipe;
use Tk;
use Tk::Dialog;

# 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

my $mw = new MainWindow;

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 $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);


# setup ipc for top
#$pid = open(FH, "top -b |") or die "$!\n";
#$mw->fileevent($fh, 'readable', [\&refresh]);

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

refresh();

MainLoop;

sub refresh{

  my $fh = new IO::Pipe;
  $fh->reader("top -b -n 1");
  my @data = <$fh>;
  splice(@data,0,7); #remove headers
#  print  @data,"\n";
  $fh->close;

 my %pid;
 $canvas->delete('all');

  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 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 => $font
  );
 my $result = $dlg->Show();

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

    [download]
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]

Back to Cool Uses for Perl