#====================================================================== # AUTEUR: Muriel Lesuisse # DATE: 29/08/2016 # SCRIPT: typographie2.pl #====================================================================== use strict; use warnings; # l'argument prend en compte un fichier texte my $fh = $ARGV[0]; my $fh_sortie = "$fh.new"; # j'ouvre le fichier en lecture pour lire ligne par ligne open ( my $donnees, '<', $fh ) or die ( "Imposible d'ouvrir le fichier $fh $!" ); # j'ouvre le fichier en écriture pour écrire le nouveau texte corrigé open ( my $sortie, '>', $fh_sortie) or die ( "Imposible d'ouvrir le fichier $fh_sortie $!" ); # tant qu'il y a des lignes, je lis le texte while ( my $ligne = <$donnees> ) { # s/ = susbstitution: on substitue la partie gauche par la partie droite # s/ ne fonctionne qu'une fois, pour que ça fonctionne plusieurs fois : /g $ligne =~ s/ +$//g; # supprimer l'espace en fin de ligne $ligne =~ s/^ +//g; # supprimer l'espace en début de ligne next if $ligne =~ /^\s+$/g; # sauter la ligne si elle ne contient que des espaces $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 print $ligne; # mettre des locutions latines en italique # 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 spécialisée dans le parcours de tableaux my $elem; foreach $elem ( @loc_lat ) { # tant qu'il y a des éléments dans mon tableau $elem =~ s/@loc_lat/@loc_lat<\/i>/g; # je les mets en italique } print $elem; # indiquer à l'auteur qu'il faut une majuscule my $minuscule; if ( $ligne =~ /[.?!] ([a-zàéèùâêîôûç])/ ) { # si une minuscule (normale et accentuée) suit # un point, un point d'interrogration ou un point # d'exclamation $minuscule = $1; # $1 récupère la minuscule suivant l'espace # après le point, point d'interrogration ou point d'exclamation say ("$minuscule"); # indiquer à l'auteur de vérifier # la majuscule } print $minuscule; # espacer un nombre 3 par 3 my $num = "12345678"; # mon numéro = 12345678 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 } print $nouveau_num_endroit, "\n"; # j'imprime mon nouveau numéro print $sortie; } # je ferme les fichiers lecture et écriture close $donnees; close $sortie;