| Revision 296 (by ahitrov, 2013/03/26 17:59:01) |
Promosite (anthill) project source
|
package IIR_Parser;
use strict;
use locale;
use vars qw ($VERSION); $VERSION=0.1;
#use LogPool;
my %default_params = (
'field_name_length' => 132 ,
'debug' => 0,
'save_path' => undef,
'err' => undef,
);
##################### СЧИТЫВАНИЕ СЛЕДУЮЩЕГО СИМВОЛА
sub getchar {
my $self = shift;
$self -> {_CHAR} = getc ($self->{'_FH'}) ;
## $self -> {err}->handle('debug', "Got char =$self->{_CHAR}=\n");
return $self -> {_CHAR} ;
}
###################### КОНСТРУКТОР
sub new {
my ($class, %params ) = @_;
my $self = { };
foreach ( keys %default_params ) {
$self->{ $_} = exists $params {$_} ? $params {$_} : $default_params {$_} ;
}
bless ($self,$class);
my $input_path = $params{'input_path' };
if( defined $input_path ) { # Откроем файл
( -d $input_path ) || $self -> {err}->handle('fatal', "IIR ($input_path) : is not a directory\n");
my $input_file_name = $input_path."/.IIR";
$self->{_FH} = IO::File -> new ("< $input_file_name") || $self -> {err}->handle('fatal', "Unable to open $input_file_name : $! \n" );
} else { # Приготовимся читать из STDIN
$self->{_FH} = \*STDIN;
}
my $char = $self->getchar ; # Прочитаем и запомним первый символ
defined ( $char ) || $self -> {err}->handle('syntax',"Message is empty: cannot read first char\n");
$self -> ClearSpaces; # Пропустим пробелы в начале
return $self;
}
######################## ПРОПУСК ПРОБЕЛОВ
sub ClearSpaces {
my $self = shift;
my $char = $self -> {_CHAR} ;
while ( defined($char) && $char =~ /[\s\r\n]/ ) {
$char = $self->getchar ;
}
}
########################## ЧТЕНИЕ ИМЕНИ ПОЛЯ
sub GetFieldName { # Прочитаем имя поля IIR
my $self = shift;
$self->{debug} && $self->{err}->handle('debug',"GetFieldName\n");
my $char = $self -> {'_CHAR'} ;
my $ret = "";
while ($char =~ /\w/) { # Имя содержит только алфавитно-цифровые символы и подчеркивание
(length($ret) > $self -> {'field_name_length'} ) && $self->{err}->handle('syntax', "Field too long : ".length($ret)."\n");
$ret .= $char;
$char = $self->getchar;
defined($char) || $self->{err}->handle('syntax', "File ended while scanning for field name \n" );
}
defined($char) || $self->{err}->handle('syntax', "File ended between field name and expected colon\n");
( $char ne ':' ) && $self->{err}->handle('syntax', "Field name ".$ret.$char." does not end with colon\n");
# После имени должно идти двоеточие
$char = $self->getchar;
return $self -> {'_FIELD_NAME'}
= $ret ; # Запомним название поля
}
########################## ЧТЕНИЕ ЗНАЧЕНИЯ ПОЛЯ
sub GetFieldValue {
my ($self, %args) = @_;
$self->{debug} && $self->{err}->handle('debug',"GetFieldValue $self->{_FIELD_NAME}\n");
my $char = $self -> {'_CHAR'} ;
my $mode = $args {'mode'};
my $name = $args {'name'};
my $save = ($mode =~ /save/ ); # Режим записи значений полей в отдельные файлы
my $return = ($mode =~ /return/); # Режим возврата значений полей
my $check = ($mode =~ /check/); # Режим возврата значений полей
my $ret = "";
my $firstline = 1;
my $line_begin="";
my $type;
my $binary=0;
my $save_file = undef;
if ($save) { # Откроем файл для сохранения значения поля, если это надо.
defined ($self -> {'save_path'} ) || $self->{err}->handle('developer', "GetFieldValue with save option called without a defined save_path\n");
my $save_file_name;
my $instance_number;
do { # На случай множественных значений полей - если такой файл уже есть, припишем к его названию номер
$save_file_name = "$self->{save_path}/.$self->{_FIELD_NAME}$instance_number";
$instance_number++;
} while -f $save_file_name ;
$save_file = MP::WriteFile -> open ("$save_file_name") || $self->{err}->handle('fatal' , "Cannot open >$save_file_name\n" );
$ret = $save_file; # Возвращаемым значением будет сохраненный файл (объект класса MP::WriteFile)
}
return "" unless defined ($char) ; # Если тут EOF, делать больше нечего - вернем пустую строку
while ( $char =~/[ \t]/ ) { # Пропустим пробелы вначале (но не переводы строки!)
$char = $self->getchar;
return "" unless defined ($char);
}
if ($char eq "\n") { # Если в первой же строке пусто,
$char = $self->getchar; # Посмотрим, что дальше
return $ret if($char ne ' '); # Если там непробел -- это уже начало следующего поля, а данное - пустое. Возвращаемся.
$char = $self->getchar;
}
while (1) {
unless (defined ($char)) { # EOF: Заканчиваем читать.
$save_file->close if $save;
return $ret;
}
$ret = 1 if $check;
$ret .= $char if $return; # Припишем новый символ к значению поля
if ( $save && !($binary && $line_begin eq '' && $char eq ' ' ) ) {
$save_file->print($char) || $self ->{err}->handle('fatal',"Cannot write to $save_file->{path}\n")
} # Запишем новый символ в файл данного поля
# в двоичном поле если вдруг в начале строки окажется пробел, не пишем его
$line_begin .= $char if $char ne "\n" && ($binary || $firstline) && length($line_begin) < 8;
# Начало строки понадобится для определения типа поля и конца двоичного поля
$char = $self->getchar;
unless (defined ($char)) { # EOF: Заканчиваем читать.
$save_file->close if $save;
return $ret;
}
# Нас интересует тип поля. Если первая строчка начинается с begin, то это
# двоичный тип (uuencode), в противном случае - текст. В конце разбора первой строки мы
# уже должны знать тип, чтобы правильно разобрать следующую.
if ($char eq "\n" && $firstline ) { # Поэтому в конце первой строки определяем тип
$firstline = 0;
$binary = ($line_begin =~ /^begin\s/ );
}
# Во всех строках, кроме первой определяем, является ли данная строка продолжением
# поля или уже нет
if ($char eq "\n" ) { # Строка закончлась
if ($binary) { # Двоичное поле кончается словом end
if ($line_begin =~ /^end/ ) {
do { # После end пропустим все до первой буквы (названия следующего поля)
$char = $self->getchar;
} until !defined($char) || $char =~/\w/;
$save_file->print("\n") if $save;
$save_file->close if $save;
return $ret;
} else {
$line_begin ="";
next;
}
} else { # Для текстового поля признаком продолжения является пробел в начале строки
my $nextchar = $self->getchar;
if ( $nextchar && $nextchar eq ' ' ) {
$char = "\n";
next;
} else {
$save_file->close if $save;
while ( defined $nextchar && $nextchar eq "\n" ) { $nextchar =$self->getchar ; } # Пропустим пустые строки, если они там есть
return $ret;
}
}
}
}
}
############# Сброс остатка входного потока в файл
sub DumpTail {
my ($self,$file) = @_;
my $char = $self->{'_CHAR'};
while(defined($char)) {
(print {$file} $char ) || return undef;
$char = $self->getchar;
}
return 1;
}
########### Проверка конца входного потока
sub eof {
my $self = shift;
! defined $self->{'_CHAR'}
}
1;