#/usr/bin/perl <<DOC; usage : perl bao3_carrey.pl fichier-talismane fichier-patrons nom-rubrique Le programme prend en entrée le nom du fichier talismane à traiter, le nom du fichier contenant les patrons, et le nom de la rubrique -> extraction de patrons DOC #-------------------------------------------------------------------------------------------- use utf8; # Ouverture des fichiers en lecture open (FICTAG, $ARGV[0]) or die ("Probleme sur ouverture de la sortie Talismane !"); #fichier talismane open (FICPOS, $ARGV[1]) or die ("Probleme sur ouverture du fichier des patrons !"); #fichier patrons #ouverture du fichier de sortie open(OUT, ">:encoding(iso-8859-1)", "SORTIEBAO3/patrons_$ARGV[2].txt"); # on stocke les patrons dans une liste my @listedespatrons=(); while (my $lignepos = <FICPOS>) { #on continue à lire tant que c'est possible chomp($lignepos); #supprimer le caractère de fin de ligne push(@listedespatrons,$lignepos); #on ajoute la ligne à la liste } close(FICPOS); #fermeture du fichier contenant les patrons # Initialisation des listes my @malignesegmentee = (); my @listedesindexs=(); my @listedetokens = (); my @listedelemmes = (); my @listedepos = (); # Lecture du fichier talismane ligne par ligne while (my $ligne = <FICTAG>) { #on continue à lire tant que c'est possible # On ne s'occupe pas des lignes qui ne respectent pas la modèle mot tab mot tab mot if ($ligne =~ /^[0-9]+\t[^\t]+\t[^\t]+\t[^\t]+\t/) { chomp($ligne); #supprimer le caractère de fin de ligne # Remplissage des listes @malignesegmentee = split(/\t/, $ligne); push(@listedesindexs, $malignesegmentee[0]); push(@listedetokens, $malignesegmentee[1]); push(@listedelemmes, $malignesegmentee[2]); push(@listedepos, $malignesegmentee[3]); } } close(FICTAG); #------------------------------------------------------------- # Parcours des POS et des tokens en // #------------------------------------------------------------- # création d'une liste tmp des POS à parcourir en supprimant le premier element my @tmplistedespos=@listedepos; #on lui affecte la valeur de la liste de POS my $indice=0; #initialisation du compteur des indices while (my $POS =shift(@tmplistedespos)) { foreach my $patron (@listedespatrons) { #pour chaque patron my @listedeterme=split(/\t/,$patron); #on segmente le patron pour connaitre son premier element # on teste si l'element courant POS correspond au premier element du patron if ($POS eq $listedeterme[0]) { # si oui, on regarde s'il y a correspondance pour la suite my $verif=0; for (my $i=0;$i<=$#listedeterme-1;$i++) { if (($tmplistedespos[$i] eq $listedeterme[$i+1]) and ($listedesindexs[$i+1] >= $listedesindexs[$i] )) { #Le suivant est bon aussi $verif++ ; } } # si verif = nb d'element du patron => on a tt reconnu # on imprime les tokens en // aux POS : astuce $indice permet de garder le // entre POS et TOKEN if ($verif == $#listedeterme) { for (my $i=0;$i<=$#listedeterme;$i++) { print OUT $listedetokens[$indice+$i]," "; } print OUT "\n"; } } } my $tmp=shift(@listedesindexs); $indice++; # on avance dans la liste des index, des POS et des TOKEN en // }