#!/usr/bin/perl -w

use locale;
use strict;
#undef $/;

use lib qw(../lib);    
use Chronology;

#####
#TODO Geral

#####
#Main
my $env = process_args(@ARGV);

die("Error: Template::Extract is not installed\n") unless (is_installed('Template::Extract'));
die("Error: Data::Dumper is not installed\n") unless (is_installed('Data::Dumper'));
die("Error: There's no config file\n") unless (-e $env->{config});
die("Error: Config file is not readable\n") unless (-r $env->{config});

use Template::Extract;
use Data::Dumper;
my $templates = process_config();
my $doc = normalize($env->{filename});
my $struct = extract_t($templates,$doc);
my $chronl = to_chronl($struct); 
output_info($chronl);
validate($chronl) unless (defined($env->{validate}) && $env->{validate} =~ /false/i);

#####
#Functions
# process_args -> process command line arguments and returns 
# <= module name 
# => bool
sub process_args {
   my @args = @_;
   my (%vars,$temp);

   if (scalar(@args) % 2 != 1) {
      die ("Error: Invalid number of arguments\nUsage: $0 [Options] file.html\n");
   }

   while (scalar(@args) > 1) {
      if (defined($temp)) {
	$vars{$temp} = shift(@args);
	undef($temp);
      } else {
	$temp = shift(@args);
      }	      
   }	  
  
   $vars{filename} = shift(@args);
   $vars{config} = 'config_extract' unless (defined($vars{config}));
   
   return(\%vars);
}	



# verify if a module is installed
# <= module name 
# => bool
sub is_installed {
  my $module = shift;
   
  my $com = "use $module;\n";
  eval($com);

  return(0) if ($@);
  return(1);
}

#process config file
# <= null
# => array
sub process_config {
  open(FILE,$env->{config});
  my ($doc,%records,$block,$type,$format);
  my $space = '[% /\s*/ %]';
   
  while(<FILE>) {
       $doc .= $_;
  }
       
  $doc =~ s/\#.*//g; #deleting comments
  $doc =~ s/\r//g; #deleting carriage return

  for my $record (split(/\-{3,}/,$doc)) {
     #extracting information from records
     $record =~ /block\s*=\s*(\w+)/i; $block = $1;
     $record =~ /type\s*=\s*(array|string)/i; $type = lc($1);
     $record =~ /format\s*=\s*(.*)/i; $format = $1;
  
     $records{$block} = {type => $type};
     unless (defined($block) && defined($type) && defined($format)) {
     	die("Error: It's not possible to recognize all the fields of a config file record\n");
     }	
     
     #generating template
     if ($type eq "string") {
	     $records{$block}{'template'} = '<!--'.$space.'BEGIN '.$block.$space.'-->'.
	     				    $format.
					    '<!--'.$space.'END '.$block.$space.'-->';
     } elsif ($type eq "array") {	
	$records{$block}{'template'} = '<!--'.$space.'BEGIN '.$block.$space."-->\n".'[% FOREACH record %]'."\n".
					 $format.
					 "\n".'[% END %]<!--'.$space.'END '.$block.$space.'-->';
     }
     undef($block);
     undef($type); 
     undef($format);
    }
  return(\%records);
}


#normalize -> normalize a html file
# <= filename
# => string
sub normalize {
   my $filename = shift;
   my $doc;
   open(FILE, $filename) or die("Couldn't open file ${filename}: $!\n");

   while (<FILE>){
     my $aux = $_;   
     if ($aux =~ /\S/) { #considering only non-blank lines
	$aux =~ s/^\s+//g;  #deleting initial spaces 
	$aux =~ s/\r//g;
	
	$aux =~ s/([^\-]>)\s*\n$/$1/;   #when a line ends with a tag
	$aux =~ s/([^\>])\s*\n$/$1 /;	#otherwise
	
	#deleting spaces between html tags
	my $tag = "<[^>]+>"; #TODO Precisa de ser revisto -> ver linha do BEGIN EVENTS
	$aux =~ s/\s*($tag)\s*($tag)/$1$2/g;
  	
	#deleting 2 or more spaces between words
	$aux =~ s/(\S+)\s{2,}(\S+)/$1 $2/g;

	#TODO deleting html coments
	$doc .= $aux;
     }
   }

   if (defined($env->{debug}) && $env->{debug} == 4) {
      print STDERR "HTML FILE NORMALIZED\n\n$doc\n\n";
   }      
   
   $doc;
}

