in reply to Re: Tk + threads
in thread Tk + threads

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.

Replies are listed 'Best First'.
Re^3: Tk + threads
by BrowserUk (Patriarch) on Jan 10, 2006 at 16:59 UTC

    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"

    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.

      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(); }

      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.

        but if I omit the "sleep" from &runprogs, or have a return in there then all manner of horrible things happen

        You're gonna have to be a little more specific that "all manner of horrible things" :)

        sleep without an argument means sleep forever, (I just discovered), or until the process receives a signal. So basically you are saying that if you allow the thread to terminate something breaks somehow.

        One problem is that your while loop is going to terminate pretty much straight away. dequeue_nb returns undef if there is nothing currently in the queue. So, if there is a delay whilst waiting for the output from the command, the dequeuing loop will terminate early. Queueing undef to terminate the dequeue loop works fine when using dequeue, but not for dequeue_nb_ hence the change to a sentinel value in my updated version.

        Another thing I notice with your code. You are creating your $Q before the declaration of runprogs(), and whilst you pass $Q as an argument to the thread, you are not using that argument, but rather picking it up by closure. That's messy, but works okay whilst you only have one command and queue, but once you start having multiple, it won't work at all.

        You really need to be creating a new queue for each command thread you start. That implies that you should be creating the Q inside the command callback sub. It also implies that you would either

        • loop inside that callback once for each program you which to run. Creating a new queue and starting a thread.
        • Or, you have a separate button for each command.
        • Or, you have one button which determines which command to start according to some selection made by the user on the GUI.

        All these are possible, but which makes sense depends upon the architecture of the rest of your application.

        I seriously suggest that you play with the code of the second version I posted and understand how the bits work together. Doing this in a separate stand alone app will allow you get to grips with things more easily than in the context of a more elaborate, complex app.

        You should also take a good look at the code zentara posted. It tackles the problem from a different direction, but you may find it a simpler starting point. I'm not quite sure how it scales for running multiple concurrent processes, but starting simple is good.


        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.