#/usr/bin/perl -w
<<DOC;
Marie Garrigue
Sandy Bonin
Juin 2010

commande : perl bao3_treetagger.pl fichier_tag_xml fichier_motif

DOC
#-----------------------------------------------------------------------------------------------
#On utilise le module XML::XPath
use XML::XPath;
#-----------------------------------------------------------------------------------------------
#On vérifie le nombre d'arguments de l'appel au script ("$0" est la variable qui contient le nom du script)
if($#ARGV!=1){print "commande : perl $0 fichier_tag_xml fichier_motif";exit;}
#-----------------------------------------------------------------------------------------------
#On enregistre les arguments dans les variables idoines
my $tag_file=shift @ARGV;
my $patterns_file=shift @ARGV;
#-----------------------------------------------------------------------------------------------
#On initialise des variables
my @patterns;
my $nb_patterns=0;
my $nb_tokens=0;
#-----------------------------------------------------------------------------------------------
#On modifie le contenu du fichier d'entrée TreeTagger XML, à l'aide d'un fichier temporaire, afin qu'il puisse être utilisé par XML::XPath
#-----------------------------------------------------------------------------------------------
#On ouvre en écriture le fichier temporaire, sinon on affiche un message d'erreur
open(TMP,">tmp.xml") or die "Probleme lors de l'ouverture du fichier temporaire : $!\n";
#On ouvre en lecture le fichier d'entrée TreeTagger XML, sinon on affiche un message d'erreur
open(FILE,$tag_file) or die "Probleme lors de l'ouverture du fichier d'entrée $tag_file : $!\n";
#On lit le fichier d'entrée ligne par ligne
while ($lg=<FILE>) {
#On remplace les retours à la ligne par rien
$lg=~s/\n//g;
#On remplace la chaîne de caractères "NAM" par la chaîne de caractères "NOM"
$lg=~s/NAM/NOM/g;
#On enlève les espaces qui se trouvent avant les chevrons ouvrants
$lg=~s/ \</\</g;
#On enlève les espaces qui se trouvent après les chevrons fermants
$lg=~s/\> /\>/g;
#On écrit la ligne à la suite du contenu du fichier temporaire
print TMP $lg;
}
#On ferme le fichier d'entrée
close(FILE);
#On ferme le fichier temporaire
close(TMP);
#-----------------------------------------------------------------------------------------------
#On stocke les patrons syntaxiques dans une liste
#-----------------------------------------------------------------------------------------------
#On ouvre en lecture le fichier qui contient les patrons syntaxiques, sinon on affiche un message d'erreur
open(PATTERNSFILE,$patterns_file) or die "Probleme lors de l'ouverture du fichier d'entrée $patterns_file qui contient les patrons syntaxiques : $!\n";
#On lit le fichier contenant les patrons syntaxiques, un motif par ligne (par exemple : NOM ADJ)
while ($ligne=<PATTERNSFILE>) {
#On supprime avec la commande "chomp" un éventuel retour à la ligne
chomp($ligne);
#On affecte à une variable "$nb_patterns" le nombre de patrons syntaxiques
$nb_patterns=push(@patterns,$ligne);
}
#-----------------------------------------------------------------------------------------------
#On crée un objet XML::XPath pour explorer le fichier d'entrée TreeTagger XML, sinon on affiche un message d'erreur
my $xp = XML::XPath->new( filename => "tmp.xml" ) or die "Problème lors de la création de l'objet XML::XPATH !\n";
#On recherche des patrons syntaxiques dans le fichier d'entrée TreeTagger XML
foreach my $pattern (@patterns){
#On construit au moyen de la commande "split" un tableau dont chaque élément a pour valeur un token du motif recherché
@tokens=split(/ /,$pattern);
#On définit le nom du fichier de sortie pour le motif en utilisant la commande "join"
my $match_file="resultat_bao3_treetagger_".join('_', @tokens).".txt";
#On ouvre en écriture le fichier de sortie, sinon on affiche un message d'erreur
open(MATCHFILE,">$match_file") or die "Probleme lors de l'ouverture du fichier de sortie $match_file : $!\n";
#On appel la procédure d'extraction des formes correspondants au motif
&extract_pattern(@tokens);
#On ferme le fichier de sortie
close(MATCHFILE);
}
#-----------------------------------------------------------------------------------------------
#On crée la fonction qui permet l'extraction d'un patron syntaxique
#-----------------------------------------------------------------------------------------------
sub extract_pattern {
@tokenz=@_;
#La commande "shift" coupe le premier élement d'un tableau et le revoie en résultat
$first_token=shift @tokenz;
#On supprime avec la commande "chomp" un éventuel retour à la ligne
chomp($first_token);
#On initialisation le chemin XPATH correspondant au motif recherché
#ATTENTION ici aux effets de bord dus à la structure choisie pour le fichier TreeTagger XML
#Par exemple pour le motif "NOM ADJ" : Une description d'un fil RSS qui se termine par un NOM suivie d'une autre description qui commence par un ADJ !
$search_path="//element/data[1][contains(text(),\"$first_token\")]";
foreach my $token (@tokenz){ #Construction récursive du chemin XPATH correspondant au motif recherché
chomp($token);
$search_path.="/ancestor::element/following-sibling::element[1]/data[1][contains(text(),\"$token\")]";
}
#On boucle sur les noeuds reconnus du chemin XPATH
foreach my $noeud ( $xp->findnodes($search_path)->get_nodelist ) {
#On initialise un tableau des formes
#On le fait ici pour des raisons évidentes d'économie de mémoire et donc de performance
my @matching_tokens;
#On remonte d'un cran au noeud parent pour extraire la forme trouvée
#Dans le cas d'un motif "NOM ADJ", c'est la forme de l'adjectif qu'on atteint
$noeud_tmp=$noeud->getParentNode;
$i=0;
foreach (@tokens){
$i++;
#On récupère la forme
#Noter que le "3" de "getChildNode(3)" correspond au "data[3]" de la feuille XSLT
$motif=$noeud_tmp->getChildNode(3)->string_value;
#"unshift(@matching_tokens,$motif)" ajoute au début du tableau "@matching_tokens" un élément dont la valeur est le contenu de la variable "$motif"
$nb_tokens=unshift(@matching_tokens,$motif);
$motif="";
#On remonte récursivement aux noeuds précedents pour extraire la forme
#Dans le cas d'un motif "NOM PRP NOM", on récupère ainsi PRP puis NOM (le premier)
#Noter que "preceding-sibling" est l'axe inverse de "following-sibling"
@noeudtmp=$xp->findnodes("./preceding-sibling::element[1]",$noeud_tmp)->get_nodelist;
$noeud_tmp=shift(@noeudtmp);
}
#On écrit les résultats dans un fichier en utilisant la commande "join"
print MATCHFILE join(' ', @matching_tokens)."\n";
}
}
#-----------------------------------------------------------------------------------------------
#On supprime le fichier temporaire
unlink("tmp.xml") or die "Problème lors de la suppression du fichier temporaire";