Im writing my first Tk app and it is coming along very nicely. However, I have one snag that is just kicking my arse.
The purpose of the app is to show me a number of files in a given set of directories every n seconds. The seconds are determined by a set of radio buttons 1,5,10, and 15 seconds, respectively. This works great in theory. I am using alarm() and $SIG{ALRM} to trigger the event set up in the radio buttons. The problem lies in using SIG ALRM. According the perldoc, SIG ALRM is not actually based on the number of seconds that elapse but rather wallclock seconds. So the "seconds" are actually not real seconds (as semi-warned in the documentation) but rather usually delayed seconds....very delayed. For instance, if I choose to update every second I get one update speratically on average about every 5 seconds; sometimes as long as 10 to 15 seconds. If I choose every 5 seconds I am able to actually go for as long as three to four minutes or when I actually do something like click buttons or something on the app. I am not completely sure what wallclock seconds are. I am guessing a number of CPU cycles in seconds burned by the process?
So, I am thinking that there must be a way to use
sleep() that doesn't block the mainloop. Unfortunately, I have not been able to come up with such a mechanism. I am positive this is due to a lack of knowledge I have. Anyone have any suggestions?
I was thinking perhaps some kind of threading model where a thread actually does the sleeping might work. Hopefully, this would allow the mainloop not to get blocked. However, I have never done any coding with threads and all of the warnings applied to threading with perl seems like something I shouldn't endeavor right now.
I will go ahead and post the code for a matter of reference.
TIA fellow monks.
- Jim
#!/usr/bin/perl -w
#
# Author: Jim Conner
#
#
#
#
#
#
#
#
#
# ***************************************************
# *****************
# import modules
# *****************
use Tk;
use Env;
use POSIX;
use strict;
use Tk::Menu;
use Tk::Table;
use Tk::ROText;
use Tk::LabEntry;
use File::Basename;
# *****************
# Global variables
# *****************
use vars qw($mainWin $TIMER);
# *****************
# Global declarations
# *****************
if ( $ARGV[0] ) {
$TIMER = $ARGV[0];
} else {
$TIMER = 5;
}
# *****************
# Dynamic Globals
# *****************
my $Title = 'GUI watch';
my @prts2chk = qw(100 120 180 182);
my @dirs2chk = qw(act new err new.pri new.tape new.sec cmp);
my $basedir = $HOME . '/gvc_dtfr';
my $linectr = 0;
my (@errors,@msgs, %error_hash, %message_hash);
# *****************
# Main
# *****************
BEGIN {
eval { $SIG{ALRM} = \&doChk };
};
&init_win($Title);
&doChk;
MainLoop;
# *****************
# Sub-routines
# *****************
sub Exit {
$mainWin->destroy();
print "Exiting...\n";
exit(0);
}
sub init_win {
my $MainTitle = shift;
my %mButtonDes = ( -relief => 'raised',
-width => '6' ,
);
my %mButtonPck = ( -side => 'left' ,
-anchor => 'n' ,
-expand => '0' ,
-fill => 'none' ,
-padx => '1' ,
-pady => '1' ,
);
$mainWin = MainWindow->new(-title => $MainTitle);
# Doll up main window
$mainWin->geometry("300x700");
$mainWin->minsize (200,700);
$mainWin->maxsize (500,968);
$mainWin->Label ( -text => $Title )->pack();
# Set frames up
my $mframe = $mainWin->Frame( -relief => 'groove',
-border => '2',
)->pack(
-fill=> 'x');
my $frame1 = $mainWin->Frame()
-> pack();
my $frame2 = $mainWin->Frame()
-> pack();
my $frame3 = $mainWin->Frame()
-> pack();
my $frame4 = $mainWin->Frame()
-> pack( -fill => 'both',
-expand => 1,);
# Make the menu
my $fileBtn = $mframe
->Menubutton( -text => 'File',
%mButtonDes,)
-> pack( %mButtonPck, );
my $aboutBtn = $mframe
->Menubutton( -text => 'About',
%mButtonDes,)
-> pack( %mButtonPck,
-side => 'right',);
# *************
# Add stuff to the frames
# *************
# Create frame one's radio button selections
$frame1 ->Radiobutton
( -text => '1s' ,
-state => 'normal' ,
-value => '1' ,
-justify => 'center' ,
-selectcolor => 'blue' ,
-activebackground => 'gray' ,
-highlightbackground=> 'gray77' ,
-variable => \$TIMER ,
-border => 2 ,
-command => \&doChk ,
-relief => 'flat' ,)
-> pack( -side => 'left' ,);
$frame1 ->Radiobutton
( -text => '5s' ,
-state => 'normal' ,
-value => '5' ,
-justify => 'center' ,
-selectcolor => 'blue' ,
-activebackground => 'gray' ,
-highlightbackground=> 'gray77' ,
-variable => \$TIMER ,
-border => 2 ,
-command => \&doChk ,
-relief => 'flat' ,)
-> pack( -side => 'left' ,);
$frame1 ->Radiobutton
( -text => '10s' ,
-state => 'normal' ,
-value => '10' ,
-justify => 'center' ,
-selectcolor => 'blue' ,
-activebackground => 'gray' ,
-highlightbackground => 'gray' ,
-variable => \$TIMER ,
-border => 2 ,
-command => \&doChk ,
-relief => 'flat' ,)
-> pack( -side => 'left' ,);
$frame1 ->Radiobutton
( -text => '15s' ,
-state => 'normal' ,
-value => '15' ,
-justify => 'center' ,
-selectcolor => 'blue' ,
-activebackground => 'gray' ,
-highlightbackground => 'gray' ,
-variable => \$TIMER ,
-border => 2 ,
-command => \&doChk ,
-relief => 'flat' ,)
-> pack( -side => 'left' ,);
# Create frame two's box area
my $widget2 = $frame2->Scrolled( 'Listbox',
-height => 25 ,
-scrollbars => 'osoe' ,)
-> pack( -fill => 'y' ,
-expand => 1 ,);
# Create frame three's button (refresh)
my $widget3 = $frame3->Button ( -text => 'Refresh',
-command => \&doChk ,)
-> pack( -fill => 'none' ,
-expand => 0 ,);
# Create frame four as the error box
# frame.
my $widget4 = $frame4->Scrolled( 'Listbox',
-height => 15 ,
-scrollbars => 'osoe' ,)
-> pack( -fill => 'both' ,
-expand => 1 ,);
tie(@msgs , "Tk::Listbox", $widget2);
tie(@errors, "Tk::Listbox", $widget4);
}
sub doChk {
print "TIMER is: $TIMER\n";
my $make_msg =
sub {
my $Errtype = shift || 'err';
my $message = shift || return(1);
if ($Errtype eq 'err' ) {
$error_hash{$message} = 1;
@errors = sort(keys(%error_hash));
}
if ($Errtype eq 'mainmsg' ) {
$message =~ /^\s+?(\d+)/;
my $port = $1;
$message =~ /([a-z\.]+)/i;
my $dir = $1;
$message_hash{$port}{$dir} = $message;
@msgs =
sort(
map {
values %{$message_hash{$_}}
} keys %message_hash
);
}
};
if ( ! chdir($basedir) ) {
&$make_msg('err',"Unable to chdir to: $basedir");
return(0);
}
for my $port ( @prts2chk ) {
for my $directory ( @dirs2chk ) {
my $path = $basedir ."/port". $port ."/". $directory;
if ( -d $path ) {
unless ( chdir($path) ) {
&$make_msg('err',"Unable to chdir to: $path");
return(0);
}
my @files = glob('*');
my $line = sprintf("%4s %8s ==> %s",
$port,
$directory,
scalar(@files));
&$make_msg('mainmsg',$line);
} else {
next;
}
}
}
alarm($TIMER);
}
0
_
_
_
_
_
_
_
_
_
_
- Jim
Insert clever comment here...
