Beefy Boxes and Bandwidth Generously Provided by pair Networks Joe
Don't ask to ask, just ask

Re^5: Perl/Tk code structure

by BrowserUk (Pope)
on Jan 17, 2012 at 23:23 UTC ( #948439=note: print w/ replies, xml ) Need Help??

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

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?

Comment on Re^5: Perl/Tk code structure
Select or Download Code
Re^6: Perl/Tk code structure
by elef (Friar) on Apr 06, 2012 at 10:16 UTC
    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?
      You might try something like this untested code. Also see controlling threads with Tk: while loop vs. signals
      # catch window close button to clean up threads $mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); sub clean_exit{ my @running_threads = threads->list; if (scalar(@running_threads) < 1){print "\nFinished\n";exit} else{ # $die = 1; # a shared var I usually use # to tell threads to return foreach my $thr (@running_threads){ $thr->join; } exit; } }

      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh

      The simplest mechanism is to just add exit after the MainLoop(). When you exit the gui, MailLoop() returns and the program terminates with cleanup:

      sub gui { require Tk; my $mw = Tk::MainWindow->new; ... Tk::MainLoop(); exit( 0 ); ### Add this }

      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?

        That is indeed simple. Thank you!

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (6)
As of 2014-04-19 10:31 GMT
Find Nodes?
    Voting Booth?

    April first is:

    Results (480 votes), past polls