Thanks all,
I put the following together using the tips from perldoc -q "tail -f". As a POE user I was under the impression that the Tk tail would fail on Win32 due to the lack of fileevent - I haven't used it recently so it may be fixed.
This first version hangs onto the filehandle as you say so it needs some thought to emulate --follow=name.
#! perl
use strict;
use warnings;
use Tk;
#
my $file = "C:\\openejb-0.8.3\\openejb.log";
#
my $title = "Tk Tail";
my $version = "1.0";
my $mw = new MainWindow( -title => $title );
# Nicer fixed-width font...
$mw->fontCreate( 'listboxfont', -family => 'courier', -size => '8' );
my $fr = $mw->Frame()->pack( -expand => 1, -fill => 'both' );
#
$fr->Label( -text => "File to tail" )->pack;
$fr->Entry(
-textvariable => \$file,
-width => '50',
-font => 'listboxfont',
)->pack;
$fr->Button( -text => 'GO', -command => \&gopush )->pack;
my $listbox = $mw->Scrolled(
'Listbox',
-setgrid => '1',
-height => '10',
-width => '50',
-font => 'listboxfont',
-selectmode => 'extended',
-scrollbars => 'se',
-bg => 'black',
-fg => 'green',
);
$listbox->pack( -expand => 'yes', -fill => 'both', -pady => '3' );
my $fr_statusbar = $mw->Frame(
-relief => 'sunken',
-borderwidth => '1',
)->pack( -fill => 'x' );
#~ $fr_statusbar->Label( -image => $smallicon )->pack(-side => 'left')
+;
$fr_statusbar->Label( -text => "Version: $version" )->pack( -side => '
+left' );
#
sub gopush {
close F;
open F, '<', $file or die $!;
timerstart();
}
# repeating actions...
my $timerid;
sub timerstart {
&timerstop();
$timerid = $mw->repeat( 1000, \&timerproc );
}
sub timerstop {
if ($timerid) {
$timerid->cancel;
}
}
sub timerproc {
while (<F>) {
chomp;
my $text = $_;
$listbox->insert( 'end', $text );
$listbox->see('end');
$mw->update();
}
seek( F, 0, 1 );
}
MainLoop();
|