1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111

#!/usr/bin/perl	-w	

# méthode Daube

# mode d'emploi du fichier
# fournir le 1r arguement le fichier txt sortie de Cordial
# fichiers cordiale sont en iso
# usage :
# perl extrait_termesl1.pl SORTIE-rubrique_ISO-8859.cnr listedespatrons.txt > SORTIE-rubrique_ISO-8859-1_patrons.txt

# open du fichier cordiale, TEXTE $ARGV[0] c'est le premier argument
open(TEXTE,"<:encoding(iso-8859-1)",$ARGV[0]);

# Lecture du fichier : on s'arrête quand on rencontre une PONCTUATION
my @TOKENS=();
my @LEMME=();
my @POS=();

while(my $ligne=<TEXTE>){

#s'il pas de pctforte je traite POS et remplie ma liste

	if($ligne !~ /PCTFORTE/) {
		#on traite la ligne et on remplit les 3 listes : TOKENS, LEMME, POS
		# faut transformer un scalar $ligne en UNE liste, tab est séparateur
			#ie $ligne contient qqchose comme ça : "Faiseurs\tfaiseur\tNOM\n"
		$ligne=~s/\r//g;			
		chomp($ligne);   #pour enlever le \n
		my @LISTEARANGER=split(/\t/,$ligne); # @LISTEARANGER contient donc
# ("Faiseurs","faiseur","NOM")

#pour garder les listes en mémoire
#on alimente les listes avec push - 
# je mets  pas my, je ne veux pas que chaque liste change avec chaque passe
			
		push(@TOKENS, $LISTEARANGER[0]); # faut s'assurer qu'il sont vide
		push(@LEMME, $LISTEARANGER[1]);
		push(@POS, $LISTEARANGER[2]);

				} # fin if
	
	#on vide les listes
	else {
	# TRAITEMENT A FAIRE sur @TOKENS, @POS
	#print "POS contient : @POS \n";
	#print "LEMME contient : @LEMME \n";
	#print "TOKENS contient : @TOKENS \n";
	#print "appuie sur return ";
	#my $retour=<STDIN>;
	#exit;
	&TraiteLaListeDesPos;	#sub programme / procédure

	#	REMISE A ZERO DES LISTES
	@TOKENS=();
	@LEMME=();
	@POS=();

		} # fin else

} #fin while

close(TEXTE);

#================PROCÉDURE==================================

