Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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...


In reply to Tk related -- timed event and $SIG{ALRM} by snafu

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

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



      Results (111 votes). Check out past polls.

      Notices?