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;