in reply to Re^2: Tk::ExecuteCommand - GUI not responding by executing longer running script
in thread Tk::ExecuteCommand - GUI not responding by executing longer running script

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
  • Comment on Re^3: Tk::ExecuteCommand - GUI not responding by executing longer running script

Replies are listed 'Best First'.
Re^4: Tk::ExecuteCommand - GUI not responding by executing longer running script
by dzon (Novice) on Feb 07, 2008 at 10:23 UTC
    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; } } }
      So after all I've got still a small problem here:
      When I insert the command output into the text window, it writes squares at the end of some lines (probalby instead of some non-printable end-of-line character)

      -> do you know how could I format the string to remove such non-printable characters?

      UPDATE:
      I solved it with a small character replace before I insert it in the ROText widget in the repeat loop:
      $buffer =~ s/\x0D\x0A/\n/g;

        Have you chomped the command output?

        You could also try something like:

        $output =~ s/\s*$/\n/;


        TGI says moo