in reply to Re^3: Tk::ExecuteCommand - GUI not responding by executing longer running script
in thread Tk::ExecuteCommand - GUI not responding by executing longer running script
#!/usr/bin/perl use threads; use threads::shared; require Thread::Queue; $Q = new Thread::Queue; share $Script; share $Terminate; share $start_work; $Terminate =0; $start_work = 0; threads->new(\&worker)->detach; use Tk; require Tk::ROText; $top = MainWindow->new; $text = $top->Scrolled('ROText'); $text->pack(qw/-expand 1 -fill both/); $b_startdir = $top->Button( -text => "Start command", -width => 12, -command => sub { $Script = "ping example.org"; $start_work = 1; } )->pack( -side => 'right' ); my $repeat; $repeat = $top->repeat( 300 => sub { eval { while ($Q->pending) { my $buffer = $Q->dequeue; return unless $buffer; $text->insert('end', $buffer); $text->see('end'); } }; if ($@) { warn "$@"; $repeat->cancel; } } ); MainLoop; $Terminate = 1; sub worker { while(!$Terminate){ if ($Script && $start_work) { open PROC, "$Script 2>&1 |" or die "ERR: unable to start $Script +\n"; while (sysread(PROC, my $buffer, 1024) > 0) { $Q->enqueue($buffer); if (!$start_work) {last;} } close PROC; $Script = undef; $start_work = 0; } else { sleep 1; } } }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^5: Tk::ExecuteCommand - GUI not responding by executing longer running script
by dzon (Novice) on Feb 13, 2008 at 14:22 UTC | |
by TGI (Parson) on Feb 13, 2008 at 20:10 UTC |