use strict;
use warnings;
use utf8;

# =============== Nettoyer le .htm pour obtenir du XML correct ====================

sub net1($){ #txt - suppressions simples
my( $txt ) = @_;

	my $er0 = '<html(.*?)>'; # supprime les 'xmlns'
	my $entete = '<?xml version="1.0"?><!DOCTYPE html [<!ENTITY nbsp "&#160;">]>';
	$txt =~ s/$er0/$entete<html>/;
	
	my $er1 = '<!--(.*?)-->|<link (.*?)>|<meta name=(.*?)>';
	my $er2 = '<o:p></o:p>|<!\[if !supportEmptyParas\]>&nbsp;<!\[endif\]>|\x{0D}'; # 0x0D = 13 = CR
	my $er3 = '<!\[if !supportLists\]>.*?<!\[endif\]>';
	my $er4 = 'class=MsoNormal|class=Section1';
	
	$txt =~ s%$er1|$er2|$er3|$er4% %sg; #une espace est indispensable
	
	$er3 = '<!\[if !supportLineBreakNewLine\]>.*?<!\[endif\]>';
	$txt =~ s%$er3|<br.*?>%<br/>%sg;
	
	return $txt;
}#net1


sub net2($){ #txt - rectifier les valeurs d'attributs
my( $txt ) = @_;
	
	my $er = '\s(\p{L}+)=(\p{L}+)'; 
	# '\s' au début seulement, pas '\s(\p{L}+)=(\p{L}+)\s' 
	# qui en demande 2 consécutifs entre deux attr...
	
	$txt =~ s/$er/ $1="$2"/g;

	my $hteqm = '<meta http-equiv=Content-Type content="text/html; charset="macintosh"">';
	# avec charset="macintosh"" , guillemets ajoutés par le filtrage précédent
	my $htequ = '<meta http-equiv="Content-Type" content="text/html; charset=utf8"/>';
	
	$txt =~ s%$hteqm%$htequ%;
	return $txt;
}#net2

# ==================== Eliminer les span parasites ======================
# AVANT de capturer les zones "Amiran" !

sub net3($){ #txt
my( $txt ) = @_;

	my $er = '<a name="OLE_LINK\d+">|</a>'; # on supprime les ancres "OLE_LINK"
	$txt =~ s%$er% %g;

	$er = '<span\s+style=\'mso-bookmark:\s?OLE_LINK\d+\'>(\s*)</span>';
	$txt =~ s%$er%$1%sg; # idem des span "OLE_LINK" vides
	
	$er = '<span\s+style="mso-spacerun: yes">(.*?)</span>';
	$txt =~ s%$er%$1%sg;  # ne contient jamais de <span>
	
	$er = '<span\s+style=\'mso-tab-count:(?:\s+)?\d\'>(.*?)</span>';
	$txt =~ s%$er%$1%sg; # ne contient jamais de <span>
	
	$er = '<span\s+style=\'mso-font-kerning:8.0pt\'>(.*?)</span>';
	$txt =~ s%$er%$1%sg; # APRÈS avoir supprimé les tab-count, ne contient PLUS de <span>
	
	$er = '<span\s+style=\'mso-bookmark:\s?OLE_LINK\d+\'>';
	$txt =~ s%$er%<span>%g; # on banalise les span "OLE_LINK" restants
	
	return $txt;
	
}#net3
# ========================= Amiran --> Unicode ==========================

#table amiran => géorgien, sera remplie au lancement du script
#on y loge a priori les caractères dont on sous-entend la mise en œuvre
#il faut tout dire pour pouvoir détecter les manques lors de la mise au point
my %tab_amiran  = (' ' , ' ', # le blanc est universel !
				   '-', '-',  # on conserve le trait d'union
				   '?', '?',  # le point d'interrogation
				   '!', '!',  # le point d'exclamation
				   ',', ',',  # la virgule
				   '.','.' ,  # le point
				   '=', '=',  # le signe =
				   ':', ':',  # deux-points
				   ';', ';',  # point-virgule
				   '(', '(',  # les deux
				   ')', ')',  # parenthèses
				   '/', '/',  # l'oblique
				   ); 

sub tab_alim($$){ # 2 caractères
my( $g, $a ) = @_;

	$tab_amiran{$a} = $g;
	return 0;
}#tab_alim

sub init_amiran(){ #procédure sans argument

	open(AMIRAN, "<:utf8", "GeorgAmiran.txt");
	my $ligne = <AMIRAN>; # sauter la 1ère ligne
	
	my @tab = <AMIRAN>;
	my $txt = join('', @tab);
	
	my $er = '^(\p{Georgian})\s+(\p{Latin})$';
	$txt =~ s/$er/tab_alim($1, $2)/emg;
}#init_amiran

#================= Traitement de la mise en forme =================
# comme caractères de substitution on choisit des lettres accentuées,
# qui ne font certanement pas partie du code Amiran,
# et on les écrit en UTF-8 !

my %tab_msf = ('&nbsp;' => 'ù', '<b>' => 'é', '</b>' => 'è', '<i>' => 'à', '</i>' => 'â', 
				'<span>' => 'ç', '</span>' => '§', '<br/>' => 'ß');
my %msf_tab = ('ù' => '&nbsp;', 'é' => '<b>', 'è' => '</b>', 'à' => '<i>', 'â' => '</i>',
				'ç' => '<span>', '§' => '</span>', 'ß' => '<br/>');

sub enc_msf($){ #chaine
my( $chn ) = @_;
	my $er = '(&nbsp;|<b>|</b>|<i>|</i>|<span>|</span>|<br/>)'; # à calculer depuis %tab_msf
	$chn =~ s%$er%$tab_msf{$1}%eg;
	return $chn;
}#enc_msf

sub tradCar($){ #caractère
my( $car ) = @_;
	if( exists($tab_amiran{$car}) ){
		return $tab_amiran{$car};
	}elsif( exists($msf_tab{$car}) ){
		return $msf_tab{$car}; # décodage msf au vol
	}else{
		die("Inconnu : ".ord($car)." = $car\n");
	}
}#tradCar

sub tradChaine($){ # chaîne Amiran
my( $chn ) = @_;
#print "$chn\n";
	$chn = enc_msf($chn);
	$chn =~ s/(.)/tradCar($1)/eg;
	return $chn;
}#tradChaine

# ====================== Traduire "in situ" =======================

sub tradsit($){ #txt
my( $txt ) = @_;

	my $pre1 = 'lang="FR"\\s+';
	my $pre2 = 'font-size:\\s?\\d+\\.\\dpt;\\s*';
	my $post = ';\\s*(?:mso-font-kerning:\\d\\.0pt|font-style:\\s?normal|font-weight:\\s?normal)';
	my $ilot = "<span\\s+(?:$pre1)?style='(?:$pre2)?font-family:\\s?Amiran(?:$post)?'>(.*?)</span>";
	# Attention ! Il ne doit plus rester de '</span>' parasite dans la portée de 'Amiran'
	$txt =~ s%$ilot%'<span>'.tradChaine($1).'</span>'%eg;
	return $txt;
}#tradsit

#========================== Action ! ============================

open(ENTREE, "<:encoding(MacRoman)", $ARGV[0]);
open(SORTIE, ">:utf8", $ARGV[1]);
my @tab = <ENTREE>;
my $txt = join('', @tab);
my $tnt = net3(net2(net1($txt))); #net3(

init_amiran();
print(SORTIE tradsit($tnt));
