Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Tk related -- timed event and $SIG{ALRM}

by snafu (Chaplain)
on Oct 17, 2002 at 18:30 UTC ( #206088=perlquestion: print w/replies, xml ) Need Help??

snafu has asked for the wisdom of the Perl Monks concerning the following question:

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...

Replies are listed 'Best First'.
Re: Tk related -- timed event and $SIG{ALRM}
by rbc (Curate) on Oct 17, 2002 at 18:36 UTC
    Take a look at
    perldoc Tk::after
    Maybe that's what you want.
Re: Tk related -- timed event and $SIG{ALRM}
by gri6507 (Deacon) on Oct 17, 2002 at 19:08 UTC
    Try something like $mainWin->repeat(5000,\&routine); to execute "routine" every 5 seconds.
Re: Tk related -- timed event and $SIG{ALRM}
by rir (Vicar) on Oct 17, 2002 at 22:02 UTC
    Just to remove your uncertainty: a wall clock second is a common ordinary second. The warnings about the inaccuracy of alarm are due to resolution. It would be similar to you trying to time something with a digital watch that reads only to seconds. You cannot tell where you are in the current second, so your accuracy can be off by nearly a second.

      Hmm. Ok. I did some more testing and I learned that if I wasn't doing something with the running script ie moving the mouse over the window, clicking buttons, etc then the ALRM never triggered. This was one of the reasons I associated the wallclock seconds with clock cycles associated with the application vs general clock cycles.

      _ _ _ _ _ _ _ _ _ _
      - Jim
      Insert clever comment here...

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://206088]
Approved by rbc
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (4)
As of 2019-06-26 22:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Is there a future for codeless software?



    Results (111 votes). Check out past polls.

    Notices?