Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked

Perl Tk and Threads

by Anonymous Monk
on Dec 23, 2008 at 14:14 UTC ( #732294=perlquestion: print w/replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi, Is there a way to get around the problem with Perl Tk and Threads? I have
#!/usr/local/bin/perl -w use Tk; use threads; use strict; my $mw = MainWindow->new(); my $text = $mw->Entry(-width =>8)->pack(); $text->insert(0,'abcde'); my $button = $mw->Button(-text=>'click', -command => \&test_thread)->p +ack(); MainLoop; sub test_thread{ my $long_thread = threads->create('long_running_sub'); $long_thread->detach(); } sub long_running_sub{ for my $i (0..2){ sleep 30; print $text->get() . "-$i\n"; } }
and I get
C:\work\BulkFirmwareUpgrade\v1>perl Attempt to free non-existent shared string '_TK_RESULT_', Perl interpr +eter: 0x2c f271c at C:/Perl/site/lib/ line 250. abcde-0 abcde-1 abcde-2 Attempt to free non-existent shared string '.entry', Perl interpreter: + 0x2cf271c at C:/Perl/site/lib/Tk/ line 98 during global destruction. Free to wrong pool 2ceec98 not 225ba0 at C:/Perl/site/lib/Tk/ + line 98 d uring global destruction.
I want to use a new thread since otherwise the GUI become unresponsive whilst the sub runs (could be ~48 hours). Any other ways around this? Would fork/exec be an option?

Replies are listed 'Best First'.
Re: Perl Tk and Threads
by zentara (Archbishop) on Dec 23, 2008 at 16:35 UTC
    Tk is not thread safe, but you can use threads with it with precautions.

    1. The thread must be created before any Tk widgets are invoked. You violate that rule by creating the thread in a button callback.

    2. Do not put any Tk code into the thread, and do not try to access Tk widgets from the thread. Use shared variables to communicate with the main thread, and have a timer or fileevent in the main Tk thread, read from the thread.

    Here is a very simple example (limited error checking)

    #!/usr/bin/perl use warnings; use strict; use threads; use threads::shared; my $ret:shared = 0; my $die:shared = 0;; my $val = 0; #create thread before any tk code is called my $thr = threads->create( \&worker ); use Tk; my $mw = MainWindow->new(); $mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit }); my $label = $mw->Label( -width => 50, -textvariable => \$val )->pack(); my $button; $button = $mw->Button( -text => 'Stop thread', -command => sub{ $button->configure(-state=>'disabled'); $die = 1; $thr->join; }, )->pack(); my $timer = $mw->repeat(10,sub{ $val = $ret; }); MainLoop; sub clean_exit{ $timer->cancel; my @running_threads = threads->list; if (scalar(@running_threads) < 1){print "\nFinished\n";exit} else{ $die = 1; $thr->join; exit; } } # no Tk code in thread sub worker { for(1..10){ print "$_\n"; $ret = $_; if($die){return} sleep 1; } $ret = 'thread done, ready to join'; print "$ret\n"; }
    If you want to launch threads from GUI callbacks, you may have better luck with Perl/Gtk2; but even with it's thread-safety mechanism, it is still more foolproof to make your thread before any Gtk2 widgets are invoked.

    I'm not really a human, but I play one on earth Remember How Lucky You Are
      Hello! I want to ask you a question.It's for you maybe easy.But ,As I'm a new learner of perl,it's too difficult.I'm writing a code ,which can read serialport message to a GUI window builded by Tk in Linux.While,I can't let the serialport message report in the Tk window,but in the Linux commond box. so,how can I modify it ,so that it can report in the Tk window. this is my code #!/usr/bin/perl -w # black magic taken from examples that came with the distribution BEGIN { $| = 1; print "varianlog loaded "; } END {print "not ok 1\n" unless $loaded;} use Device::SerialPort; use Tk; $loaded = 1; print "ok 1\n"; # end of black magic use strict; my $file = "/dev/ttyS0"; my $out; my $gotit; my $ob = Device::SerialPort->new($file) || die("Can't open $file: $!\n"); $ob->baudrate(9600) || die("can't set baudrate\n"); $ob->parity("none") || die("can't set parity\n"); $ob->databits(8) || die("can't set databits\n"); $ob->stopbits(1) || die("can't set stopbits\n"); $ob->handshake("none") || die("can't set handshake\n"); $ob->write_settings || die("settings failed\n"); $ob->are_match("\r"); $ob->lookclear; $out="hello word!" x 5; $ob->write($out) || die("writing to serial port failed: $!\n"); $ob->write_drain; $ob->error_msg(1); $ob->user_msg(1); my $mw=MainWindow->new; $mw->geometry("300x260"); $mw->title("GPS message"); my $scroll_text = $mw->Scrollbar(); my $test=$mw->Text( -yscrollcommand => 'set', $scroll_text, -background => 'black', -foreground => 'red' ) ; $test->insert('end',$gotit); $test->see('end'); $scroll_text->configure(-command => 'yview', $test); $scroll_text->pack(-side=>"right", -expand => "no", -fill => "y" ) ; $test->pack(-side => "left", -anchor => "w", -expand => "yes", -fill => "both" ) ; # $thr->detach(); $mw->MainLoop; while (1) { $gotit = $ob->read("10240"); print "$gotit"; #sleep 1; } #print("we have read: $gotit\r\n"); $ob->close || die("failed to close: $!\n"); undef $ob; }
        Wrap your code in "code" tags so I can read/download it, and I will see. ( Heh, heh, fellow Perlmonks.....refuse to answer a question unless it is properly asked... it promotes netiquette. :-)

        I'm not really a human, but I play one on earth My Petition to the Great Cosmic Conciousness

        Welcome to Perl Monks!

        I realize you are new to Perl and Perl Monks: here are some threads on formatting that might help you make your post more readable. People really do want to help - but not if they have to turn their eyes upside down to understand what you have posted.

        • Re: Formatting Tips - Formatting for people who don't want to learn HTML - only two tags that will make all the difference
        • Markup in the Monastery - Everything you ever wanted to know about monastery mark-up and more

        Best, beth

Re: Perl Tk and Threads
by liverpole (Monsignor) on Dec 23, 2008 at 16:31 UTC
    You can't do threads from within Tk.

    However, you could spawn one or more threads outside of Tk, and then use Tk only within one of those threads.

    Here's a simplistic example, based on your code, where the "parent" thread runs perl/Tk, and the "worker" thread sends messages back to the parent:

    #!/usr/local/bin/perl -w use Tk; use threads; use threads::shared; ############# ## Globals ## ############# my $shared_text: shared = ""; # The message sent back to the +parent my $shared_flag: shared = 0; # 0 = no msg waiting, 1 = msg wa +iting ################## ## Main program ## ################## my $pthread = threads->new(\&worker_thread); $pthread->detach(); my $mw = MainWindow->new(); my $text = $mw->Entry(-width => 8)->pack(); $text->insert(0, 'abcde'); my $button = $mw->Button(-text=>'click', -command => \&talk_to_worker) +->pack(); MainLoop; ################# ## Subroutines ## ################# # Parent subroutines sub talk_to_worker{ while (0 == $shared_flag) { print "(parent) Waiting for flag to go to 1\n"; select(undef, undef, undef, 0.5); } my $msg = $shared_text; print "(parent) Got message '$msg'\n"; if ($msg) { $text->delete('0.0', "end"); $text->insert('0.0', $msg); $mw->update(); } print "(parent) Resetting flag to 0\n"; $shared_flag = 0; } # Worker subroutines sub worker_thread { for my $i (0..100) { sleep 3; send_message_to_parent("-$i"); } } sub send_message_to_parent { my ($msg) = @_; # Wait until the $shared_flag is zero again while (1 == $shared_flag) { print "(worker) Waiting for flag to go to 0\n"; select(undef, undef, undef, 0.5); } # Send the message; $shared_text = $msg; # Raise the flag to handshake with the parent $shared_flag = 1; }

    Note the use of threads::shared, which lets you pass messages between threads.  Also, the use of a flag $shared_flag, which is set by the child thread (the "worker" thread) to indicate that it has sent a message in $shared_text, and then reset to zero by the parent thread to indicate that the message has been received.

Re: Perl Tk and Threads
by Anonymous Monk on Dec 23, 2008 at 15:33 UTC
    To add to the above it's Active Perl 5.10 on Windows XP.
    C:\perl -V Summary of my perl5 (revision 5 version 10 subversion 0) configuration +: Platform: osname=MSWin32, osvers=5.00, archname=MSWin32-x86-multi-thread uname='' config_args='undef' hint=recommended, useposix=true, d_sigaction=undef useithreads=define, usemultiplicity=define useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=und +ef use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cl', ccflags ='-nologo -GF -W3 -MD -Zi -DNDEBUG -O1 -DWIN32 -D +_CONSOLE - DNO_STRICT -DHAVE_DES_FCRYPT -DUSE_SITECUSTOMIZE -DPRIVLIB_LAST_IN_INC + -DPERL_IM PLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX' +, optimize='-MD -Zi -DNDEBUG -O1', cppflags='-DWIN32' ccversion='12.00.8804', gccversion='', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64 +', lseeksi ze=8 alignbytes=8, prototype=define Linker and Libraries: ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf -l +ibpath:"C: \Perl\lib\CORE" -machine:x86' libpth=\lib libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib + comdlg32 .lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uui +d.lib ws2_ 32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.l +ib perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool +.lib comd lg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib + uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvc +rt.lib libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl510.lib gnulibc_version='' Dynamic Linking: dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt: +ref,icf - libpath:"C:\Perl\lib\CORE" -machine:x86' Characteristics of this binary (from libperl): Compile-time options: MULTIPLICITY PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT PERL_IMPLICIT_SYS PERL_MALLOC_WRAP PL_OP_SLAB_ALLOC USE_ITHREADS USE_LARGE_FILES USE_PERLIO USE_SITECUSTOMIZE Locally applied patches: ActivePerl Build 1002 [283697] 32809 Load 'loadable object' with non-default file extension 32728 64-bit fix for Time::Local Built under MSWin32 Compiled at Jan 10 2008 11:00:53 @INC: C:/Perl/site/lib C:/Perl/lib .
Re: Perl Tk and Threads
by Anonymous Monk on Aug 21, 2012 at 11:30 UTC

    Darn... I was hoping to use threads to create a splash screen while a rather complex GUI was being constructed at the start of a perl script. (It's not really the GUI that takes a long time to construct, it's the harvesting of data to populate it).

    My current solution was to fork off a child process to display the splash and then send a kill 9 (KILL) to it when the main GUI was ready.

    Guess I'll stick with this rather kludgy/brute force method.

      You're using threads! But they're heavy-weight threads (vs. the light-weight threads previously discussed). It might be heavy-handed, but it's not brutal. And it gets the job done!

      As wikipedia says, "a thread is a lightweight process." The flip side is that a process is a heavyweight thread. In your case, since you spawn (fork) the thread, it runs independently of the parent thread, and then exits, you probably wouldn't see much difference in performance, especially if you fork before the parent process has gotten fat.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://732294]
Approved by ww
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (5)
As of 2018-03-17 14:07 GMT
Find Nodes?
    Voting Booth?
    When I think of a mole I think of:

    Results (224 votes). Check out past polls.