#extract -> extract information from a html file with a hash of templates
# <= document,hash ref
# => hash ref
sub extract_t {
   my ($templates,$doc) = @_;
   
   if (defined($env->{debug}) && ($env->{debug} == 2 or $env->{debug} == 3)) {
	eval('$Template::Extract::DEBUG = 1');
   }	   
   
   my $obj = Template::Extract->new;
   my %struct;

   for my $block (keys(%$templates)) {
	my $temp = $obj->extract($templates->{$block}{template},$doc);

	if(defined($temp)) { #if everything works well 
	   $struct{$block} = $temp;
	   print STDERR "Block $block is correctly extracted\n"; 
	} else {
	   print STDERR "Warning: I couldn't extract the block $block\n"; 
       }
   }
  return(\%struct); 
}

#generates chronl acording to the struct created
# <= struct
# => string
sub to_chronl {
  my ($struct) = @_;
  my $res = "#chronology generated by chron_extract.pl\n";
  
  if (defined($struct->{NAME})) {
     $res .= ">> ".$struct->{NAME}->{name};     
  }

  if (defined($struct->{IDCHRON})) {
     $res .= ' {'.$struct->{IDCHRON}->{idcron};     
  }
  
  $res .= "\n";
  
  if (defined($struct->{KEYWORDS})) {
     my @arr = split(',',$struct->{KEYWORDS}->{keywords});
     if (scalar(@arr) > 0) {
       $res .= '!!keyword:'.join(';',@arr)."\n";
     }	     
  }
  
  $res .= "\n";
  if (defined($struct->{EVENTS})) {
	  
    #date (it's not permitted a start date and a end date)
    for my $record (@{$struct->{EVENTS}->{record}}) { 
	  if (defined($record->{year}) or defined($record->{month}) or defined($record->{day})) {
    		$res .= '[';
		
		#year
		if (defined($env->{year})) {
			$res .= $env->{year}.'/'; 
		} elsif(defined($record->{year})) {
			$res .= $record->{year}.'/';
		}
		
		#month
		my $month;
		if(defined($env->{month})) {
		   $month = $env->{month};
		} elsif (defined($record->{month})) {
		   $month = month2digits(clean_str($record->{month}));
		}

		if (defined($month) && $month != -1) {
			$res .= sprintf("%02d",$month).'/'; #2 digits for months
                }			
		
		if (defined($record->{day})) {
		   $res .= sprintf("%02d",$record->{day}); #2 digits for days
		}
		
		$res .= ']';
	  }

     #event name
     $res .= get($record,'name',' ','');
     
     #event id
     $res .= get($record,'id',' {','}');
     
     $res .= "\n";
     
     #event description
     $res .= get($record,'description','',"\n\n\n");
     }
  }
  
  $res;
}


#get a value from a hash if key exists
# <= hash, key, string_i, string_f
# => string
sub get {
   my ($hash,$key,$before,$after) = @_;
   my $res = '';
   
   if (defined($hash->{$key})) { $res = $before.clean_str($hash->{$key}).$after; }
   $res; 
}	


#convert a textual month to a numerical month (in english or portuguese)
# <= string
# => int
sub month2digits {
   my ($month) = @_;
   my $res=-1;

   my %months = ('january' => 1,'february'=>2, 'march'=>3, 'april'=>4,
	   'may'=>5,'june'=>6, 'july'=>7, 'august'=>8, 'september'=>9,
	   'october'=>10, 'november'=>11, 'december'=>12,
            'janeiro' => 1,'fevereiro'=>2, 'março'=>3, 'abril'=>4,
	   'maio'=>5,'junho'=>6, 'julho'=>7, 'agosto'=>8, 'setembro'=>9,
	   'outubro'=>10, 'novembro'=>11, 'dezembro'=>12);
   
   if ($month =~ /^\d{1,2}$/ && $month >= 1 && $month <= 12){  #month is already in numerical format
      $res = $month;
   } else {      
      $res = $months{lc($month)};
   }
   return ($res);
}

#clean the initial and end spaces of a string
# <= string 
# => string
sub clean_str {
  my $str = shift;
  $str =~ /^\s*(.*?)\s*$/;
  my $res = $1;
}  


#outputs the information
sub output_info {
   my $data = shift;
   if (defined($env->{debug}) && $env->{debug} == 2) {
      print STDERR "\n\n".Dumper($struct);
   } else {   
      if (defined($env->{outfile})) {
         open(OUTFILE,">$env->{outfile}") or die("Error: I can´t open file $env->{outfile} for writing\n"); 
         print OUTFILE $data;
	 close(OUTFILE);
      } else {	 
	 print STDERR "\n\n";
         print $data;
      }
  }
}

