Perl TK program

[iceman4000000]

Hi all,

I am trying to write a small GUI in perl/tk and it's purpose is to basically ping another machine to see if it is on the network or not. It's a basic monitoring program. My intention is to have anything like a green circle in the GUI that will change to red if the machine I am pinging goes down. I have created the GUI etc. Can anyone give me some advice on how to refresh the GUI, because I don't seem to be able to change the colour of the circle...

Many thanks,

ICE

 

[icrf]

If it's what I'm thinking it is, in VB you'd call "DoEvents" to process any outstanding events. Since you're continually pinging, you're not leaving the program any time to perform any kind of redraw event. I'm not sure how to do that in perl, but I'll look around. Might be some Tk guru here that knows that kind of thing off the top their head.

----------------------------------------------------------------------------------
...but I'm just a C man trying to see the light

 

[TheGenius22]

Well u can always use the $widget->update command to refresh any graphic change. I use this for the exact same program you're making now execpt I use text and not colors.

Hope this helps

 

[Nagia]

The Genius can you send me a copy of your program man?

 

[TheGenius22]

I cant seem to find that spcecific script, I changed it so it can email me when a server is down. I dont think this will help you much. There are multiple ways of refreshing graphics in perl.

If you post your code, i will help in all the way I can.

 

[greadey]

can u not use the $widget->configure(-params etc) method?

 

[TheGenius22]

HI Iceman,

Here's an example of what your looking for.

O.S. = Win2k Server

#!Perl -U

use strict;
use warnings;
use Tk;
use Net:ing;

my $main = new MainWindow;

my $frame1 = $main -> Frame -> pack(
-side => 'top',
-expand => 1,
-fill => 'both'
);

my $canv = $frame1 -> Canvas -> pack(
-expand => 1,
-fill => 'both'
);

my $toggle = $canv -> create(

('oval', 1 . 'c', 1 . 'c', 4 . 'c', 4 . 'c'),
-fill => 'black'

);

my $frame2 = $main -> Frame -> pack(
-side => 'bottom',
-expand => 1,
-fill => 'both'
);

my $ping_button = $frame2 -> Button(
-text => 'Ping It',
-default => 'active',
-command => \&pingit
) -> pack(
-side => 'right'
);

MainLoop;

sub pingit {

my $i = 1;
$ping_button -> configure(-state => 'disabled');
$ping_button -> update;
my $ping_it = Net:ing->new("icmp", .5);

while ($i == 1) {
my $res = $ping_it->ping('google.ca');
if (defined($res)) {
$canv -> itemconfigure($toggle, -fill => 'green');
$canv -> update;
}
else {
$ping_it->close;
$canv -> itemconfigure($toggle, -fill => 'red');
$canv -> update;
$ping_button -> configure(-state => 'normal');
$i = 0;
return;
}
sleep(3);
}

}

 

[iceman4000000]

Thanks everyone for all the great advice. I have now got my program almost ready to go... I have one more question though... The subroutine I have to ping the machines and change the colours in the circles etc is triggered by a button. So, everytime you want to ping the machines you have to manually press the button. Anyone know how to automate this so you maybe just press it once to start it off and then it will keep repeating the routine?

Thanks again,

ICE

 

[TheGenius22]

Just look at sub pingit in my previous post. This should give you an idea on how to proceed.

 

[iceman4000000]

Thanks Genius, you've been a real help.... just a couple of things I don't quite get... I am trying to create a while loop in my program - I was thinking of setting $i to "1". And then, while $i == 1 (just like in your example) I will be checking all the machines. However, I find that when I run the program, it locks up totally until the condition is satisfied - for example, my exit program button does not work and I have to "end task" to stop it running. And then, even if the condition is satisfied ($i == 0), the loop is exited and you have to manually kick the process off again with the "ping_it" button. What I'm looking for is my sub-routine to run in the background and stay running. Any other thoughts? Your help so far is much appreciated.

ICE

 

[TheGenius22]

Well i found 2 options for this.

1 - dont use sleep command (find another way to time your loop)

2 - use sleep but fork the graphics and the loop (little complicated)

what i did is i created 2 scripts one is the tk and the other is the ping loop. Implement fork code in tk script. The button that starts the entire thing actually loads the ping loop script (fork it). From there you "create a link" between both process. That's it.

 

[TheGenius22]

ICEMAN,

Here is an example of what I meant

#!Perl -U

use strict;
use warnings;
use Tk;
use Net:ing;


if (my $forker = fork()) {

my $mw = new MainWindow(- title => 'mw1');

my $canv = $mw -> Canvas -> pack(
- expand => 1,
- fill => 'both'
);

my $toggle = $canv -> create(
('oval', 1 . 'c', 1 . 'c', 4 . 'c', 4 . 'c'),
-fill => 'black'
);

my $but = $mw -> Button(
- text => 'Exit',
- default => 'active',
- command => \&main_exit
) -> pack(
- side => 'left'
);

$mw -> protocol('WM_DELETE_WINDOW' => \&main_exit);

MainLoop;

sub main_exit {
kill "CHLD" => $$; #destroys the 2nd process in else block (child)
exit; #destroys the 1st process in if block (parent)
}

}

else {

my $i = 1;
my $ping_it = Net:ing->new("icmp", .5);

while ($i == 1) {

my $res = $ping_it->ping('google.ca');

if (defined($res)) { print "1"; }
else { print "0"; }

sleep(1);

#dont try to modify any vars from the if block in this else block

}

}

from here u just create a link between both process so you can change the color of the circle.

Hope this helps