sub TraiteLaListeDesPos {
#c'est ici qu'on va faire le match des POS...
#création de fichier témoin listedesPOS.txt (second argument du programme)
open(TERMES,"<:encoding(iso-8859-1)",$ARGV[1]);

# on compare le scalar ($), à la liste (@), mais 
# on ne peut comparer les choses de même nature, il faut donc 
# transformer la liste en chaîne de caractères.
		my $POStransformeenchaine=join("\#", @POS);
		#print "\$POStransformeenchaine contient :",$POStransformeenchaine,"\n";
		#print "appuie sur return\n";
		#my $reponse=<STDIN>;

# lecture du fichier des patrons
while (my $ligneterme=<TERMES>) {
		# $ligne contient par exemple : NC[A-Z]+#PREP#NC[A-Z]+
		# on veut comparer $POStransformeenchaine et $ligneterme ????
		chomp($ligneterme);		
		my $compteurdematch=0;		
		while ($POStransformeenchaine=~/$ligneterme/g) {
			
		# important : 3 variable prédéfinies de perl sont utilisées ici
		# $&	ce qui est reconnu au moment d'une recherche
		# $`	ce qui est avant ce qui est reconnu
		# $'	ce qui est après ce qui est reconnu

		my $avant=$`;
		my $apres=$';
		#------------------------
		my $nombredediese=0;
		while ($avant=~/\#/g) {
			$nombredediese++;
		}
		#------------------------
		my $nombredediesedanstermetraite=0;
		while ($ligneterme=~/\#/g) {
			$nombredediesedanstermetraite++;
		}
		#---------------------------
		#il ne reste plus qu'à aller chercher les correspondances dans @TOKENS...
		for (my $i=$nombredediese;$i<=$nombredediesedanstermetraite+$nombredediese;$i++){
			print $TOKENS[$i]," ";
		}
		print "\n";

		#$compteurdematch++;
		#print "MATCH $compteurdematch fois \n";
	}
}
close(TERMES);	
}

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

#!/usr/bin/perl
#use warnings;
#use strict;
use Time::Stopwatch; 

#printing usage if no argument set
if (!$ARGV[0] or !$ARGV[1]){
  $0 =~ s/.*\\(.*)/$1/; #name of this script without path
  print "\nUSAGE:\nperl $0 <dir with tagged files> patrons.txt\n";
  exit;
}

tie my $timer, 'Time::Stopwatch'; #start counting time

#openning the dir. with extracted titles and description
my $dir = $ARGV[0];

#creating saving directory
use File::Path;
my $path = './'.$dir.'/found';
rmtree($path);
mkdir($path);

opendir(DIR, $dir) or die "I cannot open dir: $dir";

print "\n";

while (my $file = readdir(DIR)) { #open directory
   next unless ($file =~ m/_t.txt$/); #open each file.txt
   
    my @token; 
    my @lemma;
    my @pos;
    
    #opening a sourcefile
    open(TEXTE,"<:utf8", $dir."/".$file) or die $!;
    
    while (my $ligne = <TEXTE>){
    
      #if no punctuation
      if ($ligne !~/SENT/) { #Cordial equvivalent PCTFORTE
       
        #on traite la ligne et on remplit les 3 listes : TOKEN, LEMME, POS
        #on transforme la chaine $ligne en une liste (le premier élément est une forme, le seconde un lemme etc.)
        #$ligne contient qq chose comme : "Faiseurs\tfaisieur\NOM"
        
        chomp($ligne);
        my @range = split(/\t/,$ligne); # @range has three words
        
        push(@token,$range[0]);
        push(@pos,$range[1]);
        push(@lemma,$range[2]); #for cordial lemma and pos inversed
                  
      }
      
      else {
        
        &listedepos($path."/".$file,\@pos,\@token);
        #&listedepos($file);
         
        @token=();
        @lemma=();
        @pos=();
      }
    }
  close(TEXTE);
  
  print "$file \t done\n";
  
}
close(DIR);

print "\n\n === DONE in $timer s ===\n"; #printing time

sub listedepos {

  my $pos = $_[1];#reference pos
  my $token = $_[2]; #reference token
                                                            
  my $chain = join("#",@$pos); #pos joined together
   #print "pos chain: $chain \n";
  my $save = substr($_[0],0,-6)."_p.txt";
    
  open(PATRONE,"<:utf8", $ARGV[1]);
  open(SAVE,">>:utf8",$save);
   
  #lecture du patrone
  while(my $terme=<PATRONE>){
    #$terme contientparexmple: NC[A-Z]+#PREP#NC[A-Z]+

    my $n = 0;
    chomp($terme);
    
    while($chain =~/$terme/g){
  
      my $avant=$`;
      my $apres=$';
      my $nd = 0; #nombre de diese
      my $ndt = 0; #nombre de diese terme traite
      
      while($avant=~/\#/g){
        $nd++;        
      }
      
      while($terme=~/\#/g){
        $ndt++;
      }
      
      for (my $i = $nd; $i<=$ndt+$nd; $i++){
        print SAVE $$token[$i]," ";
      }
      print SAVE "\n";  
    }           
  }
  close(PATRONE);
  close(SAVE);
}

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

#/usr/bin/perl
# usage : perl script-rachid.pl SORTIE-rubrique_t.txt.xml patrons_xml.txt

use strict;
use utf8;
use XML::XPath;

# 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;

# Ouverture du fichiers de motifs
open(PATTERNSFILE, "<:utf8", $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
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é 
	my $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
	#my $match_file = "res_extract-".join('_', @tokens).".txt"; #original
  my $match_file = substr($tag_file,0,-5).join('_', @tokens).".txt"; #changed

	# 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, au moyen de la méthode findnodes
	# qui prend pour argument le chemin XPath construit précédement
	# avec la fonction "construit_XPath"
	foreach my $noeud ( $xp->findnodes($search_path)) {
		# 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 $xp->find($form_xpath,$noeud)->get_node(1)->string_value," ";
		
		# 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 $xp->find($form_xpath,$noeud)->get_node(1)->string_value," ";
		
			# Incrémentation du compteur $following de cette boucle d'éxtraction des formes
			# $following++;
		}
		print MATCHFILE "\n";
	}
	# Fermeture du fichiers de motifs
	close(MATCHFILE);
}

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

#!/usr/bin/perl
use warnings;
use Time::Stopwatch; 

################################################################
#
# must have     script_rachid.pl in same directory
#
################################################################

tie my $timer, 'Time::Stopwatch'; #start counting time

#printing usage if no argument set
if (!$ARGV[0] or !$ARGV[1]){
  $0 =~ s/.*\\(.*)/$1/; #name of this script without path
  print "\nUSAGE:\nperl $0 <directory containing results> <fichier avec patrons>\n";
  exit;
}

#openning the dir. with extracted titles and description
$dir = $ARGV[0];
$patrons = $ARGV[1];

opendir(DIR, $dir) or die "I cannot open dir: $dir";

while (my $file = readdir(DIR)) { #open directory
   next unless ($file =~ m/_t.xml$/); #open each file.txt
	
	my $file = $dir."/".$file;
	
	print "\nprocessing to xml : $file\n";
   
   #run treetagger using terminal
   system("script_rachid.pl $file $patrons");    
  
}

closedir(DIR);

print "\n\n === DONE in $timer s ===\n"; #printing time