#!/usr/bin/perl use warnings; use strict; use Unicode::String qw(utf8); #use List::MoreUtils qw( each_array ); ######################################################################### ## PROGRAMME PRINCIPAL ######################################################################### #on lance le programme comme ceci : perl parcours.pl 2008/ print "répertoire de départ : $ARGV[0]\n"; my $racine="$ARGV[0]"; my $texte=""; my $encodage=""; # On déclare une variable de table vide qui stockera les noms des rubriques : my %dicorub=(); my %dicotitre=(); my %dicodescription=(); #On parcours alors l'arborescence pour extraire les rubriques ######################################################################### &recuprub($racine); ######################################################################### if( %dicorub eq 0 ) { #on vérifie que la table n'est pas vide print "%dicorub est vide"; } my @rubriques = keys(%dicorub); #tout les éléments de la liste se retrouve donc être tour à tour la variable $rub #et on crée des fichiers pour récupéré l'extraction de chacune des rubriques #print @rubriques; foreach my $rub (@rubriques) { my $OUTTREETAG="Sortie_extraction_".$rub."-TreeTagger_.xml"; open (OUTTREETAG,">:encoding(UTF-8)", $OUTTREETAG) or die "Pb a l'ouverture du fichier $OUTTREETAG"; print OUTTREETAG "\n"; print OUTTREETAG "\n"; print OUTTREETAG "\n"; #close (OUTTREETAG); } #print "RECUPRUB ET FICHIERS : DONE"; ######################################################################### &recurse($racine); ######################################################################### my @rubriques = keys(%dicorub); foreach my $rub (@rubriques) { my $OUTTREETAG="Sortie_extraction_".$rub."-TreeTagger_.xml"; open (OUTTREETAG,">>:encoding(UTF-8)", $OUTTREETAG) or die "Pb a l'ouverture du fichier $OUTTREETAG"; print OUTTREETAG "\n"; close (OUTTREETAG); } exit; ######################################################################### ## SOUS - PROGRAMMES ######################################################################### ######################################################################### ## RECUPERATION DES NOMS DE RUBRIQUES ######################################################################### sub recuprub { my $dossier=shift(@_); opendir(DOSSIER, $dossier) or die "can't open $dossier : $!\n"; my @fic = readdir(DOSSIER); closedir(DOSSIER); foreach my $fic(@fic) { next if $fic=~/^\.\.?$/; my $fic=$dossier."/".$fic; #print $fic,"\n"; if (($fic eq ".") or ($fic eq "..")) { print "je suis sur . ou .. : je ne fais rien"; next }; if (-d $fic) { my $chemin=$dossier."/".$fic; &recuprub($fic); } if (-f $fic) { #print $fic,"\n"; my $encodage=""; open(IN, $fic); my $firstline=; if ( $firstline =~/encoding ?= ?[\"\']+([^\"\']+)[\'\"]+/i){ $encodage=$1; } #print $encodage; #close(IN); if ($encodage ne "") { if ($fic=~/.*?.xml/){ open (IN, "<:encoding($encodage)", $fic); ## tableau des arguments entrés en ligne de commande while (my $ligne=){ #print $ligne; $ligne =~ s/\r/\n/g; $ligne =~ s/\n//g; $ligne=~s/> */g){ my $rub = $1; if (uc($encodage) ne "UTF-8") {utf8($rub);} #print $rub; ###### On nettoie les noms $rub =uc($rub); ## On les met en majuscule #print $rub, "\n"; $dicorub{$rub}++; ##Autovivification de la table de hachage (chaque rub est mise en clé avec une valeur de 1, évite les doublons) } } } #close(IN); #print keys(%dicorub); } } } } ######################################################################### ## PARCOURS DE L'ARBORESCENCE ######################################################################### sub recurse { my $dossier=shift(@_); opendir(DOSSIER, $dossier) or die "can't open $dossier: $!\n"; my @files = readdir(DOSSIER); closedir(DOSSIER); #print "liste de fichiers de $dossier: @files\n"; foreach my $file(@files) { next if $file=~/^\.\.?$/; my $file=$dossier."/".$file; #print $file,"\n"; if (($file eq ".") or ($file eq "..")) { print "je suis sur . ou .. : je ne fais rien"; next }; if (-d $file) { my $chemin=$dossier."/".$file; &recurse($file); } if (-f $file) { if (($file=~/.*?.xml/) && ($file!~/^fil.+\.xml/)){ print $file, "\n"; my $encodage; open(IN, $file); my $ligne=""; $ligne=; if ($ligne=~ /encoding=[\"\']+([^\"\']+)[\'\"]+/) { $encodage=$1; $encodage=uc($encodage); } print $encodage, "\n"; #close(IN); if ($encodage ne "") { ###### Traitement des fichier xml en fonction de leur encodage : open (IN, "<:encoding($encodage)",$file); while (my $ligne=){ ###### On recherche la rubrique pour lui indiquer le fichier de sortie : $ligne =~ s/\r/\n/g; $ligne =~ s/\n//g; $ligne=~s/> */g){ my $rub =$1; #$rub = &nettoietexte($1); if (uc($encodage) ne "UTF-8") {utf8($rub);} $rub =uc($rub); #print $rub, "\n"; my $OUTTREETAG="Sortie_extraction_".$rub."-TreeTagger_.xml"; open (OUTTREETAG, ">>:encoding(UTF-8)", "$OUTTREETAG") or die "Erreur : impossible d'ouvrir le fichier $OUTTREETAG"; print $rub, "\n"; #$texte.=$ligne; while ($ligne=~/(.*?)<\/titre>(.*?)<\/description>/g){ my $titre=$1; my $description=$2; print $rub, "\n"; print "TEST 1 : $titre \n"; my ($titreTT, $descripTT)=&etiquetagetreetagger($titre,$description); ## on ne taggue pas les doublons non plus print OUTTREETAG "\n\n".$titreTT."<\/titre>\n\n".$descripTT."<\/description>\n<\/item>\n"; } } } #close (IN); #print $file,"\n"; } } close (OUTTREETAG); } } } ######################################################################### ## NETTOYAGE DU TEXTE ######################################################################### ######################################################################### ## ETIQUETAGE AVEC TREETAGGER ######################################################################### sub etiquetagetreetagger { my ($titre, $description)=(@_); my $tmptag="texteaetiqueter.txt"; open (TMPFILE,">:encoding(utf-8)", $tmptag); print TMPFILE $titre,"\n"; #print "TEST TT TITRE : $titre \n"; #close(TMPFILE); system("perl /Applications/Treetagger/tagger-scripts/cmd/tokenize.pl $tmptag | /Applications/Treetagger/bin/tree-tagger /Applications/Treetagger/models/fr.par -lemma -token -no-unknown -sgml > treetagger.txt"); system("perl /Applications/Treetagger/tagger-scripts/cmd/treetagger2xml.pl treetagger.txt"); # lecture du resultat tagge en xml : open(OUT,"<:encoding(utf-8)","treetagger.txt.xml"); my $fistline=; my $titreTT=""; while (my $l=) { $titreTT.=$l; } #close(OUT); #----- le resume open (TMPFILE,">:encoding(utf-8)", $tmptag); print TMPFILE $description,"\n"; #close(TMPFILE); system("perl /Applications/Treetagger/tagger-scripts/cmd/tokenize.pl $tmptag | /Applications/Treetagger/bin/tree-tagger /Applications/Treetagger/models/fr.par -lemma -token -no-unknown -sgml > treetagger.txt"); system("perl /Applications/Treetagger/tagger-scripts/cmd/treetagger2xml.pl treetagger.txt"); # lecture du resultat tagge en xml : open(OUT,"<:encoding(utf-8)","treetagger.txt.xml"); $fistline=; my $descripTT=""; while (my $l=) { $descripTT.=$l; } close(OUT); # on renvoie les resultats : return ($titreTT, $descripTT); }