BAO 3 - Scripts

1- Script 1: extraction du fichier txt. Script avec le patron NOM-ADJ.

Allure du script 1

#perl extract-patron-cordial-nom-adj.pl type*_iso.cnr > cordial_NA.txt
open (FILE,"$ARGV[0]");
my $var="$ARGV[0]";
my @lignes=<FILE>;
close (FILE);
while (@lignes) {
#elle recupere la valeur de l'elt
	my $ligne=shift(@lignes);
	chomp $ligne;
	my $sequence="";
	my $longueur=0;
	if ($ligne=~/^([^\t]+)\t[^\t]+\tNC.*/) {
		#tout sauf une tabulation , tabulation et la catg qui m'intéresse
		#on memorise la forme graphique
		my $forme=$1;
		#on recupere la 1ere col et on a une longueur de la séquence 1
		$sequence.=$forme;
		$longueur=1; 
		#je demande si l'elt suivant est le bon
		my $nextligne=$lignes[0];
		if ($nextligne=~/^([^\t]+)\t[^\t]+\tADJ.*/) {
			my $forme=$1;
			$sequence.=" ".$forme;
			$longueur=2;
		}
	}
	if ($longueur == 2) {
		print $sequence, "\n";
	}
}

#perl extract-patron-cordial-nom-prep-nom.pl type*_iso.cnr > cordial_NPN.txt
open(FILE,"$ARGV[0]");
#--------------------------------------------
# le patron cherché ici est du type NOM ADJ";
# le modifier pour extraire NOM PREP NOM
#--------------------------------------------
my @lignes=<FILE>;
close(FILE);
while (@lignes) {
my $ligne=shift(@lignes);
chomp $ligne;
my $sequence="";
my $longueur=0;
if ( $ligne =~ /^([^\t]+)\t[^\t]+\tNC.*/) {
my $forme=$1;
$sequence.=$forme;
$longueur=1;
my $nextligne=$lignes[0];
if ( $nextligne =~ /^([^\t]+)\t[^\t]+\tPREP/) {
my $forme=$1;
$sequence.=" ".$forme;
$longueur=2;
my $nextligne=$lignes[1]; #je lis donc la 2ème ligne si 0 est ok
if ( $nextligne =~ /^([^\t]+)\t[^\t]+\tNC.*/) {
my $forme=$1;
$sequence.=" ".$forme;
$longueur=3;
}
}
}
if ($longueur == 3) {
print $sequence,"\n";
}
}

open(FILE,"$ARGV[0]");
#--------------------------------------------
# le patron cherché ici est du type NOM ADJ";
# le modifier pour extraire NOM PREP NOM
#--------------------------------------------
my @lignes=<FILE>;
close(FILE);
while (@lignes) {
my $ligne=shift(@lignes);
chomp $ligne;
my $sequence="";
my $longueur=0;
if ( $ligne=~/<element><data type=\"type\">NOM<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
my $forme=$1;
$sequence.=$forme;
$longueur=1;
my $nextligne=$lignes[0];
if ( $nextligne=~/<element><data type=\"type\">ADJ<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
my $forme=$1;
$sequence.=" ".$forme;
$longueur=2;
}
}
if ($longueur == 2) {
print $sequence,"\n";
}
}

#perl extract-patron-treetagger-nom-prep-nom.pl Tagged_type*.txt.xml > treetagger_NPN.txt
open(FILE,"$ARGV[0]");
#--------------------------------------------
# le patron cherché ici est du type NOM PREP NOM";
#--------------------------------------------
my @lignes=<FILE>;
close(FILE);
while (@lignes) {
my $ligne=shift(@lignes);
chomp $ligne;
my $sequence="";
my $longueur=0;
if ( $ligne=~/<element><data type=\"type\">NOM<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
my $forme=$1;
$sequence.=$forme;
$longueur=1;
my $nextligne=$lignes[0];
if ( $nextligne=~/<element><data type=\"type\">PRP<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
my $forme=$1;
$sequence.=" ".$forme;
$longueur=2;
my $next2ligne=$lignes[1];
if ( $next2ligne=~/<element><data type=\"type\">NOM<\/data><data type=\"lemma\">[^<]+<\/data><data type=\"string\">([^<]+)<\/data><\/element>/) {
my $forme=$1;
$sequence.=" ".$forme;
$longueur=3;
}
}
}
if ($longueur == 3) {
print $sequence,"\n";
}
}

