use strict; use warnings; use utf8; # =============== Nettoyer le .htm pour obtenir du XML correct ==================== sub net1($){ #txt - suppressions simples my( $txt ) = @_; my $er0 = ''; # supprime les 'xmlns' my $entete = ']>'; $txt =~ s/$er0/$entete/; my $er1 = '||'; my $er2 = '| |\x{0D}'; # 0x0D = 13 = CR my $er3 = '.*?'; my $er4 = 'class=MsoNormal|class=Section1'; $txt =~ s%$er1|$er2|$er3|$er4% %sg; #une espace est indispensable $er3 = '.*?'; $txt =~ s%$er3|%
%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 = ''; # avec charset="macintosh"" , guillemets ajoutés par le filtrage précédent my $htequ = ''; $txt =~ s%$hteqm%$htequ%; return $txt; }#net2 # ==================== Eliminer les span parasites ====================== # AVANT de capturer les zones "Amiran" ! sub net3($){ #txt my( $txt ) = @_; my $er = '|'; # on supprime les ancres "OLE_LINK" $txt =~ s%$er% %g; $er = '(\s*)'; $txt =~ s%$er%$1%sg; # idem des span "OLE_LINK" vides $er = '(.*?)'; $txt =~ s%$er%$1%sg; # ne contient jamais de $er = '(.*?)'; $txt =~ s%$er%$1%sg; # ne contient jamais de $er = '(.*?)'; $txt =~ s%$er%$1%sg; # APRÈS avoir supprimé les tab-count, ne contient PLUS de $er = ''; $txt =~ s%$er%%g; # on banalise les span "OLE_LINK" restants return $txt; }#net3 # ========================= Masis --> Unicode ========================== #table masis => arménien, 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_masis = (' ' , ' ', # le blanc est universel ! # tout le reste est pris ! '1', ':', '5', ',', '6', '-', '7', '.', '*', '(', '(', ')', ); sub tab_alim($$){ # 2 caractères my( $g, $a ) = @_; $tab_masis{$a} = $g; return 0; }#tab_alim sub init_masis(){ #procédure sans argument open(MASIS, "<:utf8", "ArmMasis.txt"); my $ligne = ; # sauter la 1ère ligne my @tab = ; my $txt = join('', @tab); my $er = '^(\p{Armenian})\s+(\p{ASCII})$'; $txt =~ s/$er/tab_alim($1, $2)/emg; }#init_masis #================= 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 = (' ' => 'ù', '' => 'é', '' => 'è', '' => 'à', '' => 'â', '' => 'ç', '' => '§', '
' => 'ß', '' => 'û', '' => 'ü'); my %msf_tab = ('ù' => ' ', 'é' => '', 'è' => '', 'à' => '', 'â' => '', 'ç' => '', '§' => '', 'ß' => '
', 'û' => '', 'ü' => ''); sub enc_msf($){ #chaine my( $chn ) = @_; my $er = '( |||||||
||)'; # à calculer depuis %tab_msf $chn =~ s%$er%$tab_msf{$1}%eg; return $chn; }#enc_msf sub tradCar($){ #caractère my( $car ) = @_; if( exists($tab_masis{$car}) ){ return $tab_masis{$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 ) = @_; $chn =~ s/>/>/g; # réduire les entités produites par le passage en HTML $chn =~ s/</' parasite dans la portée de 'Amiran' $txt =~ s%$ilot%''.tradChaine($1).''%eg; return $txt; }#tradsit #========================== Action ! ============================ open(ENTREE, "<:encoding(MacRoman)", $ARGV[0]); open(SORTIE, ">:utf8", $ARGV[1]); my @tab = ; my $txt = join('', @tab); my $tnt = net3(net2(net1($txt))); #net3( init_masis(); print(SORTIE tradsit($tnt));