in reply to Tk + threads

Play with this. Example usage at the __END__. You'll need a separate Thread::Queue for each thread. 

#! perl -slw
use strict;
use threads;
use Thread::Queue;
use IO::Pipe;

sub runNGather {
    my( $Q, $cmd ) = @_;
    my $pipe = IO::Pipe->new();
    $pipe->reader( "$cmd 2>&1" );
    $Q->enqueue( $_ ) while <$pipe>;
    $Q->enqueue( undef );
    return;
}

my $Q = new Thread::Queue;

threads->create( \&runNGather, $Q, $ARGV[0] )->detach;

require Tk;
require Tk::ROText;

my $top = MainWindow->new; #$mw-> Toplevel();
my $label = $top -> Label(
    -text=>"STDOUT from script", -relief=>"groove"
)->pack();

my $ro = $top->Scrolled(
    'ROText', -width => 60, -height=>20, -scrollbars=>"e"
)->pack();

# continuously display output
while( $_ = $Q->dequeue ) {
    $ro->insert("end", "$_");
    $ro->update();
    sleep 1;
}

# add close button
my $close = $top->Button(
    -text=>"Close window",
    -command=>sub { destroy $top; }
)->pack();

__END__
P:\test>522177 "ping www.perlmonks.org"

[download]
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

Replies are listed 'Best First'.
Re^2: Tk + threads
by knirirr (Scribe) on Jan 10, 2006 at 16:26 UTC
    Thanks. When running this, I get the same effect (blanked windows) unless I remove the sleep command whilst dequeueing. If so, then ping's output is frequent enough for the window to be updated.
[reply]

      I just knocked up something to demonstrate the technique, I didn't do any debugging. For your purposes you need to handle multiple queues simultaneously, so you would need to use dequeue_nb() (non-blocking) in the while loop. You also need to coordinate the queues with their associated windows, so the logic required is slightly more complex.

      This version, equally minimally tested, will run multiple concurrent commands as shown at the __END__. I've used Win32::Sleep to allow the updates to happen quickly whilst not running away with the cpu. You could use select, or Time::HiRes or yield() (though the latter tends to thrash the cpu!). 

      #! perl -slw
use strict;
use threads;
use Thread::Queue;
use IO::Pipe;

sub runNGather {
    my( $Q, $cmd ) = @_;
    my $pipe = IO::Pipe->new();
    $pipe->reader( "$cmd 2>&1" );
    $Q->enqueue( $_ ) while <$pipe>;
    $Q->enqueue( '!!!EOF!!!' );
    return;
}

my @Qs;
for( @ARGV ) {
    push @Qs, [ new Thread::Queue ];
    threads->create( \&runNGather, $Qs[-1][0], $_ )->detach;
}

require Tk;
require Tk::ROText;

my $mw = MainWindow->new;
for my $Q ( @Qs ) {
    my $top = $mw->Toplevel();

    my $label = $top -> Label(
        -text=>"STDOUT from script", -relief=>"groove"
    )->pack();

    my $ro = $top->Scrolled(
        'ROText', -width => 60, -height=>20, -scrollbars=>"e"
    )->pack();

    # add close button
    my $close = $top->Button(
        -text => "Close window",
        -command => sub{ destroy $top; }
    )->pack();

    push @{ $Q }, $ro;
}


# continuously display output
while( 1 ) {
    last unless @Qs;
    for my $n ( 0 .. $#Qs ) {
        my $text = $Qs[ $n ][0]->dequeue_nb;
        next unless defined $text;
        if( $text =~ m[^!!!EOF!!!$] ) {
            my $Q = splice( @Qs, $n, 1 );
            undef $Q->[0];
            last;
        }
        my $ro = $Qs[ $n ][1];
        $ro->insert("end", "$text");
        $ro->update();
    }
    $mw->update;
    Win32::Sleep .1;
}

$mw->MainLoop;

__END__
P:\test>522177 "ping www.perlmonks.org" "ping www.bbc.co.uk" "dir /s \
+*.pl"

      [download]
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]

        Thanks again! I'll take a look at that. Meanwhile, further work with your original suggestion has produced something like this (not complete): 

        my $Q = new Thread::Queue;
my $mw = MainWindow->new();

my $run_button = $mw -> Button(-text => "Run Programs",
-command=> sub { threads->create(\&runprogs, $Q)->detach(); &view_out;
+ });

sub runprogs
{
  # run the main script 
  my $pipe = IO::Pipe->new();
  $pipe->reader("$script $args 2>&1");
  $Q->enqueue( $_ ) while <$pipe>;
  $Q->enqueue ( undef );
  sleep;
}

sub view_out
{
  # create display window
  my $top = $mw-> Toplevel();
  my $label = $top -> Label(-text=>"Script output",-relief=>"groove")-
+>pack();
  my $ro = $top->Scrolled('ROText', -width => 60, -height=>20, -scroll
+bars=>"e")->pack();
  # continuously display output
  while (my $thingy = $Q->dequeue_nb())
  {
    last unless (defined $thingy);
    $ro->insert("end", "$thingy");
    $ro->update();
    sleep 1;
  }
  # add close button
  my $close = $top -> Button(-text=>"Close window", -command => sub { 
+destroy $top; })->pack();
}

        [download]

        This works, but if I omit the "sleep" from &runprogs, or have a return in there then all manner of horrible things happen. Presumably this is because I have misunderstood how this all works and cocked up the queueing somehow.

[reply]
[d/l]

In Section Seekers of Perl Wisdom