La Profondeur : traitement en pur Perl

Ci-dessous le script leMondeProfond.pl.
Téléchargement du programme.
Téléchargement des résultats. XML TXT

#!usr/bin/perl

###################################################
# TODO :
#	Ligne 16 (cf 09-03-16.pl, ligne 9)
###################################################
# BUT DU PROGRAMME :
# - prendre en compte l'arborescence
# - appel du programme : perl -w filtrage2.pl "repertoire" "rubrique"
###################################################

######################################### MAIN #########################################
my $rubrique = "$ARGV[1]";
#my @rubrique = ("0,57-0,64-823353,0", "0,2-3214,1-0,0", "0,2-3232,1-0,0", "0,2-3238,1-0,0");

# ouverture du repertoire 
my $rep="$ARGV[0]";
# suppression du dernier "/"
$rep=~ s/[\/]$//;
# initialisation de la variable de sortie
#my $DUMPFULL1="";
#----------------------------------------
# creation du fichier .txt de sortie
open my $out, ">:encoding(utf-8)", "$rubrique"."_Profond.txt";
close $out;
#----------------------------------------
# ouverture du fichier XML qui contiendra le texte taggue et balise
my $output1="SORTIE_Profond.xml";
if (!open (FILEOUT,">$output1")) { die "Pb a l'ouverture du fichier $output1"};
# ecriture de l'en-tete du fichier XML.
print FILEOUT "\n";
print FILEOUT "\n";
print FILEOUT "G. Chaminade, C. Monnin\n";
# fermeture du fichier qui sera rouvert dans procedure &parcoursarborescencefichiers
close(FILEOUT);
#----------------------------------------
# appel de la fonction qui parcourt l'aborescence et extrait les contenus textuels
&parcoursarborescencefichiers($rep);
#----------------------------------------
# rouverture du fichier XML contenant le texte taggue et balise
open (FILEOUT,">>:encoding(utf-8)", $output1);
# fermeture de la balise racine
print FILEOUT "\n";
close(FILEOUT);
exit;
#########################################################################################

############################### Definition des fonctions ################################
#----------------------------------------------
sub parcoursarborescencefichiers {
	# creation d'un dictionnaire qui contiendra 
	my %dico;
	# creation de la variable path qui contient le chemin passe en parametre a la procedure
	my $path = shift(@_);
	# ouverture du dossier indiqué dans le path
	opendir(DIR, $path) or die "can't open $path: $!\n";
	# lecture du repertoire et stockage des noms de contenu dans l'array @files
	my @files = readdir(DIR);
	# fermeture du repertoire
	closedir(DIR);
	# boucle sur le contenu de l'array
	foreach my $file (@files) {
		# elimination des dossiers ./ et ../
		next if $file =~ /^\.\.?$/;
		# stockage du chemin complet dans $file
		$file = $path."/".$file;
		# si $file est un repertoire :
		if (-d $file) {
			print " ==> ",$file,"\n";
			# recursion de la procedure
			&parcoursarborescencefichiers($file);
			print " ==> ",$file,"\n";
		}
		# si $file est un fichier :
		if (-f $file) {
			# si $file correspond à la rubrique passee en parametre :
			if ($file =~ /$rubrique.*.txt/) {
				# ouverture du fichier en lecture
				open my $in, "<:encoding(utf-8)", $file;
				# ouverture de la sortie en ecriture qui contiendra les donnes textuelles brutes
				open $out, ">>:encoding(utf-8)", "$rubrique"."_Profond.txt";
				# ouverture de la sortie XML tagguee
				open FILEOUT,">>:encoding(utf-8)", "SORTIE_Profond.xml";
				# initialisation de la variable $texte
				my $texte="";
				# pour chaque ligne du fichier en lecture
				while (my $ligne = <$in>) {
					$ligne =~ s/<.*>.*$|^ +.*$|^[0-9]+.*$|^Article .*$|^Découvrir .*\n$|^Le Monde\n$|^Suivre\n$|^Aller .*\n$|^\n?$//g;
					# si le fichier a des retours chariot windows :
					if ($ligne =~/"\r\n"/){
						# on les elimine
						$ligne=~ s/\r\n//;
					}
					# sinon
					else{
						# on chompe
						chomp $ligne;
						#print $ligne;
					}
					if (! (exists $dico{$ligne})) {
						# on l'ajoute a la sortie .txt
						print $out "$ligne\n";
						$dico{$ligne} = 1;
						#Ajout 17/02/16 = appel de l'étiquetage
						my ($textetag) = &etiquetage($ligne);
						# ecriture du contenu textuel taggue et balise dans le fichier de sortie XML
						print FILEOUT "$textetag";
					}
				}
						# fermeture du fichier en lecture
						close $in;
						# signal dans le shell
						print "<",$i++,"> ==> ",$file,"\n";
						# fermeture du fichier .txt
						close $out;
			}
		}
	}
}



#----------------------------------------------
#Ajout 17/02/16
sub etiquetage {
	# contenus textuels du fichier RSS
	my ($t) = @_; #my ($x) = @_;

	#ouverture d'un fichier temporaire pour TreeTagger
	open(TMP, ">:encoding(utf-8)", "texte.txt");
	#copie du contenu textuel precedemment extrait dans le fichier temporaire
	print TMP $t;
	close(TMP);
	############## Appel d'un shell pour lancer treetagger ###############
	# appel de Tree-tagger
	# IN : fichier temporaire | OUT : fichier txt taggue
	system("tree-tagger-french \"texte.txt\" > texte_tag.txt");
	# appel de treetagger2xml.pl
	# IN : fichier txt taggue | OUT : fichier.txt.xml taggue et balise
	system("perl treetagger2xml-utf8.pl texte_tag.txt utf-8");
	#######################################################################
	# ouverture du fichier .txt.xml
	open(TMP2, "<:encoding(utf-8)", "texte_tag.txt.xml");
	my $t_tag="";
	my $ligne = ;
	while (my $ligne = ) {
		#copie des lignes du fichier taggue et balise dans la variable $t_tag qui sera retournee
		$t_tag= $t_tag.$ligne;
	}
	close(TMP2);

	return($t_tag);
}
#########################################################################################