如何在Perl中使用timeout-on-read实现'tail -f'？

Question

My question is the antithesis of How do I process input immediately instead of waiting for newline . I want to continue reading a growing log file, but stop after the file has not grown for a specified number of seconds.

I found Sys::AlarmCall at CPAN, and tried as shown below, but it doesn't time-out when I run:

perl progress.tracker.pl progress.tracker.pl

I'm guessing that this is something to do with the auto-magic associated with the ' <> ' operator. But I'm not sure how to go about rewriting the code. I'm OK with an explicit open of just one file (instead of an arbitrary number of files), defaulting to standard input if no file is specified - I only ever expect to use it with one file name.

(The script generates a dot for each line read, generating a newline every 50 lines read, and outputting a timestamp every 25 lines of dots. I use it to track the progress of long-running builds. The current incarnation is fed by tail -f , but that is not exiting when this script does, mainly because it never gets any more input to write to the now non-existent progress tracker. The 'last' line stuff is a marker in the log files I normally process; I want to remove it. The timeout will be of the order of minutes, not sub-second.)

#!/usr/perl/v5.10.0/bin/perl -w
#
# @(#)$Id: progress.tracker.pl,v 1.3 2009/01/09 17:32:45 jleffler Exp jleffler $
#
# Track progress of a log-generating process by printing one dot per line read.

use strict;
use constant DOTS_PER_LINE => 50;
use constant LINES_PER_BREAK => 25;
use constant debug => 0;
use POSIX qw( strftime );
use Sys::AlarmCall;

sub read_line
{
    print "-->> read_line()\n" if debug;
    my $line = <STDIN>;
    printf "<<-- read_line(): %s", (defined $line) ? $line : "\n" if debug;
    return $line;
}

my $line_no = 0;
my $timeout = 30;
my $line;

$| = 1;     # Unbuffered output

while ($line = alarm_call($timeout, 'read_line', undef))
{
    $line_no++;
    print ".";
    print "\n" if ($line_no % DOTS_PER_LINE == 0);
    printf "%s\n", strftime("%Y-%m-%d %H:%M:%S", localtime(time))
        if ($line_no % (DOTS_PER_LINE * LINES_PER_BREAK) == 0);
    last if $line =~ m/^Trace run finished: /;
}

print "\n";
print $line if defined $line && $line =~ m/^Trace run finished: /;

Any suggestions? (Preferably apart from 'get off your **** and code it in C'!)

---

File::Tail seems to meet my requirements pretty well. The revised code is:

#!/usr/perl/v5.10.0/bin/perl -w
#
# @(#)$Id: progress.tracker.pl,v 3.2 2009/01/14 07:17:04 jleffler Exp $
#
# Track progress of a log-generating process by printing one dot per line read.

use strict;
use POSIX qw( strftime );
use File::Tail;

use constant DOTS_PER_LINE   => 50;
use constant LINES_PER_BREAK => 25;
use constant MAX_TIMEOUTS    => 10;
use constant TIMEOUT_LENGTH  => 30; # Seconds

my $timeout    = TIMEOUT_LENGTH;
my $line_no    = 0;
my $n_timeouts = 0;
my $line;

sub print_item
{
    my($item) = @_;
    $line_no++;
    print "$item";
    print "\n" if ($line_no % DOTS_PER_LINE == 0);
    printf "%s\n", strftime("%Y-%m-%d %H:%M:%S", localtime(time))
        if ($line_no % (DOTS_PER_LINE * LINES_PER_BREAK) == 0);
}

$| = 1;     # Unbuffered output

# The foreach and while loops are cribbed from File::Tail POD.
my @files;
foreach my $file (@ARGV)
{
    push(@files, File::Tail->new(name=>"$file", tail => -1, interval => 2));
}

while (1)
{
    my ($nfound, $timeleft, @pending) = File::Tail::select(undef, undef, undef, $timeout, @files);
    unless ($nfound)
    {
        # timeout - do something else here, if you need to
        last if ++$n_timeouts > MAX_TIMEOUTS;
        print_item "@";
    }
    else
    {
        $n_timeouts = 0;  # New data arriving - reset timeouts
        foreach my $tail (@pending)
        {
            # Read one line of the file
            $line = $tail->read;
            print_item ".";
        }
    }
}

print "\n";
print $line if defined $line && $line =~ m/^Trace run finished: /;

There is room for improvement; in particular, the timeouts should be configurable. However, it seems to work as I wanted. More experimentation and tweaking is required.

It seems that the $tail->read() function reads one line at a time; that is not totally obvious from the POD.

---

Sadly, upon further practical use, it appears that the way I'm using the File::Tail code doesn't work the way I need it to. In particular, once it stalls on a file, it doesn't seem to resume again. Rather than spend the time trying to work out what was wrong, I fell back on the alternative - code it myself in C. It took less than 2 hours to get a version with the bells and whistles I wanted added. I'm not sure whether I would have been able to get those into Perl as quickly, quite apart from the debugging of (my use of) File::Tail. One oddity: I set my code to use 4096 byte buffers; I found one line in the build process I monitor is over 5000 bytes long. Ah well - the code still uses 4096 byte buffers, but emits a dot for an over-long line like that. Good enough for my purposes. I also find that I need to allow for 5 minute pauses in the build output.

Answer 1

Have you tried File::Tail to handle the actual tailing instead of trying to coerce <STDIN> to do the job?

Or, if that piece does work, in what way is this failing?

Answer 2

The problem is most probably related to output buffering. Have a read if you want a thorough explanation:

http://www.pixelbeat.org/programming/stdio_buffering/

In my case (on RHEL, I wanted tail -n 0 -f file | grep -m 1 pattern to terminate immediately when pattern occurs in the growing file), the proposed LD_PRELOADED library didn't help, neither did plain usage of the unbuffer utility from the Expect package.

But based on a blog post ( http://www.smop.co.uk/blog/index.php/2006/06/26/tail-f-and-awk/ ) I've discovered that redirecting input from tail launched in a subshell did the trick:

grep -m 1 pattern <(tail -n 0 -f file)

This was not as simple, though. While working in an interactive shell, the same command, when run remotely using SSH, still froze as usual:

ssh login@hostname 'grep -m 1 pattern <(tail -n 0 -f file)'

I've discovered that in this case, one must unbuffer tail's output using the unbuffer utility from Expect:

ssh login@hostname 'grep -m 1 pattern <(unbuffer -p tail -n 0 -f file)'

This must not be used on an interactive shell - unbuffer will cause an ioctl(raw): I/O error !