package MP::IIR;
use strict;

use vars qw($VERSION @ISA @EXPORT);
use Error qw (:try);
$Error::Debug = 1;
use Text::Wrapper;
use IO::File;
$VERSION = 0.2;
my $Sendmail = "/usr/sbin/sendmail -t";
my $IIR_width     = 110;
my $BUFFER_LENGTH = 512;

@MP::IIR::FatalError::ISA = qw(Error::Simple);     		# Ошибка, приводящая к невозможности писать IIR
@MP::IIR::DataError::ISA = qw(Error::Simple);	    		# Ошибка в данных
{ 
  package MP::IIR::FatalError;
  sub stringify {
    my $self = shift;
    my $text = $self->SUPER::stringify;
    $text .= " \n Call stack: \n ". $self->stacktrace. "\n"  if $self->stacktrace;
    $text;
  }
} 
######################################  Конструктор - инициализатор. Открывает поток IIR и пишет туда заголовок.
sub new { 
 my ($class, %param ) = @_;
 foreach (qw(mtype_id  auth_id  password from to subject ) )  { 	 # Проверим, заданы ли необходимые параметры
    $param{$_}    					   || throw MP::IIR::FatalError("$_ is not specified");
 }

 my $self = {%param} ; 
 bless $self,$class;
} 
 #################################   Открывает IIR, Начинает писать в IIR
