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 |
