Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Re: Perl/Tk code structure

by BrowserUk (Patriarch)
on Jan 10, 2012 at 14:19 UTC ( [id://947171]=note: print w/replies, xml ) Need Help??


in reply to Perl/Tk code structure

Do I need to put all the "functional" parts of the script in subroutines in order to be able to trigger them with Tk GUI button presses and such?

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.

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.

Now you make the decision whether the enable the GUI at start up and if you do, and of your existing output to stdout goes via the queue tied to stdout and gets displayed in a listbox on the GUI. And any requests for input (Eg.my $var = <STDIN>; get fulfilled from the queue, having been source from an edit field on the gui and placed into the queue.

The main body of your code doesn't change at all. You just add:

use My::Gui; ... if( $opts{gui} ) { tie *STDOUT, 'My::Gui'; tie *STDIN, 'My::Gui'; async( \&My::Gui::gui )->detach; }

at the top of your 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?

Replies are listed 'Best First'.
Re^2: Perl/Tk code structure
by elef (Friar) on Jan 10, 2012 at 15:18 UTC
    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.
      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?

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

      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?
        Thanks, I will go through it and try to wrap my head around it.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (6)
As of 2024-03-19 02:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found