# Nettoyer un fichier Frantext - nouvelle version, février 2013, avec look-ahead & look-behind
#-----------------------------
# Restaurer les majuscules accentuées  : 
# - après un astérisque : présomption d'entité  nommée
# - juste avant une majuscule : présomption de titre 
# - ATTENTION aux effets de bord indésirables dans l'en-tête <teiHeader>
# Supprimer les astériques devant les entités nommées 
#       (supposées toujours commencer par une majuscule suivie de minuscules)
# Réduire des "oeu" en "œu" et les "oei" en "œi"


use strict;
use warnings;
use utf8;

sub netMajAcc($){ #arg. chaine - Restaure les majuscules accentuées
my ($txt) = @_;
	
	my $erMinAccAst = '(?<=\*)(\p{Ll})'; # look-behind
	$txt =~ s/$erMinAccAst/uc($1)/ge; #Impose une maj. après '*'
	
	my $erMinAccAvMaj = '(\p{Ll})(?=\p{Lu})'; # look-ahead
	$txt =~ s/$erMinAccAvMaj/uc($1)/ge; #Impose une maj. avant une maj.
	
	my $erMinAccApMaj = '(?<=\p{Lu}{2})(\p{Ll}\p{L}*)'; # look-behind
	$txt =~ s/$erMinAccApMaj/uc($1)/ge; #Impose tout en maj. après une maj. non-initiale
	
	return $txt;
}#netMajAcc
	
sub netAst($){ #arg. chaine - Enlève l'astérisque devant une maj. suivie de minuscules
my ($txt) = @_;
	
	my $erAst = '\*(?=\p{Lu}\p{Ll}+)'; # look-ahead
	$txt =~ s/$erAst//g;
	
	return $txt;
}#netAst
	
sub netOE($){ #arg. chaine  - Réduit des "oeu" en "œu" et les "oei" en "œi"
my ($txt) = @_;
	
	$txt =~ s/oe(?=[ui])/œ/g; # minuscule
	$txt =~ s/O[eE](?=[uUiI])/Œ/g; # majuscule

	return $txt;
}#netOE

#=====================================================================================

sub netFran($){ #arg. fichier - Procédure maîtresse
my ($fich) = @_;

	`cp $fich "$fich.bak"`;
	open(ENTREE, "<:utf8", "$fich.bak");
	open(SORTIE, ">:utf8", "$fich");
	my @tablignes = <ENTREE>;
	my $txt = join('', @tablignes);
	
	$txt = netOE(netAst(netMajAcc($txt)));

	print(SORTIE $txt);
}#netFran

netFran($ARGV[0]);