#!/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]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.