in reply to Re^7: Tk gui bug
in thread Tk gui bug

That's helpful, thank you. Now I'd like to redirect STDOUT and STDERR from an external program to my text widget in real time. The example below writes to the text widget, but not in real time AND the STDERR is written first rather than last. (the example below does not exhibit this last problem.) I've parsed many solutions and am thoroughly confused at this point. 
#!/usr/bin/perl -w
use warnings;
use strict;
use Tk;
use Tk::NoteBook;
require Tk::Pane;
use Tie::IxHash;
use Tk::LabEntry;

my $mw = MainWindow->new;
$mw->geometry( "600x500");
$mw->title("Survival Kit");

##################NOTES########
##expansion from 2nd tab has bug?


###default hash

tie my %tools, 'Tie::IxHash',
'program1' => ordered_hash_ref ( 'PARM1' => 'Y', 'PARM2' => 'files', '
+PARM3' => 'list', 'PARM4' => 'Y', 'PARM5' => 'N'),
'program2' => ordered_hash_ref ( 'PARM' => '', 'PARM0' => 0, 'PARM1' =
+> 1, 'PARM2' => 2, 'PARM3' => 3, 'PARM4' => 4, 'PARM5' => 5, 'PARM6' 
+=> 6, 'PARM7' => 7, 'PARM8' => 8, 'PARM9' =>9, 'PARM10' => 10 );

                                                                      
+                                                       
## create notebook
my $book = $mw->NoteBook()->pack(-expand=>1,-fill=>'both');


#####program1#######
my $tab_cnt=1;
for my $tab (keys %tools){       
     ##create tab,scroll pane,frames
      my $tab_tab=$book->add("Sheet $tab_cnt", -label => "$tab")->pack
+(-expand=>1,-fill=>'both');
      my $tab_spane=$tab_tab->Scrolled('Pane',-background=>'slate grey
+')->pack(-expand=>1, -fill=>'both');
      my $tab_frame1=$tab_spane->Frame(-background=>'blue')->pack(-sid
+e=>'left',-expand=>1,-fill=>'both',-padx=>15);
      my $tab_frame2=$tab_spane->Frame(-background=>'red')->pack(-side
+=>'bottom',-anchor=>'s',-fill=>'x');
    $tab_cnt++;
       #create columns
       my $tab_column1 = $tab_frame1->Frame()->pack(-side=>'left',-exp
+and=>1,-fill=>'both');
       my $tab_column2 = $tab_frame2->Frame()->pack(-side=>'right',-ex
+pand=>1,-fill=>'both');      
    
       ##now fill frames
      my $parm_cnt=1;
       #print "Processing tool: $tab\n";
         foreach my $parm ( keys %{$tools{$tab}}) {
        #print " $parm = $tools{$tab}{$parm}\n";
        my $tab_test;
             if ($parm_cnt < 7 ){
                   $tab_test=$tab_column1->LabEntry(-label => "$parm="
+);
             $tab_test->Subwidget('entry')->configure(-textvariable =>
+ \$tools{$tab}{$parm} );
             $tab_test->configure(-labelPack=>[-side=>'left']);
                   $tab_test->pack(-anchor=>'e');

        } else {

                   $tab_test=$tab_column2->LabEntry(-label => "$parm="
+);
             $tab_test->Subwidget('entry')->configure(-textvariable =>
+ \$tools{$tab}{$parm} );
             $tab_test->configure(-labelPack=>[-side=>'left']);
                   $tab_test->pack(-anchor=>'e');
  
                   }
          $parm_cnt++;
            }   
         
#######go and save button#############
my $run=$tab_tab->Button(-text => "\n       $tab       \n ",-command=>
+\&go ,-command =>[\&save_parms,$tab],-background=>'slate grey')->pack
+;

}

MainLoop;

####################### subs ###############################
sub save_parms {

my $tab = shift;
#print $tab;

#program > FILE 2>&1
#open STDOUT,">tmpfile" or die "Cannot open temp file";
#open STDOUT, '>/dev/null';
#open STDERR, '>>&STDOUT';
#close STDOUT;

####stderr stdout dialog box###################
my $popup = Tk::MainWindow->new;
$popup->title("${tab} Info");
my $text = $popup->Scrolled('Text',-label => "Output/Errors",-width  =
+> 45,-height => 20);
  $text->pack;
$| = 1;
 tie(*STDERR, 'Tk::Text', $text);
 tie(*STDOUT, 'Tk::Text', $text);
  $SIG{'__WARN__'} = sub { print STDERR @_ };
  my $button = $popup->Button(
      -text => 'Close',
      -command => [$popup=> 'destroy']);
  $button->pack;
################################################     

  if ( "$tab" eq "program1"){
     open (my $parfile,"> program1_parms.txt") or warn "$!\n";
    foreach my $parm ( keys %{$tools{$tab}} ) {
         print $parfile "$parm=$tools{$tab}{$parm}\n";
           }
    close $parfile;
       print STDOUT `cat program1_parms.txt 2>&1 `; 
    sleep 5;  
    print STDERR "HELP!";
    
      }

}

## order hashes##
sub ordered_hash_ref {
    tie my %hash, 'Tie::IxHash', @_;
    return \%hash;
}

[download]
-honyok

Replies are listed 'Best First'.
Re^9: Tk gui bug
by zentara (Cardinal) on Feb 05, 2009 at 14:18 UTC
    You need to open up your external programs with IPC::Open3 ( possibly a 2>&1 redirect in a piped open), but IPC::Open3 is you general purpose solution. Here is a basic example, you setup a fileevent on the inputs: 
    #!/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]
    and the simple sender to play with 
    #!/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]
    I'm not really a human, but I play one on earth Remember How Lucky You Are
[reply]
[d/l]
[select]
      I can't get your first bit of code to run properly. I only get a graphic if I comment out these lines: 
      $mw->fileevent( \*OUT, 'readable', \&write_out );
$mw->fileevent( \*ERR, 'readable', \&write_err );

      [download]
      Otherwise no errors or warnings - just stalls at the command line.
[reply]
[d/l]
[reply]

In Section Seekers of Perl Wisdom