in reply to Tk::ExecuteCommand - GUI not responding by executing longer running script

I think the problem is that Tk::ExecuteCommand uses a tk fileevent to watch the pipe that feedbacks from the command. Tk::fillevent on windows, only works on sockets, it will mess up on pipes.

So your options are either to switch to the IPC::Run module, or use threads.

Since windows use threads anyways, you may as well go with threads. Threads and Tk can work very well together with some precautions. See Tk-with-worker-threads for a starting point. The main precautions are to create your threads first, before any Tk code is called. Keep Tk code only in the main thread. Use shared variables to communicate between threads.


I'm not really a human, but I play one on earth. Cogito ergo sum a bum
  • Comment on Re: Tk::ExecuteCommand - GUI not responding by executing longer running script

Replies are listed 'Best First'.
Re^2: Tk::ExecuteCommand - GUI not responding by executing longer running script
by dzon (Novice) on Feb 05, 2008 at 15:57 UTC
    for my application would be really better, if I could just change the Tk::ExecuteCommand and not use threads

    I think the change is needed somewhere in these 2 functions in Tk::ExecuteCommand (http://search.cpan.org/src/LUSOL/tkjuke-1.0.6/Tk/ExecuteCommand.pm):
    sub _read_stdout { # Called when input is available for the output window. Also chec +ks # to see if the user has clicked Cancel. my($self) = @_; if ($self->{-finish}) { $self->kill_command; } else { my $h = $self->{-handle}; if ( sysread $h, $_, 4096 ) { my $t = $self->Subwidget('text'); $t->insert('end', $_); $t->yview('end'); } else { $self->{-finish} = 1; } } } # end _read_stdout sub execute_command { # Execute the command and capture stdout/stderr. my($self) = @_; my $h = IO::Handle->new; die "IO::Handle->new failed." unless defined $h; $self->{-handle} = $h; $self->{-pid} = open $h, $self->{-command} . ' 2>&1 |'; if (not defined $self->{-pid}) { $self->Subwidget('text')->insert('end', "'" . $self->{-command} . "' : $!\n"); $self->kill_command; return; } $h->autoflush(1); $self->fileevent($h, 'readable' => [\&_read_stdout, $self]); my $doit = $self->Subwidget('doit'); $doit->configure( -text => 'Cancel', -relief => 'raised', -state => 'normal', -command => [\&kill_command, $self], ); my $doit_bg = ($doit->configure(-background))[3]; $self->_flash_doit(-background => $doit_bg, qw/cyan 500/); $self->waitVariable(\$self->{-finish}); } # end execute_command
    ... is it actually possible to solve my problem so easily - just with changing this module (replace somehow the fileevent, which could be the problem)?
      Hi, see Perl/Tk App and Interprocess Communication for how someone else solved it on win32. You can "roll-your-own" Tk::ExecuteCommand by just popping a text widget in a toplevel windoow, and feed results into from a thread. You will need a timer to constantly pull (read the pipe) instead of a fileevent. You setup the timer to run very fast, like 5 ms, and in the callback, read the pipe. Using the Win32::Pipe module may also help. You can use the timer to read a shared variable from a thread, as an alternative using threads.

      I'm not really a human, but I play one on earth. Cogito ergo sum a bum
        Thank you for your help!

        finally I solved it with threads:
        #!/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; } } }