http://www.perlmonks.org?node_id=947177


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

Whilst you could do it that way, as you point out, it means making extensive modifications to (presumably) already working code. It also means letting your tool (Tk) dictate the architecture of your application which is never a good thing. Especially as it would make turning the gui off for those gui-phobic *nix users very difficult.

Yes, the code is already working, with a thousand or so users. Indeed, I'm not too keen on the idea of rearranging the whole script into what seems to be a contorted structure to me just to accommodate Tk, hence this thread. Keeping the GUI on/off option probably wouldn't be too difficult, though. I guess I'd have something like
if ($gui) { require Tk;import Tk; # GUI stuff calling subs that do the actual operations MainLoop; } else { # text prompts leading to calling the same subs as above } # SUBS


IMO the best alternative would be to stick your TK GUI into its own thread with a queue and tie that queue to stdin & stdout.

I understand the concept, but I have no idea how I would go about doing it. How complex would this job be? Much as I hate the idea of reshuffling the main script, it seems like the simpler option at this point - at least I have a pretty good idea of what it would involve. I guess I should note that I only code as a hobby, so there's a lot about perl that I don't know, and a fair bit that I'll never know. Can you describe the idea in a bit more detail and point me towards some code samples/relevant documentation pages? That'd help me decide whether it's feasible with my (lack of) skills.

Replies are listed 'Best First'.
Re^3: Perl/Tk code structure
by BrowserUk (Patriarch) on Jan 10, 2012 at 16:15 UTC
    How complex would this job be?

    Not complex at all.

    Here is a silly script that when run with no options just gets lines from the keyboard and echos them back to the screen until the use enters '!bye':

    #! perl -slw use strict; use threads; our $GUI //= 0; if( $GUI ) { require 'MyGui.pm'; async( \&MyGui::gui )->detach; } while( 1 ) { my $in = <STDIN>; exit if $in =~ '!bye'; print $in; } __END__ C:\test>MyGui-t hello hello goodbye goodbye !bye

    But if you add the option to the command line C:\test>MyGui-t -GUI, it fetches lines from a Tk gui and echos the results to that gui instead.

    The MyGui.pm module looks like this:

    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( $_[1] ); } 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; 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->repeat( 100, sub { $lb->insert( 'end', $Qout->dequeue ) while $Qout->pending; $lb->see( 'end' ); } ); $mw->bind( '<Return>', $enter ); $ef->focus( -force ); Tk::MainLoop(); } 1;

    And that's it. Add three lines to the top of your existing program and put the module somewhere it will be found and you are done.

    This is what the gui looks like doing the exact same entry sequence as shown for the non-gui session above just before hitting enter to quit the program.


    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?

Re^3: Perl/Tk code structure
by BrowserUk (Patriarch) on Jan 10, 2012 at 21:37 UTC

    BTW. Remember that with the gui I posted, you could (for example) check for what was printed and instead of simply displaying it in the listbox, decide to convert a text prompt into a bunch of buttons or a dialog that allows the user to answer the prompt without having to type complex material, and then send the information back to the <STDIN> requests as if he had typed it out in full.

    The gui I posted is just the simplest working example I could come up with.


    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.
      However, I'm afraid that your definition of "complex" differs quite a bit from mine. Most of the code of the module went right over my head. Even if I ignore everything outside of sub gui {...} on the assumption that I don't need to know anything about how the STDIN/STDOUT redirection chicanery works, most of the code inside the sub is also Greek to me. I get the three Tk widgets and have a vague idea about what the rest does, but no clue how.
      I'm afraid that the recipe for setting up a radiobutton widget based on what the original script prints to STDOUT and passing the selection to its STDIN would begin with "spend a week reading a couple of hundred pages of impossible to find, indecipherable documentation and writing/debugging test scripts" and may end with "give up".

        Hm. Is that a request for further explanation or a dismissal of the idea as too much complex "chicanary"?


        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?

Re^3: Perl/Tk code structure
by BrowserUk (Patriarch) on Jan 11, 2012 at 12:12 UTC

    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?

      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?

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