#validates the chronl code generated
sub validate {
    my $content = shift; 
    my ($c,$file);
    
    
    if (defined($env->{outfile})) {
	$file = $env->{outfile};
    } else {
	$file = '._temp_validate';
	open(FILE_TEMP,">$file") or die("Error: I can't create the validate file\n");
	print FILE_TEMP $content;
	close FILE_TEMP;
    }
    
    print STDERR "\nExaminating the generated file...\n\n";
    
    $c = new Chronology();
    eval('$c->load(\'chronl\',$file);');
    if ($@) {
	  print STDERR "The file is not valid with the chronl grammatic! You'll have to change it by hand.\n\n";
	  #print STDERR $@;	  
    } else {
	  print STDERR "The file is valid with the chronl grammatic\n";
    }

    #deletes the temporary file
    if ($file eq '._temp_validate') {
	unlink $file;	
    } 
}



########
#POD

=head1 NOME

Chron_extract - extractor de cronologias web 

=head1 DESCRIÇÃO 

Chron_extract é uma script feita em Perl para extrair cronologias a partir de
páginas web. Utilizando o módulo B<Template::Extract>, esta script reconhece
informação presente em documentos HTML, gerando I<ficheiros chronl> que são
interpretados pelo I<módulo Chronology>. A sua utilização passa apenas por etiquetar o
documento Html que contém a informação e escrever um ficheiro de configuração
onde são indicados os blocos de informação a extrair.

Para testar a script, invocar 

C<./chron_extract.pl config config_extract_1807 outfile inv1807.cl year 1807 inv1807.html>

e consultar o ficheiro inv1807.cl gerado.

=head1 INVOCAÇÃO 

C<chron_extract.pl [OPTIONS] ficheiro.html>

A secção OPTIONS é do tipo 'chave valor' em que as chaves e valores possíveis
são:

=over 4 

=item debug 1|2|3|4 

Permite especificar o nível de debug que se pretende. Existem 4 níveis de
debug (de 1 a 4). Para saber melhor o que representa cada um deles, consulte a secção
DEBUG. 

=item config conf_file

Permite indicar o I<path> para o ficheiro de configuração. Omitindo esta opção, é utilizado o
ficheiro ./config_extract para leitura das configurações.

=item year yyyy 

Permite indicar o ano da cronologia (no caso de todos os eventos
terem decorrido no mesmo ano).

=item month mm

Permite indicar o mês - em formato numérico - da cronologia (no caso de todos os eventos
terem decorrido no mesmo mês).

=item outfile file.cl

Permite especificar um ficheiro chronl para guardar a informação gerada. Por
omissão, é utilizada a standard Output.

=item validate true|false

Permite fazer uma validação final do código chronl gerado. Por omissão, o valor
é true. 

=back

=head2 Notas:

Em relação à invocação da script convém ter em conta que:

=over 4

=item i) 

A ordem pela qual são especificadas as várias OPTIONS é irrelevante. Contudo, o
path para o ficheiro deverá ser sempre o último argumento. Nunca
poderá vir no bloco de I<options>.

=item ii) 

As opções I<year> e I<month>, sendo especificadas, têm prioridade sobre uma
string para captar o mês ou o ano no meio do texto. Dada a facilidade com que
são passadas estas opções, recomenda-se fortemente a sua utilização no caso de
todos os eventos da cronlogia extraída terem ocorrido num mesmo ano e/ou mês.

=back


=head1 FICHEIRO DE CONFIGURAÇÃO

É composto por um conjunto de blocos separados por uma linha tracejada (-------). 
Cada bloco é constituído necessariamente por 3 campos: block (nome do bloco),
type (tipo do bloco) e format (formato do bloco).

=over 4

=item block

Nome do bloco a extrair. É especialmente importante porque vai permitir
identificar uma dado bloco no documento html.

Existem vários blocos possíveis:

=over 6

=item i) 
NAME (tipo String) 

nome da cronologia

=item ii) 
IDCHRON (tipo String) 

identificador da cronologia

=item iii) 
EVENTS (tipo Array) 

bloco de eventos que compõem a cronologia. Em
cada evento, podem-se utilizar os campos I<year>, I<month>, I<day>, I<name>, I<id> e
I<description> referentes a um evento.

=item iv) 
KEYWORDS (tipo String) 

conjunto de palavras-chave da cronologia

=back

=item type

Tipo de um bloco. Pode ser uma I<string> se for para extrair uma frase ou
um I<array> se se pretender extrair um conjunto de linhas que seguem um dado
formato. 

=item format

