Re: Monitor GUI


"Tandaina" <Tandaina@xxxxxxxxx> wrote in message-id:
<1139260430.388056.20710@xxxxxxxxxxxxxxxxxxxxxxxxxxxx>

I'm a Perl/Tk newbie so bear with me, I'm sure this is an easy problem
but I've had no luck finding a solution (probably because I'm not sure
what to search for.)

I currently have a simple little Perl script whose job is to listen on
a particular socket. Client programs send a message to this socket
when there is a error with whatever they're doing. When teh Perl
script gets one of these errors it displays an error message by calling
a TCL window. Easy and works well.

However, the customer wants something different now. They would like a
little window that is always visible and is green when all is good, and
red when we've gotten an error message. Since the existing script is
in Perl a simple upgrade to Perl/Tk seemed like the best solution.

All I need is a button that starts out green and does nothing until a
message is received, at which point it turns red. I'm running into a
frustrating issue. If I use the "MainLoop" call my GUI gets created
but my socket monitoring code never gets reached. If I dont' use my
"MainLoop" call the socket monitor goes off and does its thing but the
GUI never gets created.

I've create a simple mock up program to show what I'm trying to do.
Can anyone show me where I'm going wrong?

#!/usr/bin/perl
use IO::Socket;
use IO::Select;
use Tk;
use Tk::DialogBox;

# Create the GUI window.
my $mainwindow;
$mainwindow = MainWindow->new();
$mainwindow->configure(-title=>'Status');

#Create and setup the status indicator (button)
my $center;
$center = $mainwindow->Frame->pack(-side=>'top');
my $status_button = $center->Button(-text=>'Diag Status',
-background=>'green',
-activebackground=>'green',
-command=> \&show_errors)->pack(-side=>'top');

#PROBLEM HERE (if I uncomment this the next code never happens.
# But without it the GUI never gets drawn.
#MainLoop;

my $sock = IO::Socket::INET->new(
LocalPort => '8013',
Proto => "tcp",
Listen => 1,
Reuse => 1,
);
die "Could not create socket: $!\n" unless $sock;


while( $new_socket = $sock->accept() ) { # wait for and accept a
connection
while( defined( $buffer = <$new_socket> ) ) { # read from the socket
print $buffer; #print what we got for fun (used to spawn a window
here with error message)
swapColor($status_button, "green", "red"); #change the button
color (please?)
}
close($new_socket);
}

# Someday this should show a window with current errors.
#For now just print stuff.
sub show_errors() {
print "Button Click!";
}

# Change the button color
sub swapColor {
my ($button, $oldColor, $newColor) = @_;
print "swapColor";
foreach my $tag ($button->find("all")) {
print $tag;
if ($button->itemcget($tag, "-background") eq $oldColor) {
$button->itemconfigure($tag, -background => $newColor);
} elsif ($button->itemcget($tag, "-activebackground") eq
$oldColor) {
$button->itemconfigure($tag, -activebackground => $newColor);
}
}

}

# END


(I tried making this use two processes (we don't have thread support
compiled in) but while the GUI showed and the script listened correctly
for messages it of course couldn't update the button color. *sigh*)

- Tandaina

a simple hack would be to have the tk script monitor a directory for
the presence of a file, when the file is found the tk gui should change,
this file can be created when the monitor script detects an error.



.