Version HTML du script extraction-xml.pl

Pour télécharger le script : cliquez ici

#/usr/bin/perl
<<DOC; 
Axel COURT & Marjorie SEIZOU
MARS 2010
 usage : perl extraction-xml.pl fichier_taggé fichier_motif
 
DOC

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

# Utilisation de la bibliothèque perl XML::Path
use XML::XPath;

# Enregistrement des arguments dans des variables
my $tag_file = shift @ARGV;
my $patterns_file = shift @ARGV;

# Initialisations
my @patterns;
my $nb_patterns=0;
my $nb_tokens=0;
my %posreconnus;

######################
# Ouverture du fichier de patrons
open(PATTERNSFILE, $patterns_file) or die "Impossible d'ouvrir $patterns_file : $!\n";
# Lecture du fichier contenant les motifs, un motif par ligne (par exemple : NOM ADJ) => on stocke ces patrons dans un tableau
while ($ligne = <PATTERNSFILE>) {
	# On supprime avec la fonction chomp un éventuel retour à la ligne
	chomp($ligne);
	# 
	$nb_patterns = push(@patterns,$ligne);
}

# Création de l'objet XML::XPath pour explorer le fichier fichier XML donné en argument
my $xp = XML::XPath->new( filename => $tag_file ) or die "Oups, impossible de générer l'objet XML::XPath : vérifiez la bonne formation de votre document XML !";

# Recherche des motifs dans le fichier XML donné en argument
foreach $pattern (@patterns) {
	# Construction au moyen de la fonction split d'un tableau dont chaque élément a pour valeur  un token du motif recherché
	@tokens = split(/ /,$pattern);
	$posreconnus{$pattern} = ();
	&extract_pattern(@tokens);
}

# Ecriture de la sortie
my $namefile =  $tag_file;
$namefile =~ s/(.+)(\.xml)/$1/;
my $match_file = "resultat_$namefile.txt";
# Ouverture de ce fichier fraîchement créé
open(MATCHFILE, ">:encoding(iso-8859-1)", "$match_file") or die "Impossible d'ouvrir $match_file : $!\n";
#-------------------------------------------------
# Impression des résultats de l'extraction
#-------------------------------------------------
my $out = "";
#-------------------------------------------------
# Parcours de la table de hachage
while ( ($key, $value) = each(%posreconnus) ) {
	if ($value ne "") {
		$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 MATCHFILE $out;
# Fermeture du fichier !
close(MATCHFILE);

# Routine d'extraction d'un motif
sub extract_pattern {
	@tokenz = @_;
	# La fonction shift coupe le premier élement d'un tableau et le revoie en résultat
	$first_token = shift @tokenz;
	chomp($first_token);
	# Initialisation du chemin xpath correspondant au motif recherché
	# Pas d'effet de bord possible : le script principal de parcours des fils RSS ajoute un "point" de ponctuation finale après chaque titre et chaque résumé, s'il n'y
	# en a pas déjà. Conséquence : impossible d'extraire par exemple l'adjectif final d'un titre et le nom qui commence le résumé suivant
	$search_path = "//element/data[1][contains(text(),\"$first_token\")]";
	foreach my $token (@tokenz) { # Construction  recursive du chemin xpath correspondant au motif recherché
		chomp($token);
		$search_path .= "/ancestor::element/following-sibling::element[1]/data[1][contains(text(),\"$token\")]";
	}
	# Boucle sur les nœuds reconnus du chemin xpath
	foreach my $noeud ( $xp->findnodes($search_path)->get_nodelist() ) {
		# Initialisation du tableau des formes => ne contient qu'un seul motif à la fois
		# On le fait ici pour des raisons évidentes d'économie de mémoire et donc de performance
		my @matching_tokens;
		# On remonte d'un cran au nœud  parent pour extraire la forme trouvée
		# Dans le cas d'un motif NOM ADJ, c'est la forme de l'adjectif qu'on atteint
		$noeud_tmp = $noeud -> getParentNode;
		$i = 0;
		foreach (@tokens) {
			$i++;
			# on récupère la forme
			# noter que le "3" de getChildNode(3) correspond au "data[3]" de la feuille XSLT
			$motif = $noeud_tmp->getChildNode(3)->string_value;
			# unshift(@matching_tokens,$motif) ajoute au début du tableau @matching_tokens un élément dont la valeur est le contenu de la variable $motif (puisqu'on part de la fin du motif)
			$nb_tokens = unshift(@matching_tokens, $motif);
			$motif = "";
			# On remonte recursivement aux nœuds précedents pour extraire la forme
			# dans le cas d'un motif NOM PRP NOM, on récupère ainsi PRP puis NOM (le premier)
			# Noter que "precding-sibling" est l'axe inverse de "following-sibling"
			@noeudtmp = $xp->findnodes("./preceding-sibling::element[1]",$noeud_tmp)->get_nodelist();
			$noeud_tmp = shift(@noeudtmp);
		}
		# Écriture des résultats dans un fichier en utilisant la fonction join, pratique !
		push(@{$posreconnus{$pattern}}, join(' ', @matching_tokens));
	}
}