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

I have a program that when a button is pushed, runs a processing function that prints status information using STDOUT. The button has a callback that creates a new toplevel window containing a ROText object that I would like to show text as it is received from the dispatched process. This process can take up to 15 minutes to execute, so having this window update as output is received is vital. I did something like this: 
open(IN, "program.pl |");
while(<IN>){
    $rotObj->insert('end', $_);   #this doesn't seem to work
    print STDERR "test";  #prints to my terminal window in real time
}
close(IN);

[download]
It appears that the insert only works once the called process has finished. I tried using the update() method on both my ROText object and the toplevel window it belongs to, but neither seemed to correct the problem.
  • Comment on Trying to update a Tk:ROText widget as input is received from a backticked program
  • Download Code

Replies are listed 'Best First'.
Re: Trying to update a Tk:ROText widget as input is received from a backticked program
by pg (Canon) on Nov 12, 2004 at 02:45 UTC

    Hope this helps. It worked for me with AS Perl 5.8.4 and Windows XP.

    use Tk;
use Tk::ROText;
use threads;
use Thread::Queue;

use strict;
use warnings;

my $mw = MainWindow->new();
my $t = $mw->Scrolled('ROText', -width => 40, -height=>20, -scrollbars
+=>"e")->pack();
my $b = $mw->Button(-command => sub {threads->create(\&cook)}, -text=>
+"Click")->pack();
my $q = Thread::Queue->new();

$t->after(1000, \&eat);
MainLoop;


sub eat {
    while (my $l = $q->dequeue_nb()) {
        $t->insert('end', $l); 
        $t->update();
    }
    $t->after(1, \&eat);
}

sub cook {
    print "thread created\n";
    my ($in, $out);
    open($in, "e.pl |");
    while (<$in>) {
        print "got $_"; 
        $q->enqueue($_);
    } 
    close($in);
}

    [download]

    Here is the other process I used:

    use strict;
use warnings;

for (1..10000000) {
    print $_, "\r\n";

}

    [download]
[reply]
[d/l]
[select]
Re: Trying to update a Tk:ROText widget as input is received from a backticked program
by leriksen (Curate) on Nov 12, 2004 at 02:23 UTC
    According to How to display lines to tk text box in real time the update should work. Here's the counter generator from that link 
    use strict;
use Tk;
use Tk::ROText;

my $main = MainWindow->new;
my $b = $main->Button(-text => 'count', -command => \&count )->pack;
my $t = $main->ROText(width => 80, height => 10) ->pack();
MainLoop;
sub count {
   my $i = 0;
   my $count;
   while ($i<20) {
     $t->insert("end", "Line $i\n");
     $t->update();
     sleep 1;
     $i++;
   }
}

    [download]
    Works on my "This is perl, v5.8.0 built for i386-linux-thread-multi" and "Red Hat Linux release 9 (Shrike)"

    Not sure if a process would change that - cant see why, your in the loop with a new value for $_, so should just work. I'll try here to with something like 'cat $0' so I place my own code in the tk window - ok, done - worked fine. Can you give anymore info ? Does the process return any blank lines - they could be hard to see :P

    use brain;

[reply]
[d/l]
      The main difference is $t->update() in this prog. RULE: After insert call update for realtime.
[reply]
[d/l]
Re: Trying to update a Tk:ROText widget as input is received from a backticked program
by zentara (Cardinal) on Nov 12, 2004 at 14:51 UTC
    You really should use fileevent to read any sort of filehandle with Tk. Here is an example to demonstrate. I used IPC3 instead of a piped open because it is just eaiser to deal with the separate STDOUT and STDERR from the pipe. If you want to use the piped open form, you may want to look into the 2>&1 bash shell trick to combine your stdout and stderr. IPC3 makes it easier to keep them separate. Also in this example, there is some additional error checking you need to do, like preventing the program from crashing if you kill the toplevel. I left that out for simplicity.

    Here is the sender script for testing (also leftout ROText, but that is easy): 

    #!/usr/bin/perl
use warnings;
use strict;
$| = 1;
my $count = 0;
while(1){
 $count++;
 print "$count\n";
 warn "\tuh oh warning $count\n";
 sleep 1;
}

    [download]

    And here is the IPC3-Tk example. 

    #!/usr/bin/perl
use warnings;
use strict;
use IPC::Open3;
use Tk;

my $mw = new MainWindow;
$mw->geometry("600x400");

$mw->Button(-text => "See STDERR", -command => \&do_Toplevel)->pack();

my $tout = $mw->Scrolled(
    'Text',
    -foreground => 'white',
    -background => 'black',
    -width  => 80,
    -height => 20,
                 )->pack;

my $top =  $mw->Toplevel();
$top->withdraw;

my $terr = $top->Scrolled(
    'Text',
    -foreground => 'hotpink',
    -background => 'black',
    -width  => 80,
    -height => 20,
)->pack;

my $pid = open3( 0, \*OUT, \*ERR, "$0-sender" );
#the 0 is for ignoring \*IN  (STDIN) 
$mw->fileevent( \*OUT, 'readable', \&write_out );
$mw->fileevent( \*ERR, 'readable', \&write_err );

MainLoop;
##################################################### 
sub do_Toplevel {
  if (! Exists($top)) {
  $top = $mw->Toplevel(  );
  $top->title("T-ERR");
  $top->Button(-text => "Close",
          -command => sub { $top->withdraw })->pack;
        } else {
           $top->deiconify(  );
           $top->raise(  );
          }
 }
############################################################# 
sub write_out {
    my $str = <OUT>;
    $tout->insert( "1.0", $str );
    $tout->see("1.0");
}
#################################################### 
sub write_err {
    my $str = <ERR>;
    $terr->insert( "1.0", $str );
    $terr->see("1.0");
}
__END__

    [download]
    I'm not really a human, but I play one on earth. flash japh
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom