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?
# GUI for _LF_aligner_2012_01_16.pl
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;
# everything up to this point is pure black magic
sub gui {
require Tk; #OK
require Tk::DialogBox; #OK
my $mw = Tk::MainWindow->new; #OK
my $lb = $mw->Listbox( -width => 80, -height => 24 )->pack;
my $ef = $mw->Entry( -width => 70, -takefocus => 1 )->pack( -side
+=> 'left' ); #OK
my $enter = sub { # I guess this is to avoid the "will not stay
+ shared" error due to nested subs
$Qin->enqueue( $ef->get ); # pass the entry field's content to
+ the STDIN of the .pl
$ef->delete(0, 'end' ); # delete all the text from the entr
+y field
1; # what does this do?
};
my $do = $mw->Button( -text => 'go', -command => $enter)->pack( -a
+fter => $ef ); #OK
$mw->bind( '<Return>', $enter ); #Ok
$ef->focus( -force ); #OK
my $doStdout = sub {
if( $Qout->pending ) { # no clue
my $output = $Qout->dequeue; # read STDOUT of .pl into
+var
$lb->insert( 'end', $output ) ; # print STDOUT of .pl i
+n listbox
$lb->see( 'end' ); # What's this?
if( $output eq 'whatever' ) {
# actual Tk code
}
}
};
$mw->repeat( 500, $doStdout ); # execute $doStdout once every 500
+millisec...? but why mw->
Tk::MainLoop(); #OK
}
1;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.