I am trying to use a PERL/TK application to create a software
alarm panel. This panel basically consists of a BUTTON widget.
If the BUTTON widget is colored green, it means no alarms, if it
is colored red it means there are alarms. When the button is
clicked, the button will set the number of active alarms to zero.
I understand how to create and display the button and how to
call a command to clear the color and number of alarms.
The question is, is there a way, without clicking on ANY button,
for the perl script to periodically check a set of variables,
and based on the contents of those variables, change the status
of the alarm. Without user intervention, ie. clicking.
The idea being the the PERL script would call a C program which
checks the status of a software subsystem, if an alarm is present,
it would return a flag, the perl script upon detecting the flag,
would increment an alarm counter. at that point I would like the
script to automatically update the button, without desctoying the
button and re-creating it.
Any ideas ??
THANK YOU
BIll.
how about (untested code follows :)
#!/usr/local/bin/perl5
use Tk;
$m=new MainWindow;
$b=$m->Button();
configbutton($b,$errors=0);
$b->configure(-command => sub{ configbutton($b,$errors=0);});
$b->repeat(1000,[\&checkprog,$b]); # repeat every second
$b->pack();
MainLoop();
sub checkprog
{
configbutton($_[0],++$errors) if `callsomeprogram`=~/ERROR/;
}
sub configbutton
{
my($w,$errs)=@_;
$w->configure(-text => 'errors: $errs',
-background => ($errs?'red','green'));
}
Try editing and using the following code-snippit: Then, replace
your call to "MainLoop" with a call to this routine instead!
sub MyMainLoop
{
while (1)
{
if ($loopcnt == 2500) #INCREASE NUMBER TO REDUCE FREQUENCY
#OF CHECKS.
{
#### CALL YOUR C-ROUTINE OR WHATEVER HERE. ####
$loopcnt = 0;
}
++$loopcnt;
DoOneEvent(1);
}
}
-----------------------------------------------
Good Luck
> Try editing and using the following code-snippit: Then, replace
> your call to "MainLoop" with a call to this routine instead!
>
> sub MyMainLoop
> {
> while (1)
> {
> if ($loopcnt == 2500) #INCREASE NUMBER TO REDUCE FREQUENCY
> #OF CHECKS.
> {
> #### CALL YOUR C-ROUTINE OR WHATEVER HERE. ####
> $loopcnt = 0;
I don't think that this is a good idea!! I'm new to perl so I could be
wrong, but this looks to me like it would take a different amount of
time depending on which machine you run it, and if you develop your code
on a PC and then run it later on a fast unix server (for example) you
could be in a tight loop and causing performance problems on that
machine. I would suggest using a sleep here.
> }
> ++$loopcnt;
> DoOneEvent(1);
> }
> }
>
> -----------------------------------------------
> Good Luck
You'll need it!
>
> Jim
> jim.t...@limco.com
--
_________ Steve Button TIS, HP Brussels
[ _ _ \ Telnet: 710-3450
[ [_] [_][]\ \|||/ Tel: +32 (0)2 778-3450
[ \ (. .) Fax: +32 (0)2 778-3349
[_O_______O_] _____oOO_(_)_OOo_____________________
The question is, is there a way, without clicking on ANY button,
for the perl script to periodically check a set of variables,
and based on the contents of those variables, change the status
of the alarm. Without user intervention, ie. clicking.The idea being the the PERL script would call a C program which
checks the status of a software subsystem, if an alarm is present,
it would return a flag, the perl script upon detecting the flag,
would increment an alarm counter. at that point I would like the
script to automatically update the button, without desctoying the
button and re-creating it.
You can get an immediate response whenever the variable changes
by using Perl 5's 'tie' mechanism. This way you don't have to mess
around with sleeps and loops and such. You just let Perl do the work.
It is about the slickest thing since sliced bread. Let me know if it
works for you.
Good Luck.
Andy
Here's some untested hacked up code I cut from my own app:
...
tie $my_alarm_variable, 'Alarm';
...
package Alarm;
sub TIESCALAR
{
my ($pkg) = @_;
my $obj;
return ( bless \$obj, $pkg );
}
sub FETCH
{
my ($obj) = @_;
return $$obj;
}
sub STORE
{
my ($obj, $val) = @_;
$$obj = $val;
if ( $val =~ /alarm_variable_is_go/ )
{
# Do whatever you need to do to turn button
green
$button_widget->configure( -color => "green"
);
}
else if ( $val =~ /alarm_variable_is_stop/ )
{
# Do whatever you need to do to turn button red
$button_widget->configure( -color => "red" );
}
}
1;