#!perl -slw use strict; use threads; use threads::shared; use Thread::Queue; ## A shared var to communicate progess between work thread and TK my $Q = new Thread::Queue; my $pid:shared; sub work{ $pid = open PROC, 'perl -le"$|=1; print and select(undef,undef,undef,0.1) for 1 .. 1 +000" |' or die $!; while( <PROC> ) { $Q->enqueue( $_ ); } close PROC; } threads->new( \&work )->detach; use Tk; use Tk::ProgressBar; my $mw = MainWindow->new; my $pb = $mw->ProgressBar()->pack(); my $repeat; $repeat = $mw->repeat( 100 => sub { while( $Q->pending ) { my $progress = $Q->dequeue; return unless $progress; $repeat->cancel if $progress == 100; $pb->value( $progress ) } } ); $mw->Button( '-text' => 'Cancel', '-command' => sub {$mw->destroy})->pack(); $mw->MainLoop;
In reply to Re: Tk and IPC - killing of process not working in Linux
by Khen1950fx
in thread Tk and IPC - killing of process not working in Linux
by Dirk80
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |