Version HTML du script extraction-basique.pl

Pour télécharger le script : cliquez ici

#!/usr/bin/perl
<<DOC; 
Axel COURT & Marjorie SEIZOU
MARS 2010
 usage : perl extraction-basique.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, $ARGV[0]);

# Initialisation des listes
my @malignesegmentee = ();
my @listedetokens = ();
my @listedelemmes = ();
my @listedepos = ();
my %posreconnus;

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

# Lecture du fichier de tags ligne par ligne
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);
# On s'occupe d'un intervalle entre deux signes de ponctuation
		if ($ligne !~ /PCTFORTE|PCTFAIB|SENT|PUN/) {
# 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]);
			}
		}
		else {
# Transformation de la listedepos en scalaire (séparateur = en fonction de celui de la liste de pos à chercher, entrée par l'utilisateur)
			my $scalairedepos = join(" ", @listedepos);
			open (FICPOS, $ARGV[1]);
			while (my $terme = <FICPOS>) {
				chomp($terme);
# Calcul du nombre de blancs dans le patron
				my $lgterme = 0;
				while ($terme =~ / /g) {
					$lgterme++;
				}
# Calcul du nombre de blancs dans le contexte gauche
				my $dump = "";
				while ($scalairedepos =~ /(.*?)$terme/g) {
					$dump .= "PATRON RECONNU ! \t";
					my $contextegauche = $1;
					my $blancs = 0;
					while ($contextegauche =~ / /g) {
						$blancs++;
					}
# Calcul des indices de @listedetokens en se basant sur les blancs du contexte et du patron3
					my $j = $blancs;
					while ($j <= ($blancs+$lgterme)) {
						$dump .= "$listedetokens[$j] {$listedepos[$j]} ";
						$j++;
					}
					if ($dump ne "") {
						push(@{$posreconnus{$terme}},$dump);
					}
					$dump = "";
				}
			}

# Vidage des listes
			@listedetokens = ();
			@listedelemmes = ();
			@listedepos = ();
		}
	}
}

#-------------------------------------------------
# Impression des résultats de l'extraction
#-------------------------------------------------
# Ouverture du fichier de sortie en écriture
open (FICOUT, ">:encoding(iso-8859-1)", "resultat_$programme.txt");
my $out = "";
#-------------------------------------------------
# Parcours de la table de hachage
print "Ecriture des resultats\n";
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(FICTAG);
close(FICPOS);
close(FICOUT);
exit;