Version HTML du script extraction-listes.pl

Pour télécharger le script : cliquez ici

#!/usr/bin/perl


<<DOC; 
Script original par Serge FLEURY
Axel COURT & Marjorie SEIZOU
MARS 2010
 usage : perl extraction-listes.pl fichier_taggé fichier_motif
DOC

# Test des paramètres

if($#ARGV!=1){
	print "usage : perl $0 fichier_tagge fichier_motif\n";
	exit;
}

#----------------------------------

# Ouverture des fichiers en lecture

#----------------------------------

open (FICTAG, "<:encoding(iso-8859-1)", $ARGV[0]) or die ("Probleme sur ouverture de tags : $!\n");
open (FICPOS, "<:encoding(iso-8859-1)", $ARGV[1]) or die ("Probleme sur ouverture du fichier des patrons : $!\n");
#-----------------------------------------

# on stocke les patrons dans une liste...

#-----------------------------------------

my @listedespatrons=();
while (my $lignepos = <FICPOS>) {
    chomp($lignepos);
    push(@listedespatrons,$lignepos);
}
close(FICPOS);
#---------------------------

# Initialisation des listes

#--------------------------

my @malignesegmentee = ();
my @listedetokens = ();
my @listedelemmes = ();
my @listedepos = ();
my %posreconnus;
#-------------------------------------------

# Lecture du fichier de tags ligne par ligne

#-------------------------------------------


# On détermine si le fichier de tags passé en argument est un fichier TreeTagger ou Cordial

# Pour cela, on se base sur l'extension du fichier : on part du principe qu'un fichier Cordial est un fichier .cnr

# et un fichier TT est un fichier .txt classique

my $programme = "";
if ($ARGV[0] =~ /.*\.cnr$/) {
	$programme = "Cordial";
}
elsif ($ARGV[0] =~ /.*\.txt$/) {
	$programme = "TreeTagger";
}

while (my $ligne = <FICTAG>) {
    #----------------------------------------------------------------------------------

    # On ne s'occupe pas des lignes qui ne respectent pas la modèle mot tab mot tab mot

    #----------------------------------------------------------------------------------

    if ($ligne =~ /^[^\t]+\t[^\t]+\t[^\t]+$/) {
	#-------------------------------------------

	# Suppression du caractère de saut de ligne

	chomp($ligne);
	#-------------------------------------------

	# Remplissage des listes

	@malignesegmentee = split(/\t/, $ligne);
	if ($programme eq "Cordial") {
		push(@listedetokens, $malignesegmentee[0]);
		push(@listedelemmes, $malignesegmentee[1]);
		push(@listedepos, $malignesegmentee[2]);
	}
	elsif ($programme eq "TreeTagger") {
		push(@listedetokens, $malignesegmentee[0]);
		push(@listedelemmes, $malignesegmentee[2]);
		push(@listedepos, $malignesegmentee[1]);
	}
	#-------------------------------------------

    }
}
close(FICTAG);
#-----------------------------------

# on va maintenant parcourir les POS

# et les TOKENS en //

#----------------------------------------------------------------------------------------

# 1. on cree une liste tmp des POS que l'on va parcourir en supprimant le premier element 

#    a chaque fois

#----------------------------------------------------------------------------------------

my @tmplistedespos=@listedepos;
my $indice=0;
while (my $a =shift(@tmplistedespos)) {
    foreach my $patron (@listedespatrons) {
	#-----------------------------------

	# on segmente le patron pour connaitre

	# son premier element

	my @listedeterme=split(/ /,$patron);
	#-----------------------------------

	# on teste si l'element courant POS correspond au premier element du patron...

	if ($a=~/$listedeterme[0]/) {
	    # si c'est OK...

	    # on regarde maintenant s'il y a correspondance pour la suite...

	    my $verif=0;
	    for (my $i=0;$i<=$#listedeterme-1;$i++) {
		if ($tmplistedespos[$i]=~/$listedeterme[$i+1]/) { 
		    #Le suivant est bon aussi...

		    $verif++ ;
		}
		else {
		    # ici : $tmplistedespos[$i] differe de $listedeterme[$i+1]...

		}
	    }
	    #------------------------------------------------------------------------

	    # si verif est egal au nb d'element du patron c'est qu'on a tt reconnu... 

	    # on imprime les tokens en // aux POS : astuce $indice permet de garder le 

	    # le // entre POS et TOKEN....

	    #------------------------------------------------------------------------

	    if ($verif eq ($#listedeterme)) { 
		my $suite = "";
		for (my $i=0;$i<=$#listedeterme;$i++) {
		    $suite .= $listedetokens[$indice+$i]." ";
		}
		push(@{$posreconnus{$patron}},$suite);
	    }
	}
    }
    $indice++;
    # on avance dans la liste des POS et des TOKEN en //

}
#-------------------------------------------------

# Impression des résultats de l'extraction

#-------------------------------------------------

open (FICOUT, ">:encoding(iso-8859-1)", "resultat_$programme.txt") or die ("Probleme sur ouverture du fichier de sortie : $!\n");
my $out = "";
#-------------------------------------------------

# Parcours de la table de hachage

while ( ($key, $value) = each(%posreconnus) ) {
	$out .= "------------------------\n";
	$out .= "$key\n-------------------------\n";
	#--------------------------------------------------------------

	# Parcours du tableau contenant les suites de mots reconnues

	# qui correspondent au patron syntaxique (la clé)

	foreach my $term (@$value) {
		$out .= $term;
		$out .= "\n";
	#--------------------------------------------------------------

	}
	$out .= "\n\n\n";
}
print FICOUT $out;
close(FICOUT);
#-------------------------------------------------