Boite à Outils 3 : L'étiquetage en POS via TreeTagger
Nous avons fait deux variantes de ce script : une avec XML::RSS et une autre avec les RegEx.
La Version RegEx :
#/usr/bin/perl # perl Nom_prgm Nom_corpus "rubrique" #----------------------------------------------------------- my $rep="$ARGV[0]"; #on récupère le nom du repertoire : l'argument donné au lancement # on s'assure que le nom du répertoire ne se termine pas par un "/" $rep=~ s/[\/]$//; my $rubrique="$ARGV[1]"; my %redondant; open (FILEOUT, ">:encoding(utf8)", "sortie-$rubrique.txt"); #on vide le fichier txt sortie #close (FILEOUT); #ouvrir pour fermer, c'est con ! faudra changer open (ficOUT, ">:encoding(utf8)", "sortie-$rubrique.xml"); #on créer le fichier XML sortie print ficOUT "<?xml version='1.0' encoding=\"UTF-8\" ?>\n"; #print ficOUT "<$rubrique>\n"; print ficOUT "<bidon>\n"; close (ficOUT); #---------------------------------------- #open (ficOUT, ">>:encoding(utf8)", "sortie-$rubrique.xml"); &parcoursarborescencefichiers($rep); # on lance la récursion.... et elle se terminera après examen de toute l'arborescence #print ficOUT "</$rubrique>\n"; print ficOUT "</bidon>\n"; close (ficOUT); close(FILEOUT); #---------------------------------------- exit; #---------------------------------------------- sub parcoursarborescencefichiers { my $path = shift(@_); #je récupère le nom du repertoire opendir(DIR, $path) or die "can't open $path: $!\n"; #j'ouvre le repertoire que j'ai reçu en argument my @files = readdir(DIR); #je fais l'inventaire du contenu de ce repertoire (moins son père et lui-même) closedir(DIR); foreach my $file (@files) { next if $file =~ /^\.\.?$/; #j'ignore le répertoire pères, et le dossier lui-même $file = $path."/".$file; #je recréer leur chemin relatif complet par rapport au dossier d'où le prgm a été lancé # quand je suis face a un repertoire if (-d $file) { print "<NOUVEAU REPERTOIRE> ==> ",$file,"\n"; &parcoursarborescencefichiers($file); #recurse! print "<FIN REPERTOIRE> ==> ",$file,"\n"; } # quand j'arrive sur un fichier (txt, odt, xml ou que-sais-je ?) if (-f $file) { if ($file=~m/$rubrique.+\.xml$/) {#je ne traite que les fichiers dont le nom FINI par ".xml" #print "<",$i++,"> ==> ",$file,"\n"; my $ensemble=""; #"my" fait que la variable est globale à tous le prgm open (ficIN, "<:encoding(utf8)", $file); #ouvre le fichier puis explore toutes les lignes une par une #open (FILEOUT, ">>:encoding(utf8)", "sortie-$rubrique.txt"); #pour chaque ligne while (my $ligne=<ficIN>) { #là, "my" limite la portée de $ligne à la boucle. chomp $ligne; #On supprime le(s) caractère(s) de retours à la ligne. $ligne=~s/^ +//; #on supprime les blancs en début et fin de ligne $ligne=~s/ $//; #parce que je veux supprimer les blancs inter-balise. #mauvaise solution car colle les mots, $ensemble = $ensemble . $ligne ; #on ajoute la ligne au reste du texte (-les retours à la ligne) } #extraire le titre et la description à chaque fois : #<title>([^<]*?)<\/title>.*?<description>([^<]*?)<\/description> while ($ensemble=~/<item>.*?<title>([^<]*?)<\/title>.*?<description>([^<]*?)<\/description>.*?<\/item>/g) { my $title=$1 ; my $description=$2 ; if (!exists $redondant{$title}){ #si la clef n'existe pas, je l'ajoute et je travaille $redondant{title}=1; my ($title_new, $description_new)= &nettoyage ($title,$description) ; #on appelle la fonction définie plus bas my ($titre_etiq, $description_etiq) = &etiquetage($title_new, $description_new); #on écrit dans le .txt print FILEOUT "TITRE : $title_new\n"; print FILEOUT "DESCRIPTION : $description_new\n"; #on écrit dans le .xml print ficOUT "<titre>$titre_etiq</titre>\n"; print ficOUT "<description>$description_etiq</description>\n"; #my $inputUser = <STDIN>; } } close (ficIN); #close (FILEOUT); } } } } #---------------------------------------------- sub nettoyage { # @_[1] liste créee automatiquement qui regroupe les arguments utilisés pour lancer un sous-prgm my $var1 = shift @_ ; my $var2 = shift @_ ; $var2=~s/<.+?>//g; #vire ce qui sert à rien $var2=~s/&#39;/'/g; #remplace l'entité HTML de l'apostrophe $var2=~s/&#34;/"/g; #remplace l'entité HTML des guillemets return $var1, $var2 ; } sub etiquetage { my $var1 = shift @_ ; my $var2 = shift @_ ; open (TITRE, ">:encoding(utf8)", "titre_tmp.txt"); print TITRE $var1; close (TITRE);#obligé de fermer, avant de lancer le programme, pour éviter les conflit system("perl tokenise-utf8.pl titre_tmp.txt | ./tree-tagger.exe -lemma -token -no-unknown french-oral-utf-8.par > titre_tmp_etiq.txt"); #on étiquette system("perl treetagger2xml-utf8.pl titre_tmp_etiq.txt utf-8"); #on re-formate $/=undef; #perl lit maintenant tout le fichier, et non plus ligne à ligne open(FIC, "<:encoding(utf8)", "titre_tmp_etiq.txt.xml"); my $titre_retour=<FIC>; $titre_retour=~s/<\?xml version="1.0" encoding="utf-8" standalone="no"\?>\n//; #print $titre_retour; open (DESC, ">:encoding(utf8)", "description_tmp.txt"); print DESC $var2; close (DESC); system("perl tokenise-utf8.pl description_tmp.txt | ./tree-tagger.exe -lemma -token -no-unknown french-oral-utf-8.par > description_tmp_etiq.txt"); #on étiquette system("perl treetagger2xml-utf8.pl description_tmp_etiq.txt utf-8"); #on re-formate open(FIC, "<:encoding(utf8)", "description_tmp_etiq.txt.xml"); my $description_retour=<FIC>; $description_retour=~s/<\?xml version="1.0" encoding="utf-8" standalone="no"\?>\n//; $/="\n"; return $titre_retour, $description_retour ; }
La Version XML::RSS :
#!/usr/bin/perl use utf8; use strict; use XML::RSS; binmode STDOUT, "utf8"; # perl RegEx.pl corpus rubrique #extrait titre + description #en sortie : 2 fichier # 1 fichier.txt avec les titres et les descriptions # 1 fichier XML : mêmes infos structurées en XML my $rep="$ARGV[0]"; $rep=~ s/[\/]$//; my $rubrique="$ARGV[1]"; my %redondant; my $rss=new XML::RSS; #crée un objet qui porte le savoir lié à la bonne formation d'un fichier RSS open (FILEOUT, ">:encoding(utf8)", "XML_RSS-sortie-$rubrique.txt"); open (ficOUT, ">:encoding(utf8)", "XML_RSS-sortie-$rubrique.xml"); print ficOUT "<?xml version='1.0' encoding=\"UTF-8\" ?>\n"; print ficOUT "<racine>"; #on créer une racine pour notre fichier XML &parcoursarborescencefichiers($rep); print ficOUT "</racine>"; close (FILEOUT); close (ficOUT); exit; #________________________________________________ sub parcoursarborescencefichiers { my $path = shift(@_); #on récupère le nom du repertoire opendir(DIR, $path) or die "can't open $path: $!\n"; #je l'ouvre my @files = readdir(DIR); #je fais l'inventaire du contenu de ce repertoire closedir(DIR); #je traite tout ce que contient mon répertoire foreach my $file (@files) { next if $file =~ /^\.\.?$/; #j'ignore le répertoire père, et le dossier lui-même $file = $path."/".$file; #je recréer leur chemin relatif complet par rapport au dossier d'où le prgm a été lancé} # si l'élément est un répertoire if (-d $file) { print "<NOUVEAU REPERTOIRE> ==> ",$file,"\n"; &parcoursarborescencefichiers($file); #recurse! print "<FIN REPERTOIRE> ==> ",$file,"\n"; } # si l'élément est un fichier if (-f $file) { if ($file=~m/$rubrique.+\.xml$/) { #je ne traite que les fichiers XML eval {$rss->parsefile($file); }; #j'analyser le fichier RSS et remplace le contenu de $rss if( $@ ) { $@ =~ s/at \/.*?$//s; # remove module line number print STDERR "\nERROR in '$file':\n$@\n"; } else { foreach my $item (@{$rss->{'items'}}) { #pour chaque balise item my $description=$item->{'description'}; #on récupère le contenu de son fils "description" my $title=$item->{'title'}; #et celui de son fils 'title' $title=~s/<[^>]+>//g; #on en retire les balises $description=~s/<[^>]+>//g; if (!exists $redondant{$title}){ $redondant{title}=1; my ($title_new, $description_new)= &nettoyage ($title,$description) ; #on appelle la fonction nettoyage, définie plus bas my ($titre_etiq, $description_etiq) = &etiquetage($title_new, $description_new); print FILEOUT "$title_new\n"; print FILEOUT "$description_new\n"; print ficOUT "<article><titre>$titre_etiq</titre>\n"; print ficOUT "<description> $description_etiq</description></article>\n"; } } } } } } } sub nettoyage { # @_[1] liste créee automatiquement qui regroupe les arguments utilisés pour lancer un sous-prgm my $var1 = shift @_ ; my $var2 = shift @_ ; $var2=~s/<.+?>//g; #vire ce qui sert à rien $var1=~s/<.+?>//g; $var2=~s/&#39;/'/g; #remplace l'entité HTML de l'apostrophe $var1=~s/&#39;/'/g; $var2=~s/&#34;/"/g; #remplace l'entité HTML des guillemets $var1=~s/&#34;/"/g; if ($var1!~/[\.?!]$/){ #si la phrase ne fini pas déjà par une ponctuation forte $var1=$var1.'.'} #on y ajoute un point if ($var2!~/[\.?!]$/){ $var2=$var2.'.'} return $var1, $var2 ; } sub etiquetage { my $var1 = shift @_ ; my $var2 = shift @_ ; open (TITRE, ">:encoding(utf8)", "titre_tmp.txt"); print TITRE $var1; close (TITRE);#obligé de fermer, avant de lancer le programme, pour éviter les conflit system("perl tokenise-utf8.pl titre_tmp.txt | ./tree-tagger.exe -lemma -token -no-unknown french-oral-utf-8.par > titre_tmp_etiq.txt"); #on étiquette system("perl treetagger2xml-utf8.pl titre_tmp_etiq.txt utf-8"); #on re-formate $/=undef; #perl lit maintenant tout le fichier, et non plus ligne à ligne open(FIC, "<:encoding(utf8)", "titre_tmp_etiq.txt.xml"); my $titre_retour=<FIC>; $titre_retour=~s/<\?xml version="1.0" encoding="utf-8" standalone="no"\?>\n//; #print $titre_retour; open (DESC, ">:encoding(utf8)", "description_tmp.txt"); print DESC $var2; close (DESC); system("perl tokenise-utf8.pl description_tmp.txt | ./tree-tagger.exe -lemma -token -no-unknown french-oral-utf-8.par > description_tmp_etiq.txt"); #on étiquette system("perl treetagger2xml-utf8.pl description_tmp_etiq.txt utf-8"); #on re-formate open(FIC, "<:encoding(utf8)", "description_tmp_etiq.txt.xml"); my $description_retour=<FIC>; $description_retour=~s/<\?xml version="1.0" encoding="utf-8" standalone="no"\?>\n//; $/="\n"; return $titre_retour, $description_retour ; }