一个错误的Perl Tk stderr仅在cmd提示符中显示,而不是像所有其他警报一样在文本小部件中显示

时间:2014-07-06 21:37:24

标签: perl

我有一个用于运行脚本的perl Tk gui我已从脚本中获取所有stdout和stderr以在文本小部件中打印。 我试图从gui本身获取stderr消息以显示在文本小部件中,例如,如果有任何“消息”或“死亡”消息。由于文件不可用,警告会被触发 Tk :: ErrorDialog'错误'除了子runcripts report.pl之外,弹出框出现,此警告仅出现在cmd提示屏幕中,我希望它出现在gui弹出警告框中。

use warnings;
use strict;
use Tk;
use POSIX 'strftime';
use Tk::ErrorDialog;
my $DATE = strftime("  report.pl for %d %b %Y " , localtime());
my $title = strftime(" Processing daily Failures for %d %B %Y" , localtime());
my $mw = MainWindow->new;
my $filenameA = "c:\\Temp\\perl.txt";


$mw->geometry("720x500");
$mw->title("   report  ");


my $main_frame = $mw->Frame()->pack(-side => 'top', -fill => 'x');
my $left_frame = $main_frame->Frame(-background => "snow2")->pack(-side => 'left', -fill => 'y');
my $right_frame = $main_frame->Scrolled("Text", -scrollbars => 'se',-background => "black",-foreground => "green",-height => '44')->pack(-expand => 1, -fill => 'both');


my $failures_button = $left_frame->Button(-text => "$DATE ",
                                -command => [\&runscript])->pack;
my $guide = $left_frame->Button(-text => "           Clear Screen              ",
                                -command => [\&clear_screen])->pack;
my $Close_button = $left_frame->Button(-text => '                Exit                    ',
-command => [$mw => 'destroy'])->pack;  

my $Help_button = $left_frame->Button(-text => "            Help Guide                ",
                                -command => \&help_file)->pack(-side => "bottom");  

my $About = $left_frame->Button(-text => '                About                    ',
-command => \&About_file)->pack(-side => "bottom");                             


MainLoop;
sub runscript {

   open (daily_fail, '-|', 'report.pl &') or die "unable to start daily_failues.pl";

   my $first_line = "   please wait......\n  $title........\n";
   $right_frame->delete("1.0", 'end');
   $right_frame->insert( 'end', $first_line );

   my $daily_fail_line;

   while (defined ($daily_fail_line =<daily_fail>) ) 
   {
       $right_frame->insert( 'end', $daily_fail_line );
       $right_frame->update(); 
       $right_frame->see('end');
   }   
}

sub clear_screen {
    $right_frame->delete('1.0','end');

}  

sub About_file {
  $right_frame->delete("1.0", 'end');
  open (FH, "$filenameA") or die "unable to open c:\\Temp\\perl.txt";
  while (<FH>) { $right_frame->insert("end", $_); }
  close (FH);
}

sub help_file {
  system("tk.pl") or die "unable to start c:\\tk.pl";

}

use warnings; use strict; use Tk; use POSIX 'strftime'; use Tk::ErrorDialog; my $DATE = strftime(" report.pl for %d %b %Y " , localtime()); my $title = strftime(" Processing daily Failures for %d %B %Y" , localtime()); my $mw = MainWindow->new; my $filenameA = "c:\\Temp\\perl.txt"; $mw->geometry("720x500"); $mw->title(" report "); my $main_frame = $mw->Frame()->pack(-side => 'top', -fill => 'x'); my $left_frame = $main_frame->Frame(-background => "snow2")->pack(-side => 'left', -fill => 'y'); my $right_frame = $main_frame->Scrolled("Text", -scrollbars => 'se',-background => "black",-foreground => "green",-height => '44')->pack(-expand => 1, -fill => 'both'); my $failures_button = $left_frame->Button(-text => "$DATE ", -command => [\&runscript])->pack; my $guide = $left_frame->Button(-text => " Clear Screen ", -command => [\&clear_screen])->pack; my $Close_button = $left_frame->Button(-text => ' Exit ', -command => [$mw => 'destroy'])->pack; my $Help_button = $left_frame->Button(-text => " Help Guide ", -command => \&help_file)->pack(-side => "bottom"); my $About = $left_frame->Button(-text => ' About ', -command => \&About_file)->pack(-side => "bottom"); MainLoop; sub runscript { open (daily_fail, '-|', 'report.pl &') or die "unable to start daily_failues.pl"; my $first_line = " please wait......\n $title........\n"; $right_frame->delete("1.0", 'end'); $right_frame->insert( 'end', $first_line ); my $daily_fail_line; while (defined ($daily_fail_line =<daily_fail>) ) { $right_frame->insert( 'end', $daily_fail_line ); $right_frame->update(); $right_frame->see('end'); } } sub clear_screen { $right_frame->delete('1.0','end'); } sub About_file { $right_frame->delete("1.0", 'end'); open (FH, "$filenameA") or die "unable to open c:\\Temp\\perl.txt"; while (<FH>) { $right_frame->insert("end", $_); } close (FH); } sub help_file { system("tk.pl") or die "unable to start c:\\tk.pl"; }

0 个答案:

没有答案