yuan
I am testing a perl/tk code to display log file on my tk text window. It works correctly when I first clicked the start button, but out of lock when I try it again and my code gave me an even error:
Tk::Error: Can't locate object method "OPEN" via package "Tk::Event::IO" at fileeventXu1.pl line 81.
I had tried for a couple of days but out of luck:
Any help will be greatly appreciated.
Yuan
Here is my code:
use English;
use Tk;
use FileHandle;
use strict;
use warnings;
use vars qw($IPC_win);
#
my $dir = "~/perl/nodia/junk1";
my $out = "Test_diamod.out";
my $IPC_win = MainWindow->new;
my $title = "Diamod running status";
my $txt1 = "Start Diamod";
my $i = 0;
my $color = "red";
my $stop = "stop";
#
#
$IPC_win -> title("$title");
#
my $text = $IPC_win -> Scrolled("Text",
-width => 90,
-height => 25,
-wrap => 'none') -> pack(-side => 'top',
-expand => 1,
-fill => 'both');
#
my $close = $IPC_win -> Button(-text => "Close Window",
-activeforeground => "blue",
-command => sub {destroy $IPC_win;});
#
my $status = $IPC_win->Label(-text=>"Information:",
-relief => "sunken",
-borderwidth=> 2,
-anchor => "w",
-wraplength => 0
);
#
my $start_button = $IPC_win -> Button(-text => "$txt1",
-activeforeground => "red",
-command => sub{diamod()});
$status->pack(-side => 'bottom',
-expand => 0,
-fill =>'both'
);
#
$start_button -> pack(-side => 'left', -expand => 1, -fill => 'both');
$close -> pack(-side => 'left', -expand => 1, -fill => 'both');
#
MainLoop;
#
# ---------------------------
sub diamod{
#
my $i = ++$i;
if ($i > 1){$color = "blue";};
chdir ($dir);
#
&openfile($i);
my $text = " Running diamod program, it takes a while to finish.";
$status -> configure(-text => $text,
-foreground => $color,
-justify => 'left',
-font => "Arial 14 normal");
#
#
} #End sub diamod
#
sub fill_text_widget {
#
my($stat,$data);
$stat = sysread H, $data, 256;
die "sysread error: $!" unless defined $stat;
$text -> insert('end', $data);
$text -> yview('end');
} # end fill_text_widget
#
sub openfile {
print STDOUT "I am here, $_[0], $dir/$out\n";
#
open(H, "tail -f -n 20 $dir/$out& | ") or die "Nope: $OS_ERROR";
$IPC_win ->fileevent(\*H, 'readable', [\&fill_text_widget, $text]);
} # end fill_text_widget
1;
Tk::Error: Can't locate object method "OPEN" via package "Tk::Event::IO" at fileeventXu1.pl line 81.
I had tried for a couple of days but out of luck:
Any help will be greatly appreciated.
Yuan
Here is my code:
use English;
use Tk;
use FileHandle;
use strict;
use warnings;
use vars qw($IPC_win);
#
my $dir = "~/perl/nodia/junk1";
my $out = "Test_diamod.out";
my $IPC_win = MainWindow->new;
my $title = "Diamod running status";
my $txt1 = "Start Diamod";
my $i = 0;
my $color = "red";
my $stop = "stop";
#
#
$IPC_win -> title("$title");
#
my $text = $IPC_win -> Scrolled("Text",
-width => 90,
-height => 25,
-wrap => 'none') -> pack(-side => 'top',
-expand => 1,
-fill => 'both');
#
my $close = $IPC_win -> Button(-text => "Close Window",
-activeforeground => "blue",
-command => sub {destroy $IPC_win;});
#
my $status = $IPC_win->Label(-text=>"Information:",
-relief => "sunken",
-borderwidth=> 2,
-anchor => "w",
-wraplength => 0
);
#
my $start_button = $IPC_win -> Button(-text => "$txt1",
-activeforeground => "red",
-command => sub{diamod()});
$status->pack(-side => 'bottom',
-expand => 0,
-fill =>'both'
);
#
$start_button -> pack(-side => 'left', -expand => 1, -fill => 'both');
$close -> pack(-side => 'left', -expand => 1, -fill => 'both');
#
MainLoop;
#
# ---------------------------
sub diamod{
#
my $i = ++$i;
if ($i > 1){$color = "blue";};
chdir ($dir);
#
&openfile($i);
my $text = " Running diamod program, it takes a while to finish.";
$status -> configure(-text => $text,
-foreground => $color,
-justify => 'left',
-font => "Arial 14 normal");
#
#
} #End sub diamod
#
sub fill_text_widget {
#
my($stat,$data);
$stat = sysread H, $data, 256;
die "sysread error: $!" unless defined $stat;
$text -> insert('end', $data);
$text -> yview('end');
} # end fill_text_widget
#
sub openfile {
print STDOUT "I am here, $_[0], $dir/$out\n";
#
open(H, "tail -f -n 20 $dir/$out& | ") or die "Nope: $OS_ERROR";
$IPC_win ->fileevent(\*H, 'readable', [\&fill_text_widget, $text]);
} # end fill_text_widget
1;