#!/usr/bin/perl -w

#By: Luís Oliveira
#Last update: 2003/11/23

#Script que faz o parsing de um ou mais documentos HTML com eventos de um dado ano da
#segunda guerra mundial.
#Constroi uma hashtable em que a chave é a data e o valor é um array de eventos (strings)
#
# Note-se que eventos do tipo 1 sao todos aqueles que aparecem imediatamente a
# seguir ao dia ao passo que os de tipo 2 sao aqueles que aperecem numa segunda
# linha (começam por uma imagem em branco e por '-')

#TODO 
#

use locale;
use strict;
use Data::Dumper;

undef $/;
my %in;
my $year=-1;
my $month=-1;
my $day=-1;
my %hist;
my $file;
my $aux;
my $type="internacional"; #tipo do evento: por omissao é internacional
my $path;
my $descr;

my
%meses=(Janeiro=>'01',Fevereiro=>'02',Marco=>'03',Abril=>'04',Maio=>'05',Junho=>'06',Julho=>'07',Agosto=>'08',Setembro=>'09',Outubro=>'10',Novembro=>'11',Dezembro=>'12');

{
package Pck;
require HTML::Parser;
@Pck::ISA = qw(HTML::Parser);

sub start {  
   my($self,$tag,$attr,$attrseq,$orig) = @_;
 
   if($tag eq 'font' && defined($attr->{size}) && $attr->{size} eq "2"){
	$in{"font2"}=1;
   }

   $in{$tag}=1;
}


sub text {
  my ($self,$text) = @_;
  my $aux;
  my $texto = HTML::Entities::decode($text); #para descodificar as entidades HTML

  if ($type eq "nacional") {
	if ($texto =~ /\s*([A-ZÉ].*\.)\s*/s) {
	   $aux = filtraEspacos($1);        
	   push(@{$hist{"$year/$month/$day"}},[$aux,"nacional"]);            }
  }
  
  if($texto =~ /\s*Em Portugal\s*:/si) {
       $type="nacional";
  }

  if ($in{'title'} && $in{'title'}==1) {
     $texto =~ /(19\d{2})/s; #foi reconhecido um novo ano
     $year = $1;
  } else {
	if ($in{'font2'} && $in{'font2'}==1) { #foi reconhecido um novo evento
	
		if ($texto =~ /^\s*\-\s*([A-ZÉ].*\.)\s*$/s) { #evento tipo 2 
			$aux = filtraEspacos($1);        
			push(@{$hist{"$year/$month/$day"}},[$aux,"internacional"]);
		} 
		elsif ($texto =~ /^\s*([A-ZÉ].*\.)\s*$/s) { #evento do tipo 1
			$aux = filtraEspacos($1);        
			push(@{$hist{"$year/$month/$day"}},[$aux,"internacional"]);
		}
	} 
 
	
	if ($in{'b'}) {
		if ($texto =~ /^\s*(\d{1,2})\s*\.\s*$/) { #foi reconhecido um novo dia
		    $day = normalizaDia($1); 
		} elsif ($texto =~ /^\s*(\d{1,2})\s*([-ae])\s*(\d{1,2})\s*\.\s*$/) {
		    $day = normalizaDia($1)." $2 ".normalizaDia($3);							
		} elsif ($texto =~ /\s*(\w+)\s*/ && $meses{$1}) {  #foi reconhecido um novo mês
			$month=$meses{$1}; 
		}
        }
  }
}


sub end {
    my ($self,$tag,$origtext) = @_;
    
   if($tag eq 'font') {
	$in{"font2"}=0;
   }
   
   if($tag eq 'blockquote') {   #Os eventos nacionais terminam sempre num blockquote
	$type="internacional";
   }

   $in{$tag}=0;
}


sub filtraEspacos {
   my $str=shift;
   $str =~ s/\n//g;
   $str =~ s/ {2,}/ /g;
   $str =~ s/\t//g;
   $str;
}

#função que normaliza os dias para terem todos 2 digitos
sub normalizaDia {
  my $dia=shift;

  if ($dia =~ /^\d$/) {
      $dia = '0'.$dia;
  }
  $dia;
}


} #fim do package


if (scalar(@ARGV) < 2) { 
    die ("Usage: $0 \"Descrição\" file1.html file2.html file3.html");
}

#descrição da cronologia (1º argumento da linha de comando)
$descr = shift;

while ($path=shift) {  #ciclo que é aplicado a cada um dos argumentos da script
  open (FILE,$path) || die("Nao é possivel abrir o ficheiro $_");
  while(<FILE>) {
    $file = $_;
    $file =~ s/<i>//gi;
    $file =~ s/<\/i>//gi;  #retirar os italicos do documento HTML
    $file =~ s/Março/Marco/gi;  #retirar os italicos do documento HTML
  }

  my $p = Pck->new;
  $p->parse($file) || die $!;
  close(FILE);
}


#print count();
print toString_f();
#print toString();


### FUNÇÔES DE VISUALIZAÇÂO DOS REGISTOS ###############################

#função que devolve uma String com os registos
sub toString {
  my $aux;
  my $res="";
  
  for $aux (sort(keys(%hist))) {
     $res .= $aux." --->  ".Dumper($hist{$aux});
  }
  $res;
}


#função que devolve uma string com os registos e de acordo com o formato
#escolhido para os ficheiros das cronologias
sub toString_f {
  my $i;
  my $j;
  my $res = ">> $descr\n";
  $res .= "!!lang:pt_PT\n\n";

  for $i (sort(keys(%hist))) {
     for $j (@{$hist{$i}}) {
        if ($i =~ m@^(\d{4}/\d{2}/\d{2})$@) {  # acontecimentos de um só dia 
     	   $res .= "[$i]\n";
	} elsif ($i =~ m@^(\d{4}/\d{2})/(\d{2})\s*[ae-]\s*(\d{2})$@i) { # acontecimentos de vários dias
     	   $res .= "[$1/$2][$1/$3]\n";
	}
         
        $res .= "!!keyword:".$j->[1]."\n";
	$res .= $j->[0]."\n\n";
	}
   }
  $res;
}

#função que conta o número de registos
sub count {
   my $aux = scalar(keys(%hist));
}