in reply to Please suggest a non-forking way to do this (OS: windows)

Your "program" is a Perl function. Can it be an independent script? If so, you could spawn a thread to act as a bridge. 

use IPC::Open3 qw( open3 );

sub run_child { 
   my ($widget) = @_;

   my $pid = open3(
      my $to_child,   # Autovivified when false.
      my $fr_child,   # Autovivified when false.
      undef,          # Same as $fr_child when false.
      $somecommand,
      @args
   );

   while (<$fr_child>) {
      my $end_is_visible = ( $yview == 1.0 );
      $text->insert('end', $_);
      $w->see('end') if $end_is_visible;
   }

   waitpid($pid, 0);
}

[download]

And I have no idea how Tk will react to threads, especially when calling a $widget method from a separate thread.

Replies are listed 'Best First'.
Re^2: Please suggest a non-forking way to do this (OS: windows)
by zentara (Cardinal) on Sep 29, 2008 at 12:49 UTC
    Tk will react.....calling a $widget method from a separate thread

    Tk will crash, you can't access widgets from threads. Gtk2 allows it, with some precautions, but not Tk.

    In your example, your best bet to handle it, would be to pass the fileno of $fr_child back to the main thread thru a shared variable, then open the fileno in main, read it, and put it into the widget.

    I'm not really a human, but I play one on earth Remember How Lucky You Are
[reply]

      your best bet to handle it, would be to pass the fileno of $fr_child back to the main thread

      Who's gonna read from that handle? The OP wants the program to run asynchronously with the Tk window, such that output from the program gets added to the Tk window as it is produced.

[reply]
        Who's gonna read from that handle?

        On linux, you would setup a fileevent on that fileno, and as readable data appears on the filehandle, it would be inserted into the text box. However, on win32, fileevent won't work reliably on pipes, so you will need a timer to repeatedly read the fileno in the main script.

        Here is a simple example of passing the fileno back from a thread.(works on linux) 

        #!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use Tk;

my %shash;
#share(%shash); #will work only for first level keys
my %hash;

 share ($shash{'go'});
 share ($shash{'fileno'});
 share ($shash{'pid'});
 share ($shash{'die'});
 
 $shash{'go'} = 0;
 $shash{'fileno'} = -1;
 $shash{'pid'} = -1;
 $shash{'die'} = 0;

 $hash{'thread'} = threads->new(\&work);

my $mw = MainWindow->new(-background => 'gray50');

my $text = $mw->Scrolled('Text')->pack();


my $startb = $mw->Button( -text => 'Start',
                -command=>sub{
                     $shash{'go'} = 1;
             $mw->after(100); #give pipe chance to startup
             my $fileno = $shash{'fileno'};
                     print "fileno_m $fileno\n";
          open (my $fh, "<&=$fileno") or warn "$!\n";

 # filevent works on linux but may not work on win32, 
 # but you can use a timer instead as shown below
 $mw->fileevent(\*$fh, 'readable', );             
             while(<$fh>){
            $text->insert('end',$_);    
                $text->see('end');                  
                $mw->update;
           }

# on Win32 (untested by me) you will need 
# a timer instead of fileevent

#   my $repeater; 
#        $repeater = $mw->repeat(10,
#          sub {
#              my $bytes = sysread( "<&=$fileno", my $buf, 8192);
#          $text->insert('end',$buf);    
#                     $text->see('end');         
#          if( $shash{'go'} == 0 ){ $repeater->cancel }
#               }
#             );             
        
             }
                 )->pack();

my $stopb = $mw->Button( -text => 'Stop/Exit',
                -command=>sub{
                 $shash{'die'} = 1;
                 kill 9,$shash{'pid'};
                 $hash{'thread'}->join;         
                 exit;
              },
                 )->pack();


MainLoop;
#####################################

sub work{
    $|++; 
    while(1){
       if($shash{'die'} == 1){ return }; 
      
       if ( $shash{'go'} == 1 ){

        my $pid = open(FH, "top -b |" ) or warn "$!\n";
        my $fileno = fileno(FH);
        print "fileno_t->$fileno\n";
        $shash{'fileno'} = $fileno;
        $shash{'pid'} = $pid;
       
    $shash{'go'} = 0; #turn off self before returning      
       }else
         { select(undef,undef,undef,.1) } #short sleep
    }

}

        [download]
        I'm not really a human, but I play one on earth Remember How Lucky You Are
[reply]
[d/l]

In Section Seekers of Perl Wisdom