Karkadan has asked for the wisdom of the Perl Monks concerning the following question:

Hi,

I have an (long running) application, for which I now want to build a simple GUI, enabling the script to be used even by less experienced users.

Below example demonstrates, what is not happening. I want to capture the output of the main function of the script (printer in the example below) into two separate ROText widgets.

I also want to keep the application "alive" while printer is working - the script below doesn't react on any Event.

Adding $mw->update() is not having the effect I want.

Any hint is appreciated. The script should work on Linux/Unix as well as with (strawberry) Perl on WinXP.

#!/usr/bin/perl use strict; use warnings; use Tk; require Tk::ROText; $|++; {# Main my $mw = MainWindow->new(); $mw->Label(-text => 'STDOUT')->pack(-side => 'top', -anchor => 'w' +); my $ro_out_text = $mw->Scrolled('ROText', -scrollbars => 'osoe', -background => 'white', -width => 50, -height => 15, )->pack(-side => 'top'); tie (*STDOUT, 'Tk::ROText', $ro_out_text); $mw->Label(-text => 'STDERR')->pack(-side => 'top', -anchor => 'w' +); my $ro_err_text = $mw->Scrolled('ROText', -scrollbars => 'osoe', -background => 'white', -width => 50, -height => 15, )->pack(-side => 'top'); tie (*STDERR, 'Tk::ROText', $ro_err_text); $mw->update(); $mw->after(10, [\&printer, $mw]); $mw->repeat(50, sub { $mw->update();}); MainLoop; } sub printer { my $mw = shift @_; my $errcount = 0; my $count = 0; while (1) { if (rand() % 2){ $count++; print "STDOUT: Count = $count\n"; } else { $errcount++; print {*STDERR} "STDERR: Count = $errcount\n"; } sleep (rand() % 500 + 500); } }

Thanks a lot in advance!

EDIT

Here is a working example:

#!/usr/bin/perl use strict; use warnings; use Carp; use IO::Pipe; {# Main if ((scalar @ARGV == 1) and ($ARGV[0] eq '--no-gui')) { printer(); } elsif ((scalar @ARGV >= 1) and ($ARGV[0] ne '--no-gui')) { print "USAGE: $0 [--no-gui]\n"; exit 1; } my $err_pipe = IO::Pipe->new() or croak "Could not create pipe: $! +"; my $out_pipe = IO::Pipe->new() or croak "Could not create pipe: $! +"; if (my $pid = fork ()) { # Child tk_init($err_pipe, $out_pipe); } else { # Father croak "Could not fork: $!" unless defined $pid; $err_pipe->writer(); $out_pipe->writer(); open STDERR, ">&" . $err_pipe->fileno() or croak "Could not re +direct: $!"; open STDOUT, ">&" . $out_pipe->fileno() or croak "Could not re +direct: $!"; printer(); } } sub tk_init { use Tk; use Tk::ROText; my $err_pipe = shift @_; my $out_pipe = shift @_; $err_pipe->reader(); $err_pipe->blocking(0); $out_pipe->reader(); $out_pipe->blocking(0); my $mw = MainWindow->new(); $mw->Label(-text => 'STDOUT')->pack(-side => 'top', -anchor => 'w' +); my $ro_out_text = $mw->Scrolled('ROText', -scrollbars => 'osoe', -background => 'white', -width => 50, -height => 15, )->pack(-side => 'top'); $mw->Label(-text => 'STDERR')->pack(-side => 'top', -anchor => 'w' +); my $ro_err_text = $mw->Scrolled('ROText', -scrollbars => 'osoe', -background => 'white', -width => 50, -height => 15, )->pack(-side => 'top'); $mw->repeat(250, [\&update_text_widget, $ro_out_text, $out_pipe]); $mw->repeat(250, [\&update_text_widget, $ro_err_text, $err_pipe]); $mw->update(); MainLoop(); } sub update_text_widget { my $widget = shift @_; my $handle = shift @_; # slurp data my @in = <$handle>; my $str = join('', @in); $widget->insert('end', $str); return; } sub printer { use Time::HiRes qw(usleep); my $errcount = 0; my $count = 0; while (1) { if (rand(2) % 2 == 1) { $count++; print "STDOUT: Count = $count\n"; } else { $errcount++; print {*STDERR} "STDERR: Count = $errcount\n"; } usleep (rand(500000) + 500000); } }

Replies are listed 'Best First'.
Re: Perl Tk: STDOUT and STDERR to ROText
by zentara (Cardinal) on Feb 15, 2012 at 19:28 UTC
    The while loop is blocking the eventloop. You have to use a thread or IPC of somesort to fork or thread your code. An alternative, would be to avoid the while(1) loop and sleep with a repeater. See the simple example below.

    If you wanted a random timer interval, you would have to run each timer onetime only, spawning another timer as it's last action.

    #!/usr/bin/perl use warnings; use strict; use Tk; my $mw = MainWindow->new(); $mw->fontCreate('big', -size => 16 ); my $tx = $mw->Text(-bg=> 'white', -font=>'big', -width => 25)->pack(); tie *STDOUT, 'Tk::Text', $tx; $mw->repeat(1000, \&tick); MainLoop; my $count; sub tick { ++$count; print "$count\n"; }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

      Hi Zentara,

      Thanks for your suggestion. Using timer functions like repeat is not working for me. As I said, printer is just a placeholder for another long running task (extracting a very big file).

      I posted a working example using pipes and fork in my reply above. I have not yet tested, if this will run under Windows as well. This will have to wait until tomorrow.

      BR from Germany,

      Karkadan

Re: Perl Tk: STDOUT and STDERR to ROText
by Anonymous Monk on Feb 15, 2012 at 18:54 UTC

      I feared that.

      So the other script in script solution would be using threads. I will try that.

      Thanks a lot.