Perl: анализ лога игрового сервера

[buggykey]

Всем привет!
Помогите, пожалуйста, кто сможет и кому не лень:
начал изучать перл по книге, но примеры там неинтересные, хочется к своим насущным надобностям и интересам новые знания применить. К слову, я держу у себя сервер "World Of Padman" - это игруля такая, построенная на модифицированном движке Quake III. Решил я попробовать разобрать лог-файл этого сервера, чтобы самому поковырять статистику и т. д.: Решил для начала разделить большой лог на части, чтобы лог каждого раунда игры был в отдельном файле. Каждый раунд начинается со строки:

Код: [Выделить]

  0:00 ------------------------------------------------------------
Написал скрипт, который ищет такие строки и все, что между ними сохраняет в отдельные файлы, однако столкнулся с такой проблемой: почему-то регулярки, которые находят эту строку, находят не каждую из таких строк, а как-то через одну, или более. Никак не могу это побороть! Может найдется какой опытный перловщик, который сможет мне растолмачить, что-же я делаю не так?
Мой говноскрипт, пример исходного лога и те логи, которые у меня получаются на выходе - прилагаю: http://sendfile.su/828626
Сам текст скрипта:

(Нажмите, чтобы показать/скрыть)

Код: [Выделить]

#!/usr/bin/perl
use warnings;
use strict;
# use encoding 'utf8';


my $filename = 0; # начальное имя первого атомарного лог-файла

my $log = "ctl-temp.log";
my @game;
my $logdir = "ctl/";

my $line;

open (WOPLOG, "<", "$log") or die "Can't open file $log: $!";
my $check = 0; # начальное значения флага, взводится в "1" при нахождении первой строки начала игры

while (defined($line=<WOPLOG>))
{

if ($line =~ /^....00..--/)
# if ($line =~ /^\s+0:00 -+/)
{ # если $line - начальная строка игры
if ($check == 0)
{ # если мы ищем первую начальную строку, т. е. $check не взведена

$check = 1;

push @game, $line;
}
else
{ # если мы ищем завершающую строку, т. е. $check взведена в "1"
open (CURRENTLOG, ">", "${logdir}${filename}.log") or die "Cant open Current log file ${filename}.log: $!";
foreach (@game) { print CURRENTLOG "$_" }

close CURRENTLOG;
$check = 0;
$filename++;
@game = (); # обнуляем массив
push @game, $line;
}
}
else
{ # если $line - не начальная строка игры
push @game, $line;
}
}
close WOPLOG;


Спасибо за внимание!

[andrew_bye]

Для начала попробуй изменить использующееся в скрипте регулярное выражение

Код: [Выделить]

$line =~ /^....00..--/на

Код: [Выделить]

$line =~ /^\s*0:00\s*-+$/

[buggykey]

Для начала попробуй изменить использующееся в скрипте регулярное выражение

Код: [Выделить]

$line =~ /^....00..--/на

Код: [Выделить]

$line =~ /^\s*0:00\s*-+$/

Пробовал уже много раз. И такую регулярку пробовал, и другие - все одно. Причем, grep находит правильно, а в перловом скрипте - ерунда какая-то...

[andrew_bye]

Тогда попробуй такой скрипт.

Код: (Perl) [Выделить]

#!/usr/bin/perl

use warnings;
use strict;

# исходный лог-файл
my $srcLog = "ctl-temp.log";
# папка для атомарных лог-файлов (папка создается в директории из которой запускается скрипт)
my $dir = "ctl-logs";

# создаем папку для новых логов если ее не существует
unless (-e -d $dir) { mkdir $dir, 0755 }

# порядковый номер текущего атомарного лог-файла
my $newLog = 1;

# создаем файловый дескриптор для чтения исходного лог-файла
open FID, $srcLog or die "Failed to open $srcLog: $!\n";
# создаем массив, содержащий строки исходного лог-файла
my @srcLog = <FID>;
# закрываем файловый дескриптор
close FID;

# удаляем из начала исходного лога все строки (если они есть), не соответствующие началу нового раунда
shift @srcLog while ($srcLog[0] !~ /^\s*0:00\s*-+$/);
# завершаем работу скрипта, если исходный лог-файл пустой
die "Source log file is empty!\n" if (scalar @srcLog == 0);

# массив со строками текущего атомарного лог-файла
my @newLog;

# обрабатывем исходный лог
while (@srcLog)
{
  # вызываем подпрограмму записи текущего атомарного лог-файла если найдена строка следующего нового раунда
  if ($srcLog[0] =~ /^\s*0:00\s*-+$/ && @newLog) { &writeNewLog() }
  # в противном случае извлекаем текущую строку из масива @srcLog и добавляем ее в массив @newLog
  else { push  @newLog, shift @srcLog }
}

