Мой вопрос - противоположность Как я могу обработать ввод немедленно, вместо ожидания новой строки . Я хочу продолжить чтение растущего файла журнала, но остановлюсь после того, как файл не будет увеличен в течение указанного количества секунд.
Я нашел 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-минутные паузы в выводе сборки.