diff --git a/README.md b/README.md index fde53cb..6de3a6d 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,116 @@ valide-utf8 =============== -Programme pour vérifier la validité d’un fichier UTF-8 et le corriger si possible. \ No newline at end of file +Programme pour vérifier la validité d’un fichier UTF-8 et le corriger si possible. + + + +## valide_utf8.pl + +Programme qui vérifie que tous les caractères du texte sont bien codés en UTF-8 et sont considérés comme valides. Il signale également les caractères qui, bien que corrects en UTF-8, peuvent ne pas être acceptables suivant le contexte. Par exemple, les caractères de contrôle ne sont pas censés être présents dans un texte, une page HTML ou un fichier XML. De même, les caractères d’usage privé n’ont de sens que pour un programme donné. + +Dans le contexte de l’import des thèses d’exercice de l’UL sur Hal, ce programme est utilisé pour vérifier s’il n’y a pas de caractères parasites dans les notices Conditor, une erreur due à certains copier-coller depuis des documents PDF, notamment au niveau des résumés. + +Le code de retour après exécution du programme est : + + - 0 : fichier valide + - 1 : option(s) erronée(s) + - 2 : présence de caractères de contrôle ou d’usage privé + - 3 : présence de caractères interdits ou mal formés + + +### Usage + +```txt + valide_utf8.pl -f fichier [ -l log ] + valide_utf8.pl -h +``` + +### Options + +```txt + -f indique le nom du fichier d’entrée + -h affiche cette aide + -l indique le nom du fichier “log” +``` + +### Résultat + +En cas de fichier valide, le programme n’affiche rien. Autrement, il affiche le nom du fichier suivi de la liste des caractères invalides ou potentiellement problématiques. Ces caractères sont regroupés soit dans la rubrique `Erreurs`, soit dans la rubrique `Avertissements` suivant leur type. En plus du caractère ou de la séquence d’octets en cause, le programme indique le type d’erreur, parfois suivi d’un commentaire entre parenthèses ou du nombre d’occurrences lorsque ce nombre est supérieur à 1. + +Dans un répertoire contenant des fichiers XML à tester, la commande en *shell* est : + +```bash +for i in *.xml +do + valide_utf8.pl -f $i -l log.txt +done +``` + +On pourra obtenir un résultat du genre : + +```txt + ==> 2018LORR2078_232852677.xml <== + Avertissements : + Caractère d’usage privé '0xF0B7' (3 occurrences) + + ==> 2019LORR1039_236086766.xml <== + Avertissements : + Caractère d’usage privé '0xF0B1' (11 occurrences) + + ==> 2019LORR1054_236704621.xml <== + Erreurs : + Caractère interdit '0x0090' (2 occurrences) + + ==> 2019LORR1243_242220924.xml <== + Erreurs : + Caractère interdit '0xC0374' (plans réservés non attribués) + Caractère interdit '0xC0372' (plans réservés non attribués) (3 occurrences) + Caractère interdit '0xC0373' (plans réservés non attribués) (4 occurrences) + Caractère interdit '0xC0377' (plans réservés non attribués) (2 occurrences) + Caractère interdit '0xC0379' (plans réservés non attribués) (2 occurrences) + Caractère interdit '0xC020B' (plans réservés non attribués) (2 occurrences) + Caractère interdit '0xC037A' (plans réservés non attribués) + Caractère interdit '0xC020C' (plans réservés non attribués) + Caractère interdit '0xC037B' (plans réservés non attribués) +``` + +Le fichier *log*, lorsqu'il est demandé, contient la liste des fichiers testés et pour chaque occurrence d’un caractère ou d’une séquence d’octets invalides ou problématiques, le type d’erreur, la valeur du caractère ou de la séquence d’octets, le commentaire éventuel et la position en numéro de ligne, d’octet et de caractère. Par exemple : + +```txt +==> 2018LORR2076_232738580.xml <== +==> 2018LORR2078_232852677.xml <== + - Caractère d’usage privé '0xF0B7' [ligne 84, octet 1211, caractère 1175] + - Caractère d’usage privé '0xF0B7' [ligne 84, octet 1251, caractère 1213] + - Caractère d’usage privé '0xF0B7' [ligne 84, octet 1494, caractère 1449] + +==> 2018LORR2079_232855838.xml <== +==> 2018LORR2080_232740100.xml <== + ... +==> 2019LORR1054_236704621.xml <== + - Caractère interdit '0x0090' [ligne 8, octet 40, caractère 40] + - Caractère interdit '0x0090' [ligne 34, octet 46, caractère 46] + +==> 2019LORR1055_236713302.xml <== + ... +==> 2019LORR1243_242220924.xml <== + - Caractère interdit '0xC0374' (plans réservés non attribués) [ligne 78, octet 707, caractère 677] + - Caractère interdit '0xC0372' (plans réservés non attribués) [ligne 78, octet 711, caractère 678] + - Caractère interdit '0xC0373' (plans réservés non attribués) [ligne 78, octet 715, caractère 679] + - Caractère interdit '0xC0372' (plans réservés non attribués) [ligne 78, octet 719, caractère 680] + - Caractère interdit '0xC0377' (plans réservés non attribués) [ligne 78, octet 995, caractère 945] + - Caractère interdit '0xC0379' (plans réservés non attribués) [ligne 78, octet 1010, caractère 957] + - Caractère interdit '0xC020B' (plans réservés non attribués) [ligne 78, octet 1015, caractère 959] + - Caractère interdit '0xC037A' (plans réservés non attribués) [ligne 78, octet 1027, caractère 968] + - Caractère interdit '0xC0372' (plans réservés non attribués) [ligne 78, octet 1031, caractère 969] + - Caractère interdit '0xC020C' (plans réservés non attribués) [ligne 78, octet 1036, caractère 971] + - Caractère interdit '0xC020B' (plans réservés non attribués) [ligne 78, octet 1603, caractère 1517] + - Caractère interdit '0xC0373' (plans réservés non attribués) [ligne 78, octet 1612, caractère 1523] + - Caractère interdit '0xC0377' (plans réservés non attribués) [ligne 78, octet 1617, caractère 1525] + - Caractère interdit '0xC0379' (plans réservés non attribués) [ligne 78, octet 1621, caractère 1526] + - Caractère interdit '0xC0373' (plans réservés non attribués) [ligne 78, octet 1627, caractère 1529] + - Caractère interdit '0xC0373' (plans réservés non attribués) [ligne 78, octet 1632, caractère 1531] + - Caractère interdit '0xC037B' (plans réservés non attribués) [ligne 78, octet 1636, caractère 1532] + +==> 2019LORR1244_242514006.xml <== +``` diff --git a/valide_utf8.pl b/valide_utf8.pl new file mode 100755 index 0000000..85fde07 --- /dev/null +++ b/valide_utf8.pl @@ -0,0 +1,734 @@ +#!/usr/bin/perl + + +# Déclaration des pragmas +use strict; +use utf8; +use open qw/:std :utf8/; + +# Pragmas servant à détecter les variables et fonctions inutilisés, +# ce qui n’a d’intérêt qu’à l’écriture du script. +## use warnings::unused; +## use warnings 'once'; + +# Appel des modules externes de base +use Encode; +use Getopt::Long; + +my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; +my $Version = "1.4.4"; +my $dateModif = "25 Octobre 2022"; + +my $usage = "Usage : \n" . + " $programme -f fichier [ -l log ] [ -c fichier_correct ] [ -b ]\n" . + " $programme -h \n"; + +my $aide = undef; +my $bom = undef; +my $corrige = undef; +my $fichier = undef; +my $log = undef; + +eval { + $SIG{__WARN__} = sub {usage(1);}; + GetOptions( + "bom" => \$bom, + "corrige=s" => \$corrige, + "fichier=s" => \$fichier, + "help" => \$aide, + "log=s" => \$log, + ); + }; +$SIG{__WARN__} = sub {warn $_[0];}; + +if ( $aide ) { + print " \n"; + print "Programme : \n"; + print " “$programme”, version $Version ($dateModif)\n"; + print " Permet de vérifier que les caractères du texte sont bien codés \n"; + print " en UTF-8 et sont considérés comme valides \n"; + print "\n"; + print $usage; + print "\nOptions : \n"; + print " -b ajoute le BOM (Byte Order Mark) au début du fichier de sortie (ce qui \n"; + print " n’a de sens qu’en présence de l’option “-c”) \n"; + print " -c indique le nom du fichier de sortie avec la version corrigée du texte \n"; + print " -f indique le nom du fichier d’entrée \n"; + print " -h affiche cette aide \n"; + print " -l indique le nom du fichier “log” qui recevra une liste de tous les \n"; + print " caractères invalides ou interdits avec leur position dans le texte \n"; + print " \nCode de retour : \n"; + print " Si tous les caractères du fichier testé sont valides, le programme renvoie \n"; + print " le code de retour 0 (zéro). Sinon, le programme renvoie le code 1 en cas \n"; + print " d’erreur dans les options, le code 2 si le fichier contient des caractères \n"; + print " pouvant poser problème suivant le contexte et le code 3 si le fichier contient \n"; + print " des caractères interdits ou mal-formés \n"; + print " \nFichier corrigé : \n"; + print " Les caractères erronés sont remplacés dans la mesure du possible. Dans le cas \n"; + print " des jeux de caractères ISO 8859-1 (ISO latin-1) et ISO 8859-15 (ISO latin-15), \n"; + print " comme il n’est pas facile de savoir à quelle norme appartient un caractère, \n"; + print " on suppose, par défaut, qu‘il s‘agit de l‘ISO 8859-15. Autrement, chaque \n"; + print " caractère inconnu sera remplacé par le caractère “\x{FFFD}”. \n"; + print "\n"; + + exit 0; + } + +usage(1) if not $fichier; + +# Variables +my $ligne = undef; +my $niveau = undef; +my $octets = undef; +my $position = undef; +my @erreurs = (); + +# Expressions régulières pour les caractères multi-octets corrects +my $mo2 = qr/([\xC2-\xDF][\x80-\xBF])/o; +my $mo3 = qr/(\xE0[\xA0-\xBF][\x80-\xBF]|[\xE1-\xEF][\x80-\xBF]{2})/o; +my $mo4 = qr/(\xF0[\x90-\xBF][\x80-\xBF]{2}|[\xF1-\xF3][\x80-\xBF]{3}|\xF4[\x80-\x8F][\x80-\xBF]{2})/o; + +# Caractères CP 1252 +my %winlat = ( + 128 => "E2 82 AC", + 130 => "E2 80 1A", + 131 => "C6 92", + 132 => "E2 80 9E", + 133 => "E2 80 A6", + 134 => "E2 80 A0", + 135 => "E2 80 A1", + 136 => "CB 86", + 137 => "E2 80 B0", + 138 => "C5 A0", + 139 => "E0 80 B9", + 140 => "C5 92", + 142 => "C5 BD", + 145 => "E2 80 98", + 146 => "E2 80 99", + 147 => "E2 80 9C", + 148 => "E2 80 9D", + 149 => "E2 80 A2", + 150 => "E2 80 93", + 151 => "E2 80 94", + 152 => "CB 9C", + 153 => "E2 84 A2", + 154 => "C5 A1", + 155 => "E2 80 BA", + 156 => "C5 93", + 158 => "C5 BE", + 159 => "C5 B8", + ); + +# Caractères ISO 8859-15 +my %lat9 = ( + 164 => "E2 82 AC", + 166 => "C5 A0", + 168 => "C5 A1", + 180 => "C5 BD", + 184 => "C5 BE", + 188 => "C5 92", + 189 => "C5 93", + 190 => "C5 B8", + ); + +if ( $log ) { + open(LOG, ">>:utf8", $log) or die "$!,"; + print LOG "==> $fichier <== \n"; + } +else { + open(LOG, ">:utf8", "/dev/null") or die "$!,"; + } + +if ( $corrige ) { + open(OUT, ">:raw", $corrige) or die "$!,"; + if ( $bom ) { + print OUT "\xEF\xBB\xBF"; + } + } +else { + open(OUT, ">:raw", "/dev/null") or die "$!,"; + } + +select OUT; + +open(INP, "<:raw", $fichier) or die "$!,"; + +while($octets = ) { + my $tmp = $octets; + $ligne ++; + $position = 1; + + # Vérification des caractères UTF-8 surencodés + ## while ( $tmp =~ /(($mo2|$mo3|$mo4){2,})/go ) { + while ( $tmp ) { + if ( $tmp =~ /^(($mo2|$mo3|$mo4){2,})/go ) { + my $chaine = $&; + ## $position = pos($tmp) - length($chaine) + 1; + my %occurrences = reduit($chaine, $position); + if ( %occurrences ) { + foreach my $pos (sort {$a <=> $b} keys %occurrences) { + push(@erreurs, $occurrences{$pos}{'erreur'}); + print LOG " - $occurrences{$pos}{'erreur'} [ligne $ligne, octet $pos, caractère $occurrences{$pos}{'poscar'}]\n"; + print pack("C*", map {hex($_);} split(/ +/, $occurrences{$pos}{'correct'})); + ## + ## Autre méthode, plus simple. + ## + # foreach my $code (split(/ +/, $occurrences{$pos}{'correct'})) { + # print chr(hex($code)); + # } + if ( defined $occurrences{$pos}{'taille'} ) { + $tmp = substr($tmp, $occurrences{$pos}{'taille'}); + $position += $occurrences{$pos}{'taille'}; + last; + } + else { + die "Erreur quelque part,"; + } + } + + } + } + # then what? + + # Vérification de la syntaxe des caractères UTF-8 + ## $tmp = $octets; + ## $position = 1; + ## while ( $tmp ) { + if ( $tmp =~ /^[\0-\x7F]+/o ) { + my $chaine = $&; + $tmp = substr($tmp, length($chaine)); + while ($chaine =~ /([\0-\x08\x0B\x0C\x0E-\x1F\x7F])/go) { + my $hexa = sprintf("x%02X", ord($1)); + my $pos = pos($chaine); + push(@erreurs, "Caractère de contrôle \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet ", $position + $pos - 1, ", caractère $poscar]\n"; + } + $position += length($chaine); + $chaine =~ s/[\0-\x08\x0B\x0C\x0E-\x1F\x7F]/\xEF\xBF\xBD/go; + print $chaine; + next; + } + # elsif ( $tmp =~ /^(($mo2|$mo3|$mo4){2,})/o ) { + # my $chaine = $1; + # # my $nouveau = undef; + # my $nouveau = reduit($chaine, $position); + # if ( defined $nouveau ) { + # + # # $position += length($chaine); + # } + + # } + elsif ( $tmp =~ /^([\xC2-\xDF])([\x80-\xBF])/o ) { + my $oct1 = $1; + my $oct2 = $2; + $tmp = substr($tmp, 2); + my $val = ((ord($oct1) & 31) * 64) + (ord($oct2) & 63); + if ( $val >= 128 and $val <= 159 ) { + if ( $val == 129 or $val == 141 or + $val == 143 or $val == 144 or + $val == 157 ) { + my $hexa = sprintf("0x%04X", $val); + push(@erreurs, "Caractère interdit \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + else { + my $hexa = sprintf("0x%04X", $val); + if ( $winlat{$val} ) { + my $winlat = pack("C*", map {hex($_);} split(/ +/, $winlat{$val})); + push(@erreurs, "Caractère interdit \'$hexa\' (CP 1252 \'".decode_utf8($winlat)."\' ?)"); + print $winlat; + } + else { + push(@erreurs, "Caractère interdit \'$hexa\' (CP 1252 ?)"); + print "\xEF\xBF\xBD"; + } + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n" + } + } + else { + print "$oct1$oct2"; + } + $position += 2; + } + elsif ( $tmp =~ /^(\xED[\xA0-\xAF][\x80-\xBF]\xED[\xB0-\xBF][\x80-\xBF])/o ) { + my @octets = split(//, $1); + my $haut = (((ord($octets[0]) & 15) * 64) + (ord($octets[1]) & 63)) *64 + (ord($octets[2]) & 63); + my $bas = (((ord($octets[3]) & 15) * 64) + (ord($octets[4]) & 63)) *64 + (ord($octets[5]) & 63); + my $val = 65536 + (($haut - 55296) * 1024) + ($bas - 56320); + $tmp = substr($tmp, 6); + $haut = sprintf("0x%04X", $haut); + $bas = sprintf("0x%04X", $bas); + my $hexa = sprintf("0x%04X", $val); + push(@erreurs, "Séquence interdite \'$haut $bas\' (code UTF-16 pour \'$hexa\')"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + $position += 6; + } + elsif ( $tmp =~ /^(\xE0)([\xA0-\xBF])([\x80-\xBF])/o or + $tmp =~ /^([\xE1-\xEF])([\x80-\xBF])([\x80-\xBF])/o ) { + my $oct1 = $1; + my $oct2 = $2; + my $oct3 = $3; + $tmp = substr($tmp, 3); + my $utf8 = $oct1 . $oct2 . $oct3; + my $val = (((ord($oct1) & 15) * 64) + (ord($oct2) & 63)) * 64 + (ord($oct3) & 63); + if ( $val >= 55296 and $val <= 57343 ) { + my $hexa = sprintf("0x%04X", $val); + push(@erreurs, "Caractère interdit \'$hexa\' (demi-codet)"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( $val >= 57344 and $val <= 63743 ) { + my $hexa = sprintf("0x%04X", $val); + push(@erreurs, "Caractère d’usage privé \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( ( $val >= 64976 and $val <= 65007 ) or + $val == 65534 or $val == 65535 ) { + my $hexa = sprintf("0x%04X", $val); + push(@erreurs, "Non caractère \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + else { + print $utf8; + } + $position += 3; + } + elsif ( $tmp =~ /^(\xF0)([\x90-\xBF])([\x80-\xBF])([\x80-\xBF])/o or + $tmp =~ /^([\xF1-\xF3])([\x80-\xBF])([\x80-\xBF])([\x80-\xBF])/o or + $tmp =~ /^(\xF4)([\x80-\x8F])([\x80-\xBF])([\x80-\xBF])/o ) { + my $oct1 = $1; + my $oct2 = $2; + my $oct3 = $3; + my $oct4 = $4; + $tmp = substr($tmp, 4); + my $utf8 = $oct1 . $oct2 . $oct3 . $oct4; + my $val = ((((ord($oct1) & 7) * 64) + (ord($oct2) & 63)) * 64 + (ord($oct3) & 63)) * 64 + (ord($oct4) & 63); + if ( $val == 131070 or $val == 131071 or $val == 196606 or $val == 196607 ) { + my $hexa = sprintf("0x%06X", $val); + push(@erreurs, "Non caractère \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( $val >= 196608 and $val <= 917503 ) { + my $hexa = sprintf("0x%06X", $val); + push(@erreurs, "Caractère interdit \'$hexa\' (plans réservés non attribués)"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( $val >= 917504 and $val <= 983037 ) { + my $hexa = sprintf("0x%06X", $val); + push(@erreurs, "Caractère spécial \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( $val == 983038 and $val == 983039 ) { + my $hexa = sprintf("0x%06X", $val); + push(@erreurs, "Non caractère \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( $val >= 983040 and $val <= 1048573 ) { + my $hexa = sprintf("0x%06X", $val); + push(@erreurs, "Caractère d’usage privé \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( $val == 1048574 and $val == 1048575 ) { + my $hexa = sprintf("0x%06X", $val); + push(@erreurs, "Non caractère \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( $val >= 1048576 and $val <= 1114109 ) { + my $hexa = sprintf("0x%06X", $val); + push(@erreurs, "Caractère d’usage privé \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + elsif ( $val == 1114110 and $val == 1114111 ) { + my $hexa = sprintf("0x%06X", $val); + push(@erreurs, "Non caractère \'$hexa\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + } + else { + print $utf8; + } + $position += 4; + } + elsif ( $tmp =~ /^([\xC0-\xDF][\x80-\xBF])/o or + $tmp =~ /^([\xE0-\xEF][\x80-\xBF][\x80-\xBF])/o or + $tmp =~ /^([\xF0-\xF7][\x80-\xBF][\x80-\xBF][\x80-\xBF])/o ) { + $tmp = $'; + my $taille = length($1); + my $sequence = join(" ", map {sprintf("x%02X", ord($_));} split(//, $1)); + push(@erreurs, "Séquence interdite \'$sequence\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + $position += $taille; + } + elsif ( $tmp =~ /^([\xF8-\xFB][\x80-\xBF]{4})/o or + $tmp =~ /^([\xFC-\xFD][\x80-\xBF]{5})/o or + $tmp =~ /^(\xFE[\x80-\xBF]{6})/o or + $tmp =~ /^(\xFF[\x80-\xBF]{7})/o ) { + $tmp = $'; + my $taille = length($1); + my $sequence = join(" ", map {sprintf("x%02X", ord($_));} split(//, $1)); + push(@erreurs, "Séquence interdite \'$sequence\'"); + my $poscar = position($octets, $position); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print "\xEF\xBF\xBD"; + $position += $taille; + } + else { + my $val = ord(substr($tmp, 0, 1)); + my $hexa = sprintf("x%02X", $val); + $tmp = substr($tmp, 1); + my $latin1 = chr(hex($hexa)); + my $poscar = position($octets, $position); + if ( $winlat{$val} ) { + my $winlat = pack("C*", map {hex($_);} split(/ +/, $winlat{$val})); + push(@erreurs, "Caractère interdit \'$hexa\' (CP 1252 \'". decode_utf8($winlat)."\' ?)"); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print $winlat; + } + elsif ( $lat9{$val} ) { + my $lat9 = pack("C*", map {hex($_);} split(/ +/, $lat9{$val})); + push(@erreurs, "Caractère interdit \'$hexa\' (ISO 8859-15 \'".decode_utf8($lat9)."\' ou ISO 8859-1 \'$latin1\' ?)"); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + print $lat9; + } + else { + push(@erreurs, "Caractère interdit \'$hexa\' (ISO 8859-1 \'$latin1\' ?)"); + print LOG " - $erreurs[$#erreurs] [ligne $ligne, octet $position, caractère $poscar]\n"; + my $octet1 = ($val >> 6) + 192; + my $octet2 = ($val & 63) + 128; + $latin1 = pack("C*", ($octet1, $octet2)); + print $latin1; + } + $position += 1; + } + } + } +close INP; +close OUT; + +if ( @erreurs ) { + print STDERR "\n ==> $fichier <== \n"; + print LOG " \n"; + my @mortel = (); + my @veniel = (); + my %nb = (); + foreach my $erreur (@erreurs) { + if ( $erreur =~ /\binterdite?\b/o ) { + push(@mortel, $erreur); + $nb{$erreur}++; + } + else { + push(@veniel, $erreur); + $nb{$erreur}++; + } + } + if ( @mortel ) { + print STDERR " Erreur", $#mortel == 0 ? "": "s", " : \n"; + } + foreach my $erreur (@mortel) { + if ( $nb{$erreur} ) { + print STDERR "\t$erreur"; + print STDERR " ($nb{$erreur} occurrences)" if $nb{$erreur} > 1; + print STDERR "\n"; + delete $nb{$erreur}; + } + } + if ( @veniel ) { + print STDERR " Avertissement", $#mortel == 0 ? "": "s", " : \n"; + } + foreach my $erreur (@veniel) { + if ( $nb{$erreur} ) { + print STDERR "\t$erreur"; + print STDERR " ($nb{$erreur} occurrences)" if $nb{$erreur} > 1; + print STDERR "\n"; + delete $nb{$erreur}; + } + } + + if ( @mortel ) { + exit 3; + } + else { + exit 2; + } + } + + +exit 0; + + +sub usage +{ +print STDERR "\n$usage\n"; + +exit shift; +} + +sub position +{ +my ($chaine, $position) = @_; + +my $portion = join("", (split(//, $chaine))[0 .. $position - 1]); +my $utf8 = undef; +eval { + $utf8 = decode("UTF-8", $portion, Encode::FB_DEFAULT); + }; +return length($utf8); +} + +sub reduit +{ +my $chaine = shift; +my $position = shift; + +my $debut = 0; +my $fin = 0; +my $num = undef; +my $nouveau = undef; +my $offset = 0; +my $original = $position; +my @octets = split(//, $chaine); +my @val = (); +my %retour = (); + +$niveau ++; + +for ( my $nb = 0 ; $nb <= $#octets ; $nb ++ ) { + my $val = undef; + if ( $octets[$nb] =~ /^[\xC2-\xDF]/o ) { + $val = ((ord($octets[$nb]) & 31) * 64) + (ord($octets[$nb + 1]) & 63); + # $nouveau .= pack("C", $val); + # 1100 0011 1000 0011 1100 0010 1010 1001 = C3 83 C2 A9 = 195 131 194 169 + # -> 00011 000011 00010 101001 = C3 A9 = 195 169 + # -> 11000011 10101001 + # + $nb ++; + } + elsif ( $octets[$nb] =~ /^[\xE0-\xEF]/o ) { + $val = (((ord($octets[$nb]) & 15) * 64) + (ord($octets[$nb + 1]) & 63)) * 64 + + (ord($octets[$nb + 2]) & 63); + $nb += 2; + } + elsif ( $octets[$nb] =~ /^[\xF0-\xF4]/o ) { + $val = ((((ord($octets[$nb]) & 7) * 64) + (ord($octets[$nb + 1]) & 63)) * 64 + + (ord($octets[$nb + 2]) & 63)) * 64 + (ord($octets[$nb + 3]) & 63); + $nb += 3; + } + else { + die "Cas inattendu,"; + } + # $fin = $nb; + + if ( $num == 0 ) { + if ( $val >= 194 and $val <= 223 ) { + $num = 2; + } + elsif ( $val >= 224 and $val <= 239 ) { + $num = 3; + } + elsif ( $val >= 240 and $val <= 244 ) { + $num = 4; + } + else { + $position = $original + $debut; + if ( $nouveau ) { + my $courant = $niveau; + my $correct = join(" ", map {sprintf("x%02X", ord($_));} split(//, $nouveau)); + my $reel = undef; + if ( $nouveau =~ /^(\p{IsPrint})+\z/o ) { + $reel = decode_utf8($nouveau); + } + while ( $nouveau =~ /(($mo2|$mo3|$mo4){2,})/go ) { + my $long = length($&); + my $pos = pos($nouveau); + my %tmp = reduit($nouveau, $position); + if ( %tmp ) { + $correct = $tmp{$position}{'correct'}; + $courant = $tmp{$position}{'niveau'}; + $reel = $tmp{$position}{'reel'}; + } + } + + my $sequence = join(" ", map {sprintf("x%02X", ord($_));} @octets[$debut .. $fin]); + my $taille = $fin - $debut + 1; + my $erreur = "Caractère UTF-8 surencodé "; + if ( $courant > 1 ) { + $erreur .= "$courant fois "; + } + $erreur .= "\'$sequence\' (au lieu de \'$correct\'"; + if ( defined $reel ) { + $erreur .= " = \'$reel\'"; + } + $erreur .= ")"; + my $poscar = position($octets, $position); + $retour{$position}{'sequence'} = $sequence; + $retour{$position}{'taille'} = $taille; + $retour{$position}{'correct'} = $correct; + $retour{$position}{'niveau'} = $courant; + $retour{$position}{'poscar'} = $poscar; + $retour{$position}{'erreur'} = $erreur; + $retour{$position}{'reel'} = $reel; + + ## $nouveau = undef; + } + + ## $debut = $nb + 1; + ## @val = (); + ## next; + $niveau --; + return %retour; + } + push(@val, $val); + } + else { + push(@val, $val); + if ( $#val + 1 == $num ) { + my $utf8 = pack("C*", @val); + if ( $utf8 =~ /^($mo2|$mo3|$mo4)\z/o ) { + $nouveau .= $utf8; + $fin = $nb; + } + ## elsif ( $utf8 =~ /(($mo2|$mo3|$mo4)+)/o ) { + else { + $position = $original + $debut; + if ( $nouveau ) { + my $courant = $niveau; + my $correct = join(" ", map {sprintf("x%02X", ord($_));} split(//, $nouveau)); + my $reel = undef; + if ( $nouveau =~ /^(\p{IsPrint})+\z/o ) { + $reel = decode_utf8($nouveau); + } + while ( $nouveau =~ /(($mo2|$mo3|$mo4){2,})/go ) { + my $long = length($&); + my $pos = pos($nouveau); + my %tmp = reduit($nouveau, $position); + if ( %tmp ) { + $correct = $tmp{$position}{'correct'}; + $courant = $tmp{$position}{'niveau'}; + $reel = $tmp{$position}{'reel'}; + } + } + + my $sequence = join(" ", map {sprintf("x%02X", ord($_));} @octets[$debut .. $fin]); + my $taille = $fin - $debut + 1; + my $erreur = "Caractère UTF-8 surencodé "; + if ( $courant > 1 ) { + $erreur .= "$courant fois "; + } + $erreur .= "\'$sequence\' (au lieu de \'$correct\'"; + if ( defined $reel ) { + $erreur .= " = \'$reel\'"; + } + $erreur .= ")"; + my $poscar = position($octets, $position); + $retour{$position}{'sequence'} = $sequence; + $retour{$position}{'taille'} = $taille; + $retour{$position}{'correct'} = $correct; + $retour{$position}{'niveau'} = $courant; + $retour{$position}{'poscar'} = $poscar; + $retour{$position}{'erreur'} = $erreur; + $retour{$position}{'reel'} = $reel; + + $nouveau = undef; + } + ## $fin ++; + ## if ( $octets[$fin] =~ /^[\xC2-\xDF]/o ) { + ## $nb = $fin + 1; + ## $debut = $fin + 2; + ## } + ## elsif ( $octets[$fin] =~ /^[\xE0-\xEF]/o ) { + ## $nb = $fin + 2; + ## $debut = $fin + 3; + ## } + ## elsif ( $octets[$fin] =~ /^[\xF0-\xF4]/o ) { + ## $nb = $fin + 3; + ## $debut =$fin + 4; + ## } + ## $fin = $nb; + $niveau --; + return %retour; + } + ## else { + ## my $biniou ++; + ## } + @val = (); + $num = 0; + } + } + + } +if ( $nouveau ) { + $position = $original + $debut; + my $courant = $niveau; + my $correct = join(" ", map {sprintf("x%02X", ord($_));} split(//, $nouveau)); + my $reel = undef; + if ( $nouveau =~ /^(\p{IsPrint})+\z/o ) { + $reel = decode_utf8($nouveau); + } + while ( $nouveau =~ /(($mo2|$mo3|$mo4){2,})/go ) { + my $long = length($&); + my $pos = pos($nouveau); + my %tmp = reduit($nouveau, $position); + if ( %tmp ) { + $correct = $tmp{$position}{'correct'}; + $courant = $tmp{$position}{'niveau'}; + $reel = $tmp{$position}{'reel'}; + } + } + + my $sequence = join(" ", map {sprintf("x%02X", ord($_));} @octets[$debut .. $fin]); + my $taille = $fin - $debut + 1; + my $erreur = "Caractère UTF-8 surencodé "; + if ( $courant > 1 ) { + $erreur .= "$courant fois "; + } + $erreur .= "\'$sequence\' (au lieu de \'$correct\'"; + if ( defined $reel ) { + $erreur .= " = \'$reel\'"; + } + $erreur .= ")"; + my $poscar = position($octets, $position); + $retour{$position}{'sequence'} = $sequence; + $retour{$position}{'taille'} = $taille; + $retour{$position}{'correct'} = $correct; + $retour{$position}{'niveau'} = $courant; + $retour{$position}{'poscar'} = $poscar; + $retour{$position}{'erreur'} = $erreur; + $retour{$position}{'reel'} = $reel; + } + +$niveau --; +return %retour; +} + +sub est_valide +{ +; +}