Как мне реализовать 'tail -f' с тайм-аутом при чтении в Perl?

Мой вопрос противоположен Как обработать ввод немедленно, а не ждать перевода строки. Я хочу продолжить чтение растущего файла журнала, но остановиться после того, как файл не увеличился в течение заданного количества секунд.

Я нашел Sys::AlarmCall на CPAN и попробовал как показано ниже, но время ожидания не истекает, когда я запускаю:

perl progress.tracker.pl progress.tracker.pl

Я предполагаю, что это как-то связано с автоматической магией, связанной с оператором '<>'. Но я не уверен, как переписать код. Я согласен с явным открытием только одного файла (вместо произвольного количества файлов), по умолчанию используется стандартный ввод, если файл не указан - я всегда ожидаю использовать его только с одним именем файла.

(Сценарий генерирует точку для каждой прочитанной строки, создает новую строку каждые 50 прочитанных строк и выводит отметку времени через каждые 25 строк точек. Я использую его для отслеживания хода выполнения длительных сборок. Текущее воплощение подпитывается tail -f, но это не завершается, когда этот скрипт делает, главным образом потому, что он никогда не получает больше ввода для записи в ныне несуществующий трекер прогресса. «Последняя» строка — это маркер в файлах журнала, которые я обычно обрабатываю; я хочу удалить тайм-аут будет порядка минут, а не доли секунды.)

#!/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: /;

Какие-либо предложения? (Желательно, кроме «отойди от своего дерьма и напиши это на C»!)

File::Tail соответствует моим требованиям не плохо. Пересмотренный код:

#!/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: /;

Есть возможности для улучшения; в частности, тайм-ауты должны быть настраиваемыми. Однако, похоже, он работает так, как я хотел. Требуется больше экспериментов и настроек.

Кажется, что функция $tail->read() читает по одной строке за раз; это не совсем очевидно из POD.

К сожалению, при дальнейшем практическом использовании оказывается, что то, как я использую код File::Tail, не работает так, как мне нужно. В частности, когда он останавливается на файле, он, похоже, больше не возобновляется. Вместо того, чтобы тратить время на то, чтобы понять, что не так, я остановился на альтернативе — закодировать это самостоятельно на C. Потребовалось менее 2 часов, чтобы получить версию с добавленными прибамбасами, которые я хотел. Я не уверен, что смог бы так же быстро перенести их в Perl, если не считать отладки (использования мной) File::Tail. Одна странность: я настроил свой код на использование 4096-байтовых буферов; Я обнаружил, что одна строка в процессе сборки, которую я отслеживаю, имеет длину более 5000 байт. Что ж, код по-прежнему использует 4096-байтовые буферы, но выделяет точку для такой длинной строки. Достаточно хорошо для моих целей. Я также считаю, что мне нужно разрешить 5-минутные паузы в выводе сборки.