Formato de um bloco. Segue a sintaxe do I<Template::Extract> pelo que recomenda-se a 
leitura da documentação deste módulo.
Convém saber que sempre que se pretende extrair um campo c1 de uma frase, temos 
de colocar C<[% c1 %]>. Recomenda-se também que, entre dois
blocos onde possa haver espaços no documento html, se inclua a etiqueta C<[% /\s*/ %]>.
No cado das strings, só é admissível um campo: a própria string. O nome do
campo deverá ser igual ao do bloco mas em minúsculas. Nos blocos do tipo array,
existem campos associados a cada bloco. Para ver os campos disponíveis em cada
bloco, consultar a secção anterior I<block>.

Convém perceber que cada bloco é constituído por vários campos no caso dos
arrays ou de um só campo no caso das strings. Todos os campos seguem o seguinte
esquema: C<[% c %]> em que 'c' é o nome do campo.

=back

Como exemplo, está disponível o ficheiro de configuração do documento
I<inv1807.html>.


=head1 ETIQUETAGEM 

A etiquetagem do documento Html é muito simples. Basta colocar C<<!--BEGIN nome_bloco-->>
e C<<!--END nome_bloco-->> no início e fim de cada bloco.
Recomenda-se que, no caso de blocos do tipo I<String> a etiqueta BEGIN e END seja
colocada imediatamente antes e depois do texto a extrair. No caso do tipo I<Array>,
recomenda-se que se crie uma nova linha quer para a etiqueta BEGIN quer para a
etqiueta END (ver ficheiro inv1807.html como exemplo).
Quer a etiqueta BEGIN como a END, estão em forma de comentário HTML pelo que
a sua coloção nos documentos não altera a forma como eles são visulalizados 
pelos browsers. Pareceu-nos mais sensata esta abordagem do que aquela que foi
seguida no desenvolvimento do módulo WWW::Extractor.


=head1 DEBUG 

Através da opção I<debug>, é possivel obter informação adicional sobre o
comportamento da script. Pode ser muito útil no caso da ocorrência de erros.

Existem 4 niveis de debug:

=over 4

=item 1 

nível mínimo de debug (valor por omissão)

=item 2 

é feito um I<dumper> da estrutura que armazena a informação extraída

=item 3 

além do que é feito nos níveis anteriores, são mostradas todas as expressões
regulares utilizadas na processo de extração. Note-se que esta informação é gerada pelo 
módulo I<Template::Extract>.  

=item 4 

mostra apenas o ficheiro html normalizado (antes de ser processado)

=back

Toda a informação de debug é enviada para a Standard Error (STDERR).

Aconselha-se que quando se utilize a opção I<debug>, seja também utilizada a opção
I<outfile> para se poder distinguir a informação de debug com o código chronl.

=head1 VALIDAÇÃO 

O chron_extract não garante que o ficheiro gerado esteja de acordo com a gramática 
do chronl. Em muitos casos, o código gerado constitui apenas uma aproximação que deverá ser 
revista e completada pelo utilizador final.
Assim, existe uma opção I<validate> que por omissão está activada e que valida o ficheiro
gerado. Desta forma, o utilizador fica com uma ideia do estado da cronologia gerada.

=head1 NORMALIZAÇÃO

Para mais facilmente extrair a informação do documento HTML, é-lhe feito uma
normalização que permite remover, entre outras coisas, espaços adicionais ou
mudanças de linha.

=head1 EXEMPLOS 

Como exemplo, está disponível um documento Html contendo uma cronologia das
invasões francesas em 1807 (inv1807.html) e o ficheiro de configuração
(config_extract_1807). O documento Html foi obtido no do Portal de História
(www.arqnet.pt) e está disponível em http://www.arqnet.pt/portal/portugal/invasoes/inv1807.html 

Invocando
C<$./chron_extract.pl config config_extract_1807 outfile inv1807.cl year 1807 inv1807.html>

produziria o seguinte output

C<Block NAME is correctly extracted>

C<Block KEYWORDS is correctly extracted>

C<Block EVENTS is correctly extracted>


C<Examinating the generated file...>

C<The file is valid with the chronl grammatic>

=head1 AUTOR 

Luis Oliveira - luis.oliveira@montemuro.org

=head1 VER TAMBÉM

Dado que o módulo I<Template::Extract> tem uma grande importância nesta script,
recomenda-se a leitura dos seguintes documentos:

=over 4

=item Documentação da versão 0.35 do módulo (mais recente)

http://search.cpan.org/~autrijus/Template-Extract-0.35/lib/Template/Extract.pm

=item Artigo da Oreilly sobre o módulo Template::Extract

http://www.oreillynet.com/pub/a/javascript/excerpt/spiderhacks_chap01/

=item Exemplo de utilização do Template::Extract

http://www.perladvent.org/2003/5th/

=back

Recomenda-se também a leitura da documentação do módulo I<Chronology> uma vez
que esta script serve de suporte a esse módulo. 

=cut