1 #!usr/bin/perl 2 3 # But du programme : extraire d'un fichier 4 # Fonctionnement : perl prog fichier_de_treetagger|fichier_de_cordial ==> pour l'utilisation de fichiers cordial on fera attention de : 5 # a) corriger le fichier motif 6 # b) de modifier les impressions des colonnes en conséquence 7 8 use strict; 9 use warnings; 10 use Data::Dumper; 11 use 5.014; 12 13 die "syntaxe pour programme $0 : perl prog fichierTagger(résultat treetagger) fichierMotif(1 ligne séparée par tabulation) nomSortie" unless (@ARGV==3); 14 # création d'un dossier de sortie 15 mkdir ("./RESULTAT_EXTRACTION_MOTIF_PERSO"); 16 # récupération des arguments 17 my $fichier = shift @ARGV; 18 my $fichierMotif = shift @ARGV; 19 my $motifName = shift @ARGV; 20 #on change un peu le nom de sortie 21 $motifName =~ s/.txt//g; 22 #on donne le nom de fichier en cours de traitement 23 say"_"x20; 24 say "extraction : $motifName"; 25 #chemin final de sortie 26 my $fichierSortie = "./RESULTAT_EXTRACTION_MOTIF_PERSO/Result". $motifName; 27 ##say $fichierSortie; 28 #ouverture de fichiers entrées/ et du fichier de sortie 29 open (my $INData, "<", "$fichier") or die "problème ouverture fichier tagger : $!"; 30 open (my $INMotif, "<", "$fichierMotif") or die "problème ouverture fichier motif : $!"; 31 open (my $OUTmotif, ">>", "$fichierSortie") or die "problème ouverture fichier motif : $!"; 32 #découpage et stockage du motif 33 my @motif = split /\t/, <$INMotif>; 34 # sans cette ligne le fichier de motif pose problème, résidu de la fonction split ??? 35 $motif[scalar(@motif) - 1] =~ s/\R//; 36 37 # préparation des variables 38 my @tag1 =(); 39 my @tag2 =(); 40 my @tag3 =(); 41 my $stock1; 42 my $stock2; 43 my $stock3; 44 45 #extraction et stockage du fichier issu de treetagger (ou de cordial), et découpe selon les tabulations, stockage dans trois tableaux 46 foreach (<$INData>) 47 { 48 #chomp; 49 ($stock1, $stock2, $stock3) = split /\t/, $_; 50 push @tag1, $stock1; 51 push @tag2, $stock2; 52 push @tag3, $stock3; 53 } 54 # préparations des compteurs 55 my $i=0; 56 my $j; 57 #préparation des tableaux pour stocker les résultats 58 my @result1 = (); 59 my @result2 = (); 60 my @result3 = (); 61 #on parcourt la liste entière de tag 62 for ($i = 0; $i < scalar(@tag2); $i++) 63 { 64 # on parcourt pour chacun aussi chaque élément du motif 65 for ($j = 0; $j < scalar(@motif); $j++) 66 { 67 #say ' [', $tag2[$i + $j], '] motif [' , $motif[$j] , "]"; 68 #si le tag est égal au motif on stocke dans le fichier résultat 69 #l'avantage de cette technique est que comme les indices sont égaux à 0, au premier tour pour le motif (j=0), et donc le tag en court est comparer au premier élément du motif. Au deuxième tour on prend la référence du premier tag et on déplace les indices de 1 on teste donc si tag[reférence+1] == motif[2] ... l'avantage ? Quelque soit la taille du motif on peut tester les indices de 0 à n ! 70 if ($tag2[$i + $j] eq $motif[$j]) 71 { 72 push (@result1, $tag1[$i + $j]); 73 push (@result2, $tag2[$i + $j]); 74 push (@result3, $tag3[$i + $j]); 75 } 76 #Si on trouve une faute pendant le parcourt du motif on "reset" les tableaux et on quitte la boucle, on passera à la suite 77 else 78 { 79 @result1 = (); 80 @result2 = (); 81 @result3 = (); 82 last; 83 } 84 # Quand $j est égal au nombre d'éléments du motif, on a réussi, on imprime. Puis on "reset" les tableaux pour tester un nouveau motif jusqu'à la fin du fichier. Si on veut changer un élément d'impression (par exemple pour utiliser un fichier cordial) on change ici les éléments d'impression. 85 if ($j == (scalar(@motif) - 1)) 86 { 87 88 89 say $OUTmotif "@result1"; 90 #print $OUTmotif Dumper (@result1); 91 #print $OUTmotif Dumper(@result2); 92 #print Dumper(@result3); 93 #@result = (); 94 @result1 = (); 95 @result2 = (); 96 @result3 = (); 97 } 98 } 99 } 100 close $OUTmotif; 101 close $INData; 102 close $INMotif;