#/usr/bin/perl
<<DOC;
Nom : Rachid Belmouhoub
Avril 2012
usage : perl bao3_rb_new.pl fichier_tag fichier_motif
DOC
use strict;
use utf8;
use XML::XPath;
# Définition globale des encodage d'entrée et sortie du script à utf8
# On vérifie le nombre d'arguments de l'appel au script ($0 : le nom du script)
if($#ARGV!=1){print "usage : perl $0 fichier_tag fichier_motif";exit
;}
# Enregistrement des arguments de la ligne de commande dans les variables idoines
my $tag_file= shift @ARGV;
my $patterns_file = shift @ARGV;
# Ouverture du fichiers de motifs
open(PATTERNSFILE
, $patterns_file) or die "can't open $patterns_file: $!\n";
# lecture du fichier contenant les motifs, un motif par ligne (par exemple : NOM ADJ)
while (my $ligne = <PATTERNSFILE>) {
# Appel à la procédure d'extraction des motifs
&extract_pattern($ligne);
}
# Fermeture du fichiers de motifs
# routine de construction des chemins XPath
sub construit_XPath{
# On récupère la ligne du motif recherché
my $local_ligne=shift @_;
# initialisation du chemin XPath
my $search_path="";
# on supprime avec la fonction chomp un éventuel retour à la ligne
# on élimine un éveltuel retour chariot hérité de windows
$local_ligne=~ s/\r$//;
# Construction au moyen de la fonction split d'un tableau dont chaque élément a pour valeur un élément du motif recherché
my @tokens=split(/ /,$local_ligne);
# On commence ici la construction du chemin XPath
# Ce chemin correspond au premier noeud "element" de l'arbre XML qui répond au motif cherché
my $search_path="//element[data[\@type=\"type\"][contains(text(),\"$tokens[0]\")]";
# Initialisation du compteur pour la boucle de construction du chemin XPath
my $i=1;
while ($i < $#tokens) {
$search_path.="[ancestor::element/following-sibling::element[1]/data[\@type=\"type\"][contains(text(),\"$tokens[$i]\")]";
$i++;
}
my $j=$i-1;
my $search_path_suffix="]";
# on utilise l'opérateur x qui permet de répéter la chaine de caractère à sa gauche autant de fois que l'entier à sa droite,
# soit $i fois $search_path_suffix
$search_path_suffix=$search_path_suffix x $i;
# le chemin XPath final
$search_path.="[ancestor::element/following-sibling::element[1]/data[\@type=\"type\"][contains(text(),\"".$tokens[$#tokens]."\")]]"
.$search_path_suffix;
# on renvoie à la procédure appelante le chein XPath et le tableau des éléments du motif
return ($search_path,@tokens);
}
# routine d'extraction du motif
sub extract_pattern{
# On récupère la ligne du motif recherché
my $ext_pat_ligne= shift @_;
# Appel de la fonction construit_XPath pour le motif lu à la ligne courrante du fichier de motif
my ($search_path,@tokens) = &construit_XPath($ext_pat_ligne);
# définition du nom du fichier de résultats pour le motif en utilisant la fonction join
my $match_file = "res_extract-".join('_', @tokens).".txt";
# Ouverture du fichiers de résultats encodé en UTF-8
open(MATCHFILE
,">:encoding(UTF-8)", "$match_file") or die "can't open $match_file: $!\n";
# création de l'objet XML::XPath pour explorer le fichier de sortie tree-tagger XML
my $xp = XML
::XPath->new( filename
=> $tag_file ) or die "big trouble";
# Parcours des noeuds du ficher XML correspondant au motif avec le chemin XPath construit précédement
# avec la fonction construit_XPath
foreach my $noeud ( $xp->findnodes($search_path)) {
# extraction impression de la forme correspondant au premier élément du motif
print MATCHFILE
$noeud->getChildNode(3)->string_value," ";
# Copie de la variable de la boucle $noeud dans une la variable de travail $noeud_suivant
# cette variable va subir les modification nécessaires pour le calcul, on ne peut évidement pas modifier la variable de boucle
my $noeud_suivant=$noeud;
# Initialisation du compteur pour la boucle d'éxtraction des formes correspondants aux éléments suivants du motif
my $following=0;
# Boucle d'éxtraction des formes correspondants aux éléments suivants du motif
# On descend graduellement au dernier noeud element
while ( $following < $#tokens) {
$following++;
# construction du chemin XPath cible pour atteindre le noeud suivant
my $following_elmt="./following-sibling::element[".$following."]";
# la méthode "find" retourne un objet dont on peut extraire une liste de noeuds au moyen de la méthode get_nodelist,
# bien que cette liste, vu notre chemin, ne contient qu'un seul noeud (voir element[1])
my @noeuds_suivants=$xp->find("./following-sibling::element[1]",$noeud_suivant)->get_nodelist();
# récupération du noeud recherché
$noeud_suivant=shift(@noeuds_suivants);
# impression de la forme correspondant à l'élément suivant du motif au moyen de la méthode string_value
print MATCHFILE
$noeud_suivant->getChildNode(3)->string_value," ";
}
}
# Fermeture du fichiers de motifs
}