# записываем последний атомарный лог-файл
&writeNewLog() if (@newLog);

# подпрограмма записи атомарного лог-файла
sub writeNewLog
{
  # формируем имя текущего атомарного лог-файла
  my $newLogFile = "$dir/$newLog.log";
 
  # записываем текущий атомарный лог-файл
  open (LOG, ">", $newLogFile) or die "Cannot open the current log file $newLogFile: $!";
  while (@newLog) { print LOG shift @newLog }
  close LOG;
 
  # увеличиваем порядковый номер атомарного лог-файла на еденицу
  $newLog++;
}

__END__


[buggykey]

Огромное спасибо!
Я даже не ожидал такого развернутого и подробного ответа, прямо с готовым скриптом!
Я сейчас поразбираюсь и отпишусь.
Еще раз большое спасибо!
Пользователь решил продолжить мысль 21 Июня 2013, 15:24:48:Сейчас яйца курицу учить будут, но я в твоем скрипте обнаружил маленький недочет: тот лог-файл, что я выложил был маленьким кусочком реального 200-мегабайтного лога (ротация логов у меня отвалилась), и если твой скрипт на него натравить, он отжирает полгига оперативки, т. к. читает весь исходный лог в массив. Я переписал его немного по-своему, все отработало (200-мегабайтный файл новый скрипт раскидал буквально за 8 сек.) с минимальным потреблением ресурсов. Так что огромное спасибо за идею, однако, мне все-же непонятно, почему первый скрипт, пусть корявый, некрасивый и неоптимальный, но все-же правильный, как мне кажется, отрабатывает с такими ошибками?
Сам новый скрипт:

(Нажмите, чтобы показать/скрыть)

Код: [Выделить]

#!/usr/bin/perl
use warnings;
use strict;

my $filename = 0;
my $log = "ctl-server.log";
my @game;
my $logdir = "ctl/";
my $line;

open (WOPLOG, "<", "$log") or die "Can't open file $log: $!";
while (defined($line=<WOPLOG>)) {
if ($line =~ /^\s*0:00\s*-+$/) {
if (scalar @game <= 1) {
push (@game, $line);
} else {
my $currentfilename = "${logdir}${filename}.log";
open (CURRENTLOG, ">", "$currentfilename");
foreach (@game) {print CURRENTLOG};
$filename++;
@game = ( );
push (@game, $line);
}

} else {
push (@game, $line);
}
}
close WOPLOG;
__END__


[andrew_bye]

тот лог-файл, что я выложил был маленьким кусочком реального 200-мегабайтного лога

Предупреждать надо.

[andrew_bye]

Тогда уж, наверное, лучше так.

Код: (Perl) [Выделить]

#!/usr/bin/perl

use warnings;
use strict;

my $filename = 0;
my $log = "ctl-server.log";
my $logdir = "ctl/";
my @game;

unless (-e -d $logdir) { mkdir $logdir, 0755 }

open (WOPLOG, "<", "$log") or die "Can't open file $log: $!";
while (<WOPLOG>)
{
  if ($_ =~ /^\s*0:00\s*-+$/o && @game) { &writeNewLog() }
  push @game, $_;
}
close WOPLOG;

&writeNewLog() if (@game);

sub writeNewLog
{
  my $currentfilename = $logdir.$filename.".log";
 
  open (CURRENTLOG, ">", "$currentfilename");
  while (@game) { print CURRENTLOG shift @game }
  close CURRENTLOG;
 
  $filename++;
}

__END__
П.С. Код желательно писать максимально читабельным, чтобы потом можно было легко понять логику его работы.

[buggykey]

Просто СУПЕР!

ПС
Подскажи пожалуйста, как можно так-же красиво оформлять перловый синтаксис?

ППС
Только я так и не понял, в чем в моем первом скрипте загвоздка была?...

[andrew_bye]

как можно так-же красиво оформлять перловый синтаксис?

Вместо тэга [cоde][/cоde] использовать [cоde=Perl][/cоde]

Только я так и не понял, в чем в моем первом скрипте загвоздка была?...

ХЗ. Иногда лучше переписать код заново, чел ломать голову над ошибками.

[buggykey]

ОК! По-любому, огромное спасибо!
Даже не думал, что так быстро получу помощь!

[andrew_bye]

Дело в том, что в первом скрипте код довольно "кучерявый" и поэтому не очень хочется в нём ковыряться.

Старайся составлять и форматировать код таким образом, чтобы можно было легко понять логику его работы.

[buggykey]

Дык я стараюсь, сублайм отступы делает, в нем все довольно наглядно видно, это здесь, кода скопировал текст - все слепое становится... Но я теперь знаю, как сделать, чтобы все наглядно видно было. Спасибо!