Re: Tk-with-worker-threads

[Anonymous Monk]

Thats great to know its possible. The author had asked if we need a simpler chopped of example.Can I request one .THat will be greatly useful to many of them.

[zentara]

Hi, here is about as simple an example as you can get. It uses a thread to watch a filehandle(like tail), push the results into a shared array, then display the results in a Tk::Text box. It dosn't get much simpler than this. Basically the shared array is a buffer between the thread and main Tk code. NOT thorougly tested for buffer problems.

#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;

# must setup thread code before any Tk code is used
# to avoid Tk thread-safety problems

my @logdata : shared;
my $thread_die : shared;
@logdata = ();
$thread_die = 0;

my $thread = threads->new( \&work );
############################################

use Tk;

my $mw = MainWindow->new(-background => 'gray50');

my $tframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'top' ,-fill=>'y');
my $bframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
                  ->pack(-side =>'bottom',-fill =>'both' );


my $text = $tframe->Scrolled("Text",
                   -scrollbars => 'ose',
                   -background => 'black',
                   -foreground => 'lightskyblue',
                   )->pack(-side =>'top', -anchor =>'n');

my $exit_button = $mw->Button(-text => 'Exit',
                    -command => sub{
                     $thread_die = 1; #kill thread
             $thread->join;
             exit;                          
            })->pack();


my $timer = $mw->repeat(1000, sub{
                lock( @logdata );  #locks within scope
                my @in = @logdata; #copy it 
        @logdata = ();  #clear out old log lines
            $text->insert('end', "@in");
        $text->see('end');
              });


MainLoop;

########################################
sub work{

   $|++;
   open(FH,"< z.log") or die "$!\n";

 while(1){
    while(<FH>){
         push @logdata, $_;
    if( $thread_die == 1 ){return} #kill thread
     }
  }

}
############################################