sub begin { 
 my $self=shift;
 $self->{_closed}					   && throw MP::IIR::FatalError ("Cannot activate the output when it is already closed ");
 $self->{_active}=1;

 if ( $self->{FILE}  ) {               				 # Выберем, куда писать IIR:
     print STDERR "Debug mode: write IIR to $self->{FILE} \n";
     $self->{FILE} ="&STDOUT" if $self->{FILE} eq '-';           # В файл ?
     $self->{_iir} = new IO::File(">".$self->{FILE})       || throw MP::IIR::FatalError ("Cannot open output file $self->{FILE}: $!");		 
 } else {							 # Сразу на sendmail
     $self->{_iir} = new IO::File("|$Sendmail -t ")        || throw MP::IIR::FatalError ("Cannot run $Sendmail: $!\n");
 }

#####  self->send_field("Error", $_[0]); } ;

								# Напишем заголовок IIR
 $self->{_iir}->print (
"To: $self->{to}
From: $self->{from}
Subject: $self->{subject}

MTYPE_ID: $self->{mtype_id}
AUTH_ID: $self->{auth_id}
PASSWORD: $self->{password}
") 							   || throw MP::IIR::FatalError ("Cannot write IIR header: $!");

}

###################################  Методы, гарантирующие целостность IIR

sub commit { 							# Успешно завершить посылку IIR
  my $self=shift;
  if ( $self->{_active} ) { 
     $self->{_iir}->close					   || throw MP::IIR::FatalError("Cannot close output stream");		
     $self->{_closed}  = 1;					#  Чтобы отсечь попытки в дальнейшем писать в закрытый файл.
     $self->{_active}  = 0;
  }
}

sub rollback { 							# Завершить посылку IIR в случае, если возникла ошибка, т.е.
  my ($self, $msg)  = @_;
  $self->send_field("Error", $msg) if ($msg);			#  записать сообщение об ошибке в выходной поток и все же послать его
  $self->commit;
}

sub DESTROY { 							# Удаление объекта IIR с незакрытым выходным потоком - ошибка
  $_[0]->{_active} 					           && throw MP::IIR::FatalError("IIR stream destroyed without explicit commit or rollback");	  
} 

################################### Методы для отправки содержательных фрагментов IIR 

sub send_field {                                                # Послать одно небольшое поле IIR или начало длинного поля IIR
  my ($self,$name,$value) = @_; 
  $self->begin unless $self->{_active};
  $value = iir_fix_val($value);
  chomp($value);
  $self->{_iir}->print("$name: $value\n") 		    || throw MP::IIR::FatalError ("Cannot write ($name, $value) to output stream: $!");
}

sub send_field_addition { 					# Послать строку - продолжение текущего поля
  my ($self,$value) = @_;
  $self->begin unless $self->{_active};

  $value = iir_fix_val($value);
  chomp($value);
  $self->{_iir}->print(" $value\n")		 	    || throw MP::IIR::FatalError ("Cannot write to output stream: $!");
}

sub send_file { 						# Послать поле, взяв его из файла
  my ($self, $name, $path) = @_; 
  $self->begin unless $self->{_active};

  my $in = IO::File->new("< $path")			   || throw MP::IIR::DataError ("Cannot read $path: $!\n");
  my $line=0;
  while(<$in>) { 
       chomp;
		   $_ = iir_fix_val($_);
       if ($line) { $self->{_iir}->print(" $_\n")          || throw MP::IIR::FatalError ("Cannot write to output stream: $!"); }
            else  { $self->{_iir}->print("$name: $_\n")    || throw MP::IIR::FatalError ("Cannot write to output stream: $!"); } 
       $line++;
  }
}

sub send_binary_file { 						# Послать файл в виде двоичного поля
  my ($self, $name, $dest_name, $path) = @_;			# Параметры: Название поля, название файла под которым он ложится в IIR, название файла как он доступен в ФС
  $self->begin unless $self->{_active};

  my $in = IO::File->new("< $path")			   || throw MP::IIR::DataError  ("Cannot read $path: $!\n")  ;
  $self->send_binary_fh($name, $dest_name, $in);

}

sub send_binary_fh { 						# Послать файл в виде двоичного поля 
  my ($self, $name, $dest_name, $fh) = @_;			# Параметры: Название поля, название файла под которым он ложится в IIR, filehandle
  $self->begin unless $self->{_active};

  return unless $self->{_iir};

  print STDERR "MP::IIR: $name: begin 644 $dest_name\n";
  $self->{_iir}->print("$name: begin 644 $dest_name\n")    || throw MP::IIR::FatalError ("Cannot write to output stream: $!"); 
  my ($chunk,$r);
  while( defined($r = read($fh,$chunk,45)) && $r > 0) { 
        $self->{_iir}->print(pack("u", $chunk))		   || throw MP::IIR::FatalError ("Cannot write to output stream: $!"); 
  }
  $self->{_iir}->print("`\nend\n\n")			   || throw MP::IIR::FatalError ("Cannot write to output stream: $!"); 
}

sub start_buffered_field { 
  my ($self,$name, $data) = @_;
  $self->begin unless $self->{_active};
  $self->{_iir}->print("$name: ") 		    	   || throw MP::IIR::FatalError ("Cannot write ($name, $data) to output stream: $!");
  $self->{buffer} = "";
  $self->continue_buffered_field($data);
}
sub continue_buffered_field { 
  my ($self, $data) = @_;
  $self->flush_buffered_field  if length($self->{buffer}) >= $BUFFER_LENGTH ;
  $self->{buffer} .=  $data;
}
sub end_buffered_field {
  shift->flush_buffered_field (1) ;
} 
sub flush_buffered_field { 
  my $self   = shift;
  my $at_end = shift;
  $self->{_iir}->print( iir_fix_val( $self->{buffer} ))  || throw MP::IIR::FatalError ("Cannot write buffer to output stream: $!");
  if ( $at_end ) {   			# переведем строку в конце поля
	$self->{_iir}->print("\n");
  } 
  $self->{buffer} = "";

}
###########################################  Вспомогательные методы 

sub iir_fix_val { 			# Почистить строку данных, помещаемую в IIR:
 my $val = shift;
 my $wrapper = Text::Wrapper->new(columns => $IIR_width );
    $val=~s/\n/ \n/g;                   # Чтобы WRAPPER не соединял слова, поставим пробел перед каждым переводом строки
    $val= $wrapper->wrap($val);         # Ограничим ширину текста
    $val=~s/\n*$//g;                    # Уберем пустые строки в конце
    $val=~s/\r//g;                      # и символы \r
    $val=~s/\n/\n /g;                   # Вставим пробелы в начале каждой строки, кроме первой
    $val=~s/[\0-\011\013\014\016-\037\177-\242\244-\262\264-\277]//g;
                                          # Уберем непечатные символы
    $val
}


1;


__DATA__

=head1 NAME
 CORE/lib/perl/MP/IIR.pm
=head1 SYNOPSIS

 my $iir = MP::IR->new(
	# For debugging: FILE => '/tmp/iir', turns off sending mail
        to       => 'robot@www.nature.ru', 
        from     => 'exotic@space.net',
	subject  => 'SUBMIT',
	mtype_id => 5, 
	auth_id  => $auth_id, 
	password => $password,
	itype_id => 'apod',
 );

 $iir->send_field("Title","Корова Баха\nи одинокий гитарист");
 $iir->send_field("SECT_ID",170100000);  # Фото дня 
 $iir->send_field("SECT_ID",120400000); # Астрономия 
 $iir->send_field("Body","Вставим пробелы в начале каждой строки, кроме первой");
 $iir->send_field_addition("И еще раз снова Вставим пробелы в начале каждой строки, кроме первой ");
 $iir->send_file("Abstract","/tmp/abstract.html");
 $iir->send_binary_file("Image","smallpicture.jpg","/usr/tmp/small.jpg");
 if ($disaster) { $iir->rollback($disaster_description);  }  
           else { $iir->commit;  }

=head1 Description
 
Данный модуль содержит методы для создания данных во входном формате Discovery (IIR)
 

=head1 Обработка ошибок
Ошибками  работы методов данного модуля являются ситуации, в которых 
невозможно начинать/продолжать/заканчивать выдачу выходного потока.

В таких ситуациях происходит throw MP::IIR::FatalError.

В остальных ненормальных ситуациях в выходной поток 
должно записываться сообщение об ошибке, а работа - продолжаться