Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re^3: Perl/Tk code structure

by BrowserUk (Pope)
on Jan 11, 2012 at 12:12 UTC ( #947337=note: print w/ replies, xml ) Need Help??


in reply to Re^2: Perl/Tk code structure
in thread Perl/Tk code structure

Here is an updated version that looks for two specific prompts coming from STDOUT and popping up a dialog to deal with them. The implementations of those dialogs is crude --no validation; minimalistic gui; my Tk is pretty simplistic -- but they are a demonstration only. You can enhance to your hearts desire.

Again, the simplistic command line app:

#! perl -slw use strict; use threads; our $GUI //= 0; if( $GUI ) { require 'MyGui.pm'; async( \&MyGui::gui )->detach; } while( 1 ) { printf 'Enter three, 2-digit numbers: '; my $in = scalar <STDIN>; exit if $in =~ '!bye'; print 'You entered: ', $in; printf 'Enter a date and time: '; $in = scalar <STDIN>; exit if $in =~ '!bye'; print 'You entered: ', $in; }

Updated: Improved the code below a little.

And the gui module to service it it when the -GUI command line option is supplied:

package MyGuiStdin; our @ISA = qw[ Thread::Queue ]; sub TIEHANDLE { bless $_[1], $_[0]; } sub READLINE { $_[0]->dequeue(); } package MyGuiStdout; our @ISA = qw[ Thread::Queue ]; sub TIEHANDLE { bless $_[1], $_[0]; } sub PRINT { $_[0]->enqueue( join ' ', @_[ 1 .. $#_ ] ); } sub PRINTF { $_[0]->enqueue( sprintf $_[1], @_[ 2 .. $#_ ] ); } package MyGui; use strict; use warnings; use threads; use Thread::Queue; my $Qin = new Thread::Queue; my $Qout = new Thread::Queue; tie *STDIN, 'MyGuiStdin', $Qin; tie *STDOUT, 'MyGuiStdout', $Qout; sub gui { require Tk; require Tk::DialogBox; my $mw = Tk::MainWindow->new; my $lb = $mw->Listbox( -width => 80, -height => 24 )->pack; my $ef = $mw->Entry( -width => 70, -takefocus => 1 )->pack( -side +=> 'left' ); my $enter = sub { $Qin->enqueue( $ef->get ); $ef->delete(0, 'end' ); 1; }; my $do = $mw->Button( -text => 'go', -command => $enter)->pack( -a +fter => $ef ); $mw->bind( '<Return>', $enter ); $ef->focus( -force ); my $doStdout = sub { if( $Qout->pending ) { my $output = $Qout->dequeue; $lb->insert( 'end', $output ) ; $lb->see( 'end' ); if( $output eq 'Enter three, 2-digit numbers: ' ) { my $db = $mw->DialogBox( -title => 'Three 2 digit numb +ers', -buttons => [ 'Ok' ] ); my $e1 = $db->add( 'Entry', -width => 3 )->pack( -side + => 'left' ); my $e2 = $db->add( 'Entry', -width => 3 )->pack( -side + => 'left', -after => $e1 ); my $e3 = $db->add( 'Entry', -width => 3 )->pack( -side + => 'left', -after => $e2 ); $e1->focus( -force ); $db->Show; my $input = sprintf "%2d %2d %2d", $e1->get, $e2->get, + $e3->get; $Qin->enqueue( $input ); } elsif( $output eq 'Enter a date and time: ' ) { my $db = $mw->DialogBox( -title => 'Date&time', -butto +ns => [ 'Ok' ] ); my $day = $db->add( 'Entry', -width => 2 )->pack( -sid +e => 'left' ); my $mon = $db->add( 'Entry', -width => 2 )->pack( -sid +e => 'left', -after => $day ); my $year= $db->add( 'Entry', -width => 4 )->pack( -sid +e => 'left', -after => $mon ); my $hours = $db->add( 'Entry', -width => 3 )->pack( -s +ide => 'left' ); my $mins = $db->add( 'Entry', -width => 3 )->pack( -s +ide => 'left', -after => $hours ); my $secs = $db->add( 'Entry', -width => 3 )->pack( -s +ide => 'left', -after => $mins ); $day->focus( -force ); $db->Show; my $input = sprintf "%2d/%02d/%02d %2d:%02d:%02d", $day->get, $mon->get, $year->get, $hours->get, $mi +ns->get, $secs->get; $Qin->enqueue( $input ); } } }; $mw->repeat( 500, $doStdout ); Tk::MainLoop(); } 1;

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?


Comment on Re^3: Perl/Tk code structure
Select or Download Code
Re^4: Perl/Tk code structure
by elef (Friar) on Jan 11, 2012 at 18:40 UTC
    Thanks, I will go through it and try to wrap my head around it.

      I'll say it again. If you will identify what you are having trouble with understanding, then I'll try to clarify those parts.

Re^4: Perl/Tk code structure
by elef (Friar) on Jan 17, 2012 at 19:53 UTC
    Thanks for the help.
    I've read through it and commented what I get and what I don't get. It looks like I'll be able to just add my GUI elements and use it. I tried setting it up with my own script and ran into problems right away. Perl just crashed as soon as it got to the part where the GUI module is loaded. It turns out that if I have something like
    open(LOG, ">:encoding(UTF-8)", "$scriptpath/scripts/log.txt") or print "\nCan't create log file: $!\nContinuing anyway.\n";
    before the .pm is loaded, it crashes. (It works if I remove ">:encoding(UTF-8)", but that's hardly ideal.)
    The reason why I have other code before require 'MyGui.pm'; is that I have OS-specific defaults for whether or not the GUI is launched, which can be overwritten in a setup txt file. So the main script has to determine what OS it's running on and then find and read setup.txt before it can decide whether to launch the gui.
    I also have binmode STDIN, ':encoding(UTF-8)'; at the start of the script, which also crashes the GUI (IIRC it was needed for non-ASCII input file names to work on linux).
    Now, it seems pretty clear from these errors I got and this thread that caution is the word of the day when it comes to Tk and threads. Should I just change the way $gui is set and use the command line parameter system you used in your sample script and putt the if ($GUI) {} at the very start of the script?

      Okay. I'm going to break this down into chunks.

      • First, lets deal with the business end of things, the $doStdout() sub:
        my $doStdout = sub { ## $Qout is a [Thread::Queue] object onto which anything that + is printed to stdout is enqued by the "black magic". ## It is created by the statement <c>my $Qout = new Thread::Q +ueue;</c>. ## If you look up the documentation for that module you'll se +e that the <c>pending()</c> method returns ## the count of 'things' in the the queue. Using that informa +tion, the next line of code reads: ## If there is anything in the queue -- ie. if the parent pro +gram has printed anything to stdout if( $Qout->pending ) { # no clue my $output = $Qout->dequeue; # read STDOUT of .pl into + var ## YES. $lb->insert( 'end', $output ) ; # print STDOUT of .pl +in listbox ## YES. ## We've inserted the next item into the listbox, ## but this addition may have gone 'off the bottom' of th +e visible part of the listbox ## so ask the listbox to redraw itself to ensure that we +can 'see' the 'end' ## ie. the last item in the listbox. Ie. the one we just +added. $lb->see( 'end' ); # What's this? if( $output eq 'whatever' ) { # actual Tk code } } };
      • Now the invocation of that subroutine:
        $mw->repeat( 500, $doStdout ); # execute $doStdout once every 500 +millisec...? but why mw-> Tk::MainLoop(); #OK }

        We have the subroutine to process STDOUTput from the main script, but we need to call it. We cannot just call it, because then the GUI would freeze until it returned and nothing will be updated (or even drawn!), on the gui until we enter Tk::MainLoop;.

        So, we need to ask Tk to invoke $doStdout() on a regular basis, and we do that using the repeat timer mechanism.

        "Why $mw?" a) because that is the traditional place for it. b) because you may well decide to throw the listbox (and Entry widget) of my example away and replace them with a bunch other widgets (buttons/checkboxes and similar) for your purposes, but you will need to retain a MainWindow in which to show them, so that is the obvious place to hang the repeat timer off.

      Now to the "black magic" :)

      • Part one: Creating the queues and tying them:
        use Thread::Queue; ## A queue, that we tie to the main programs stdin. ## Anything our Tk code <c>$Qin->enqueues( ... )</c> (writes) to this + queue ## Will turn up in the main program when it reads from stdin (Eg. <c> +while( my $line = <STDIN> )</c> etc.) my $Qin = new Thread::Queue; ## And another queue that we tie to the main programs stdout. ## Anything the main program prints to stdout, we can access in our T +k code ## by reading (<c>my $line = $Qout->dequeue()</c>) from this queue my $Qout = new Thread::Queue; ## So, we've created the means for bidirectional communications betwe +en us and the main program ## And now we need to (transparently) persuade the main program to us +e them instead of the console. ## Which we do by [tie]ing the standard handles to our newly created +queues. tie *STDIN, 'MyGuiStdin', $Qin; tie *STDOUT, 'MyGuiStdout', $Qout; # everything up to this point is pure black magic

        Essentially -- but for the observing pedants, not necessarily, totally accurately -- tieing replaces the object being tied -- STDIN and STDOUT in this case -- with an object that lives in the identified package. And whenever an operation (subroutine or method) is performed using that tied variable, instead of the standard operation code in the perl runtime being called directly, perl calls methods that we write in the package the variable is tied to.

        Hence (parts 2 & 3 ) ...

      • After we've tied STDOUT to package MyGuiStdout,

        when the main program uses STDOUT either explicitly as in print STDOUT ...;, or implicitly with print ...; the PRINT() subroutine in that package gets called. So, whenever the main program prints to stdout, this subroutine gets called:

        sub PRINT { $_[0]->enqueue( join ' ', @_[ 1 .. $#_ ] ); }

        Similarly, when printf STDOUT ...;<c> & <c>printf ...; are used in the main program, the subroutine PRINTF() in the tying package gets called.

        And instead of appearing on the console, the 'output' gets written ($Qout->enqueue( ... )) to our 'output' queue.

        And then, sometime later but within 500 milliseconds, our $doStdout() subroutine will get called by the Tk repeat timer, and we can then do whatever we want with it.

      • And after we've tied STDIN, whenever the main program reads from STDIN, it will call the our READLINE() sub:
        package MyGuiStdin; our @ISA = qw[ Thread::Queue ]; sub TIEHANDLE { bless $_[1], $_[0]; } sub READLINE { $_[0]->dequeue(); }

        Which simply dequeues the next line from $Qin and gives it back to the main program, which is none the wiser that what it gets wasn't typed by the user at the console.

      By simply calling MyGUI::gui(), you've established bidirectional communications between the main program and your gui thread, without the main code needing to know any different.

      And there it is, the "black magic" explained (I hope:). Loosely, skipping over much detail, but I hope with sufficiently clarity to explain the basic mechanisms. For the details, consult the appropriate documentation.

      And if anything still alludes you, ask.

      I'll respond to the "utf problem" and "Tk/threads caution" in a separate reply once I've had a thunk and tried a few things out, but my basic response is that the problem is not a "Tk & threads" problem, but "Tk and Unicode" problem.

      (Actually I think it is more a "perl & Unicode" problem, but I'll spare you that diatribe.)


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

      The start of some sanity?

        I've been working on this project on and off based on BrowserUk's excellent advice since this thread was made, and now it's pretty much done.
        One issue I have is that when the GUI window is closed, the other thread keeps running. I've hidden the console window, so the only way to close it is via the task manager. Is there a way to automatically end the other process when the GUI window is closed or crashes?
      It turns out that if I have something like open(LOG, ">:encoding(UTF-8)", "$scriptpath/scripts/log.txt") or print "\nCan't create log file: $!\nContinuing anyway.\n"; before the .pm is loaded, it crashes. (It works if I remove ">:encoding(UTF-8)", but that's hardly ideal.)

      It appears that the unicode IO layers are not thread-safe. I cannot help you with that, you'll have to raise a bug report.

      The work around is to not open your logfile until after you've decided whether to invoke the GUI or not.

      If you find that too restricting, then open the logfile without the encoding layer before making the decision and binmode the io layer on afterward:

      #! perl -slw use strict; use threads; our $GUI //= 0; open LOG, ">", "$0.log" or print "Can't create log file: $!"; if( $GUI ) { require 'MyGui.pm'; async( \&MyGui::gui )->detach; } else { binmode STDIN, ':encoding(UTF-8)'; } binmode LOG, ':encoding(UTF-8)'; while( 1 ) { printf 'Enter three, 2-digit numbers: '; my $in = scalar <STDIN>; last if $in =~ '!bye'; print 'You entered: ', $in; printf 'Enter a date and time: '; $in = scalar <STDIN>; last if $in =~ '!bye'; print 'You entered: ', $in; }
      I also have binmode STDIN, ':encoding(UTF-8)'; at the start of the script, which also crashes the GUI (IIRC it was needed for non-ASCII input file names to work on linux).

      If you are using the gui, then you will not actually be using STDIN, as the input will come via Tk. So, only binmode stdin if you are not using the gui, as shown above.

      From what I can tell, the thread-hostility of the unicode IO layers is not a some subtle error involving race conditions or mismatched locking, but rather a complete absence of any attempt on behalf of the code to be thread-safe. Just plain, old-fashioned bad coding.


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

      The start of some sanity?

        Thanks for all the help. The project is coming along pretty nicely, although I'll need to work on error reporting in the GUI and stuff like that.
        I'm not sure which option to choose for launching the GUI, but both are workable and shouldn't be too difficult to implement.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (2)
As of 2014-11-29 08:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (204 votes), past polls