#/usr/bin/perl
<<DOC;
Nom : Princesse Andria
Avril 2015
usage : perl bao3_rb_new.pl fichier_tag fichier_motif
DOC

use strict;
use utf8; #usage des packages de utf8
use XML::LibXML; #un seul module à utiliser dans perl

# Définition globale des encodage d'entrée et sortie du script à utf8
binmode STDIN, ':encoding(utf8)';
binmode STDOUT, ':encoding(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;

# création de l'objet XML::XPath pour explorer le fichier de sortie tree-tagger XML
my $xp = XML::LibXML->new(XML_LIBXML_RECOVER => 2); #agit sur la classe
$xp->recover_silently(1);

my $dom = $xp->load_xml( location => $tag_file ); #agit sur l'accès
my $root = $dom->getDocumentElement();

my $xpc = XML::LibXML::XPathContext->new($root);

# 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)/ automatiser la lecture globale du fichier
while (my $ligne = <PATTERNSFILE>) {
# Appel à la procédure d'extraction des motifs
&extract_pattern($ligne); #pour chq ligne de mon motif on extrait le motif
}

# Fermeture du fichiers de motifs
close(PATTERNSFILE);

# 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
chomp($local_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é
$search_path="//element[contains(data[\@type=\"type\"],\"$tokens[0]\")]";

# Initialisation du compteur pour la boucle de construction du chemin XPath
my $i=1;
while ($i < $#tokens) {
$search_path.="[following-sibling::element[1][contains(data[\@type=\"type\"],\"$tokens[$i]\")]";
$i++;
}
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.="[following-sibling::element[1][contains(data[\@type=\"type\"],\"".$tokens[$#tokens]."\")]"
.$search_path_suffix;
# print "$search_path\n";

# 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
#join prend un chaine de Kre et un tableau, a chq elt du tableau suivi d'un autre elt, on concatène ces elts. avec des points
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

# Parcours des noeuds du ficher XML correspondant au motif, au moyen de la méthode findnodes
# qui prend pour argument le chemin XPath construit précédement
# avec la fonction "construit_XPath"
my @nodes=$root->findnodes($search_path);
foreach my $noeud ( @nodes) {
# Initialisation du chemin XPath relatif du noeud "data" contenant
# la forme correspondant au premier élément du motif
# Ce chemin est relatif au premier noeud "element" du bloc retourné
# et pointe sur le troisième noeud "data" fils du noeud "element"
# en l'identifiant par la valeur "string" de son attribut "type"
my $form_xpath="";
$form_xpath="./data[\@type=\"string\"]";

# Initialisation du compteur pour la boucle d'éxtraction des formes correspondants
# aux éléments suivants du motif
my $following=0;

# Recherche du noeud data contenant la forme correspondant au premier élément du motif
# au moyen de la fonction "find" qui prend pour arguments:
# 1. le chemin XPath relatif du noeud "data"
# 2. le noeud en cours de traitement dans cette boucle foreach
# la fonction "find" retourne par défaut une liste de noeuds, dans notre cas cette liste
# ne contient qu'un seul élément que nous récupérons avec la fonction "get_node"
# enfin nous en imprimons le contenu textuel au moyen de la méthode string_value
print MATCHFILE $xpc->findvalue($form_xpath,$noeud);

# Boucle d'éxtraction des formes correspondants aux éléments suivants du motif
# On descend dans chaque noeud element du bloc
while ( $following < $#tokens) {
# Incrémentation du compteur $following de cette boucle d'éxtraction des formes
$following++;

# Construction du chemin XPath relatif du noeud "data" contenant
# la forme correspondant à l'élément suivant du motif
# Notez bien l'utilisation du compteur $folowing tant dans la condition de la boucle ci-dessus
# que dans la construction du chemin relatif XPath
my $following_elmt="following-sibling::element[".$following."]";
$form_xpath=$following_elmt."/data[\@type=\"string\"]";

# Impression du contenu textuel du noeud data contenant la forme correspondant à l'élément suivant du motif
print MATCHFILE " ",$xpc->findvalue($form_xpath,$noeud);

# Incrémentation du compteur $following de cette boucle d'éxtraction des formes
# $following++;
}
print MATCHFILE "\n";
}
# Fermeture du fichiers de motifs
close(MATCHFILE);
}