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

Hi, I'm hoping you can help me on something that has bugged me for a couple of years now. I have a perl/TK script which runs a main perl script with a basic TK front end. The problem I just cannot seem to crack is how to run it and achieve three things:
1) - all STDOUT is printed to a text widget (including from any system commands that are all called)
2) - the Tk front end doesn't just hang whilst the routine is running (and it can run for a couple of days sometimes, depending on what system commands are being run).
3) - it must work on Windows not just Unix
Below is a simple test code which runs what I currently do (badly) 
#!/usr/bin/perl -w
# use strict;
# use Encode::Unicode;
use Tk;

# open(H, "tail -f -n 25 $ARGV[0]|") or die "Nope: $!";
# open(STDOUT, "+> |") or die "Nope: $!";
# open STDOUT, '+<', \&test or die "Can't open STDOUT: $!";
  
$mw=MainWindow->new(); # create main window, and stretch it to fill sc
+reen minus a bit
$mw->title("GRM Consulting Ltd. - GENESIS Optimisation Coupling Tool v
+1.0");
$mw->geometry("800x600+100+100");

 
my $t = $mw->Text(-width => 80, -height => 25, -wrap => 'none');
$t->pack(-expand => 1);
# $mw->fileevent(\*STDOUT, 'readable', [\&fill_text_widget, $t]);

$mw->update;
test();

MainLoop;



sub fill_text_widget {
 
    my($widget) = @_;
 
    my($stat, $data);
    $stat = sysread STDOUT, $data, 4096;
    die "sysread error:  $!" unless defined $stat;
    $widget->insert('end', $data);
    $widget->yview('end');
 
}


## Test routine to simulate my main program execution

sub test {

for ($i=0; $i<3; $i++ ) {
print "testline $i\n";
sleep 1;
}

$command="dir";
system("$command");

for ($i=0; $i<3; $i++ ) {
print "testline1 $i\n";
sleep 1;
}

die;
}

[download]
As you'll see by the commented out line I have been trying to use the filevent command to pipe things and have had a little bit of success but not really too much. If you can help with this it is going to solve a long standing problem in my understanding of how perl and tk talk.
Many thanks
Martin Gambling (<- hence the Gambling user name!!)

Replies are listed 'Best First'.
Re: Executing pipe STDOUT from a subroutine to Widget
by Joost (Canon) on May 15, 2008 at 11:10 UTC 
    #!/usr/bin/perl -w
use strict;
use Tk;
use Tk::Text;
use Tk::IO;

my $mw = MainWindow->new( -width => 200, -height => 200);
my $textwidget = $mw->Text()->pack( -expand => 1, -fill => 'both');
tie *STDOUT, ref $textwidget, $textwidget;

my $label = $mw->Label( -text => ".")->pack( -fill => 'x');
my $b = $mw->Button( -text => "start", -command => \&start)->pack( -fi
+ll => 'x');

## just showing that Tk events are actually handled all the time
my $i = 0;
my @thing = qw( . o O o );
$mw->repeat( 100 => sub { $label->configure( -text => $thing[$i++] x 2
+0); $i = 0 if $i == @thing });



sub start {
  # this catches the output of the child process and 
  # sends it to (tied) STDOUT of this process
  my $io = Tk::IO->new( -linecommand => sub { print @_ }, -childcomman
+d => sub { print "EOF\n" } );

  $io->exec(q(perl -e '$|=1; for (0 .. 10) { print "$_\n"; sleep 1 }')
+);
}

MainLoop;

    [download]
    "What should it profit a man, if he should win a flame war, yet lose his cool?"
[reply]
[d/l]
      '-' is not recognized as an internal or external command,
operable program or batch file.

      [download]
      perlport says open to |- and -| are unsupported. (Mac OS, Win32, RISC OS)
[reply]
[d/l]
Re: Executing pipe STDOUT from a subroutine to Widget
by zentara (Cardinal) on May 15, 2008 at 13:58 UTC
    Try Tk::ExecuteCommand or look at this simple example. I run bash here, but you can also run commands directly( a shell may get made automatically). The only problem is having it run in windows. Some versions of windows don't allow fileevent, except on socket filehandles. There is the IPC::Run module which only uses sockets (no pipes) so it will run on linux and win32, but it is more complex to use. You could write separate subs for win32 and linux, but if you need the same code for both, use IPC::Run 
    #!/usr/bin/perl
use warnings;
use strict;
use Tk;
use IPC::Open3;
require Tk::ROText;

$|=1;

my $mw = new MainWindow;

my $entry=$mw->Entry(-width => 80)->pack;

$mw->Button(-text => 'Execute',
        -command => \&send_to_shell)->pack;

my $textwin =$mw->Scrolled('ROText',
       -width => 80,
       -bg =>'white',    
       -height => 24,
       )->pack;

$textwin->tagConfigure( 'err', -foreground => 'red' );

my $pid = open3( \*IN, \*OUT, \*ERR, '/bin/bash' ) or warn "$!\n";

$mw->fileevent( \*OUT, readable => \&read_stdout );
$mw->fileevent( \*ERR, readable => \&read_stderr );

$entry->focus;

MainLoop;

sub read_stdout {
    
    if( sysread( OUT, my $buffer, 1024 ) > 0 ){
       $textwin->insert( 'end', $buffer );
       $textwin->see('end');
      }
}

sub read_stderr {
    if( sysread(ERR, my $buffer, 1024 ) > 0 ){
      $textwin->insert( 'end', $buffer, 'err' );
      $textwin->see('end');
    }
}

    
sub send_to_shell {
   my $cmd= $entry->get();
   print IN "$cmd\n";
}

    [download]
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
[d/l]

Back to Seekers of Perl Wisdom