1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
| #======================================================================
# AUTEUR: Muriel Lesuisse
# DATE: 29/08/2016
# SCRIPT: typographie2.pl
#======================================================================
use strict; # Pour que Perl m'avertisse si j'oublie de déclarer une variable
use warnings; # Pour que Perl me signale les petites erreurs non bloquantes, en plus des GROSSES
use utf8; # Pour que les modifications effectuées dans les variables du pgm le soient en utf8
# Pour avoir les accents dans l'invite de commande (Console/Terminal)
ActiverAccents();
#######################
# Programme principal #
#######################
# l'argument prend en compte un fichier texte
my $entree = $ARGV[0];
my $sortie = $entree."new";
my ($fh_entree, $fh_sortie ) = (); # initialisation de variables à RIEN
# j'ouvre le fichier en lecture pour lire ligne par ligne # en convertissant en utf8
open ( $fh_entree, '<:utf8', $entree )
or die ( "Imposible d'ouvrir le fichier $entree $!" );
# j'ouvre le fichier en écriture pour écrire le nouveau texte corrigé # en convertissant en utf8
open ( $fh_sortie, '>:utf8', $sortie )
or die ( "Imposible d'ouvrir le fichier $sortie $!" );
# Initialisation du tableau contenant les locutions latines
my @loc_lat = ( "ad hoc", "ad libitum", "a foritori", "a posteriori", "a priori", "bis",
"grosso modo", "ididem", "idem in extenso", "in extremis", "in fine",
"infra", "loc. cit.", "modus vivendi", "op. cit.", "passim", "quater",
"sic", "statu quo", "supra", "ter", "via", "vice versa");
###############################
# Boucle du programme principal
# tant qu'il y a des lignes dans le fichier en entrée, je lis le texte
while ( my $ligne = <$fh_entree> ) {
# s/ = susbstitution: on substitue la partie gauche par la partie droite
# s/ ne fonctionne qu'une fois, pour que ça fonctionne plusieurs fois : /g
next if $ligne =~ /^\s+$/g; # sauter la ligne si elle ne contient que des espaces
$ligne =~ s/ +$//g; # supprimer l'espace en fin de ligne
$ligne =~ s/^ +//g; # supprimer l'espace en début de ligne
$ligne =~ s/\( +/\(/g; # supprimer les espaces après la parenthèse ouvrante
$ligne =~ s/ +\)/\)/g; # supprimer les espaces avant la parenthèse fermante
$ligne =~ s/\[ +/\[/g; # supprimer les espaces après le crochet ouvrant
$ligne =~ s/ +\]/\]/g; # supprimer les espaces avant le crochet fermant
$ligne =~ s/ +/ /g; # supprimer plusieurs espaces consécutifs
$ligne =~ s/ +\././g; # supprimer les espaces avant le point
$ligne =~ s/ +\,/,/g; # supprimer les espaces avant la virgule
$ligne =~ s/ ;/\x{A0};/g; # transformer l'espace justifiante en espace insécable
# avant un point-virgule
$ligne =~ s/ \?/\x{A0}\?/g; # transformer l'espace justifiante en espace insécable
# avant un point d'interrogation
$ligne =~ s/ !/\x{A0}!/g; # transformer l'espace justifiante en espace insécable
# avant un point d'exclamation
$ligne =~ s/ :/\x{A0}:/g; # transformer l'espace justifiante en espace insécable
# avant deux points
$ligne =~ s/("[^+]")/«[^+]»/g; # transformer les guillemets
$ligne =~ s/(')//g; # transformer l'apostrophe
$ligne =~ s/\. - \./\. \./g; # transformer le tiret en tiret cadratin
$ligne =~ s/\.([^ ])/. $1/g; # mettre une espace après le point s'il n'est pas déjà
# suivi par un espace
# pour éviter qu'une ligne soit "mangée", il faut mémoriser
# la lettre qu'on mange et la recopier ensuite
$ligne =~ s/\,[^ ]/\, /g; # mettre une espace après la virgule si elle n'est pas
# déjà suivie par un espace
$ligne =~ s/;[^ ]/; /g; # mettre une espace après le point-virgule s'il n'est
# pas déjà suivi par un espace
$ligne =~ s/\?[^ ]/\? /g; # mettre une espace après le point d'interrogation s'il
# n'est pas déjà suivi par un espace
$ligne =~ s/![^ ]/! /g; # mettre une espace après le point d'exclamation s'il
# n'est pas déjà suivi par un espace
$ligne =~ s/:[^ ]/: /g; # mettre une espace après les deux points s'il ne sont
# pas déjà suivis par un espace
$ligne =~ s/[^ ];/ ;/g; # mettre une espace avant le point-virgule s'il n'est
# pas déjà précédé par un espace
$ligne =~ s/[^ ]\?/ \?/g; # mettre une espace avant le point d'interrogation s'il
# n'est pas déjà précédé par un espace
$ligne =~ s/[^ ]!/ !/g; # mettre une espace avant le point d'exclamation s'il
# n'est pas déjà précédé par un espace
$ligne =~ s/[^ ]:/ :/g; # mettre une espace avant les deux points s'il ne sont
# pas déjà précédés par un espace
$ligne =~ s/^A\$/^À\$/g; # remplacer le A par un À avec accent
# indiquer à l'auteur qu'il faut une majuscule : # Compte tenu des modifs précédentes
my $Pattern = '[.?!] ([a-zàéèùâêîôûç])'; # regex dans une variable
# recherche une minuscule après .?!
$Pattern =~ s/ /\\ /go; # protège l'espace dans la regex
my @Array = ($ligne =~ m/(\b.{0,10}$Pattern.{0,10}\b)/gx); # place dans un tableau le résultat
# de la recherche
if (@Array) { # SI tableau non vide
print $fh_sortie "\nContrôler dans la phrase suivante :"; # écrit un libellé pour l'auteur
foreach my $Minuscule (@Array) { # pour chaque case dans le tableau
print $fh_sortie "\n$Minuscule ==> MAJUSCULE ?"; # pose la question à l'auteur
}
print $fh_sortie "\n\n"; # On saute 1 ligne pour aérer
}
print $fh_sortie "\n\n"; # On saute 2 lignes pour aérer
# avant traiter une autre ligne
$ligne = latin ($ligne); # On regarde s'il y a des locutions
# latines à traiter
$ligne = lineNumber ($ligne); # On regarde s'il y a des nombres
# à traiter
print $fh_sortie $ligne; # On écrit la ligne avec toutes ses
# modifs dans le fichier en sortie
} # FIN de la boucle principale
print $fh_sortie "\n";
# je ferme les fichiers lecture et écriture
close $fh_entree;
close $fh_sortie;
#######
# FIN #
#######
##################################################
# Fonctions appelées dans le programme principal #
##################################################
########################################################
# fonction pour mettre des locutions latines en italique
sub latin {
my ( $newLine ) = @_; # $newLine reçoit $ligne du pgm principal
foreach my $elem ( @loc_lat ) { # Tant qu'il y a des éléments dans mon tableau
my $newElem = "<i>". $elem ."</i>"; # j'y concaténe les balises italiques dans $newElem
$newLine =~ s/$elem/$newElem/g; # je remplace tous les $elem par des $newElem
} # dans $newLine
return ($newLine); # je retourne la nouvelle ligne au pgm principal
}
#####################################################
# fonction pour rechercher les nombres dans une ligne
# qui appelle, si nécessaire, la fonction qui espace les nombres
sub lineNumber {
my ( $newLine ) = @_; # $newLine reçoit $ligne du pgm principal
my $Pattern = ' [0-9]{1,} '; # regex qui sélectionne dans la ligne un nombre
# entouré d'espaces
$Pattern =~ s/ //g; # je supprime les espaces autour du nombre
my @Array = ($newLine =~ m/$Pattern/g); # Dans un tableau je range tous les nombres
# trouvés dans la ligne
if (@Array) { # SI il y a des nombres dans le tableau
foreach my $number (@Array) { # pour chacun d'eux
my $newNumber = nombres ($number); # j'appelle la fonction qui ajoute des espaces
$newLine =~ s/$number/$newNumber/g; # Dans la ligne je remplace les nombres chiffres
} # accolés, par les nombres chiffres espacés
}
return ($newLine); # je retourne la nouvelle ligne au pgm principal
}
#########################################
# fonction pour espacer un nombre 3 par 3
sub nombres {
my ( $num ) = @_; # $num reçoit mon nombre à modifier
my @tab = split //, $num; # je splite mon numéro dans un tableau
my @tab_invers = reverse @tab; # j'inverse mon tableau
my $compteur = 0; # mon compteur est égal à 0
my $nouveau_num = ""; # je crée une chaine de caractère vide dans laquelle je vais mettre mes chiffres
my $nouveau_num_endroit;
for my $chiffre (@tab_invers) { # tant qu'il y a des chiffres dans mon tableau inversé
$compteur++; # j'incrémente mon compteur
$nouveau_num .= $chiffre; # je concatène chaque chiffre à ma chaine de caractère vide
$nouveau_num .= "\x{A0}" if $compteur % 3 == 0; # je concatène une espace insécable tous les 3 chiffres
$nouveau_num_endroit = reverse $nouveau_num; # je remets mon numéro à l'endroit
}
return ($nouveau_num_endroit); # je retourne mon nombre à la fonction appelante
}
#==============================================================
# Pour avoir les accents sur la console DOS
# http://perl.developpez.com/faq/perl/?page=Terminal#AccentsDOS
#==============================================================
sub ActiverAccents {
my $encodage;
# Windows
if ( lc($^O ) eq 'mswin32') { # Si je suis sur Windows
eval {
my ($codepage) = ( `chcp` =~ m/:\s+(\d+)/ ); # On récupère le nombre que renvoie chcp dans une invite de commande
# exemple : Page de codes active*: 437
$encodage = "cp$codepage"; # On accole ce nombre au libellé "cp" de façon avoir cp437
foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) { # pour les fichiers spéciaux sortie_Ecran, Sortie_Erreur, Clavier_Entrée
binmode $h, ":encoding($encodage)"; # djibril modifie l'encodage ;)
}
};
}
else { # SINON je suis dans Unix / Linux
$encodage = `locale charmap`; # On récupère l'encodage par défaut, mais avec la commande qui va bien
eval {
foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) { # djibril modifie l'encodage des fichiers spéciaux ;)
binmode $h, ":encoding($encodage)";
}
};
}
return $encodage; # Retourne le bon encodage suivant l'OS
}
#Sinon petit rappel pour info :
#ü \x81 à \x85 è \x8A
#é \x82 ç \x87 ï \x8B
#â \x83 ê \x88 î \x8C
#ä \x84 ë \x89 |
Partager