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";
    }
}

[download]
and I get 
C:\work\BulkFirmwareUpgrade\v1>perl fd.pl
Attempt to free non-existent shared string '_TK_RESULT_', Perl interpr
+eter: 0x2c
f271c at C:/Perl/site/lib/Tk.pm 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/Widget.pm line 98 during global destruction.
Free to wrong pool 2ceec98 not 225ba0 at C:/Perl/site/lib/Tk/Widget.pm
+ line 98 d
uring global destruction.

[download]
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 (Cardinal) 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";
}

    [download]
    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
[reply]
[d/l]
    A reply falls below the community's threshold of quality. You may see it by logging in.
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;
}

    [download]

    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.

    s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
[reply]
[d/l]
[select]
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
    .

    [download]
[reply]
[d/l]
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.

[reply]

      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.

[reply]

Back to Seekers of Perl Wisdom