#!/usr/bin/perl use warnings; use strict; use threads; use threads::shared; my $ret:shared = ''; my $go: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 $canvas = $mw->Scrolled('Canvas', -bg =>'white', -scrollregion=>[0,0,1000,1000] )->pack(-expand=>1,-fill=>'both'); my $text; my $button1 = $mw->Button( -text => 'Start', -command => sub{ $canvas->itemconfigure($text,-text=> ''); $canvas->update; $go = 1; }, )->pack(); my $button2 = $mw->Button( -text => 'Stop thread', -command => sub{ $die = 1; $thr->join; }, )->pack(); my $timer = $mw->repeat(10,sub{ if($ret ne ''){ $text = $canvas->createText(20,10, -anchor=>'nw', -fill => 'black', -text => $ret, ); $canvas->configure(-scrollregion => [$canvas->bbox('all')]); $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 { while(1){ if($die){return} if($go){ $ret = `ls -la`; # print "$ret\n"; $go = 0; } # print 1; select(undef,undef,undef,.1); } }