Repository List / Contenido / utf8 / samples / promosuite / services / loader / lib / IIR_Parser.pm @ r296

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;