Le Script

#!/usr/bin/perl

use strict;
use warnings;
use Unicode::String qw(utf8);
use utf8;
use XML::RSS;
use File::Basename;

if ( @ARGV < 2 )
{
	die utf8("Usage: $0 <dossier d'entrée> <dossier de sortie>\nLe programme prend en argument deux dossiers en entrée .\n\n");
}


my $garbagein=0;

my $rep=$ARGV[0];
$rep=~ s/[\/]$//; 

my %dicti=();
my %dicdesc=();

my %rssdicti=();
my %rssdicdesc=();

my %xmldump = ();
my %xmlrssdump = ();

my $globtext = "";
my $rssglobtext = "";

my $sortie=$ARGV[1];
$sortie =~ s/[\/]$//; 

my $ppfolder ="$sortie/purperl/";

my $rssfolder="$sortie/xmlrss/";

my $tagged = "$sortie/tagged/";

&dirz($sortie);
&dirz($ppfolder);
&dirz($rssfolder);
&dirz($tagged);

&arbo($rep);

open(FILEglobTXT,">:encoding(UTF-8)", $ppfolder."global.txt");
print FILEglobTXT $globtext;
close FILEglobTXT;

open(FILEglobTXT,">:encoding(UTF-8)", $rssfolder."global.txt");
print FILEglobTXT $rssglobtext;
close FILEglobTXT;

foreach my $folder ($ppfolder,$rssfolder)
	{
		open(FILEglobXML, ">:encoding(UTF-8)", $folder."global.xml") or die "Erreur de création de $folder.global.xml";
		print FILEglobXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<parcours>\n<nom>Lapraye</nom>\n<filtrage>";
		opendir(DIR, $folder) or die "Erreur d'ouverture du repertoire: $!\n";
		
		my @sorties = readdir(DIR);
		closedir(DIR);

		foreach my $sortie (@sorties)
		{
			if ($sortie=~/(.+?)\.xml$/ && !( $1 eq "global"))
			{
				my $rub=$1;
				print "\n$rub";
				open(FILE,">>:encoding(UTF-8)", $folder.$sortie);
				print FILE "</$rub>\n";
				print FILE "</parcours>\n";
				close(FILE);
				#------ Sortie Globale Ecriture de contenu ---->
				print FILEglobXML "<$rub>\n";
				#print FILEOUT "<items>";
				print FILEglobXML $xmldump{$rub}; #écrire le dump global de chaque rubrique
				#print FILEOUT "</items>";
				print FILEglobXML "</$rub>";
			}
		}
		print FILEglobXML "</filtrage>\n";
		print FILEglobXML "</parcours>\n";
		close(FILEglobXML);
	} 


opendir(FOLDER,$ppfolder);
my @fichiers = readdir(FOLDER);
foreach my $fiche (@fichiers)
	{
		if ($fiche =~/^[^\.]+?\.txt$/)
		{
			&ttagging($ppfolder.$fiche);
		}
	}
closedir(FOLDER);

print utf8("\nFichiers traités : $garbagein\n");

exit 0;

#Fonctions


sub dirz
{
	my $dossier = $_[0];
	
	if (! -e $dossier)
		{
			mkdir($dossier) or die utf8("Problème avec la création du répertoire de $dossier");
		}					
	else 
	{

		print utf8("Cette opération effacera irréversiblement le contenu du répertoire $dossier. Êtes-vous sûr de continuer ? (O/n)");
		#my $answer=<STDIN>;

		if (<STDIN>=~/n/)
		{
			exit 0;
		}
		else
		{
			&rmfolder($dossier);
		}
	}
}


sub rmfolder
	{
		my $dossier = $_[0];
		print ("Suppression des fichiers de $dossier.\n");
		opendir(DIR, $dossier) or die "Erreur d'ouverture de repertoire: $!\n";
		my @tobedeleted = readdir(DIR);	
		
		foreach my $scrubbed (@tobedeleted) # pour chaque fichier dans le dossier
			{
				next if $scrubbed =~ /^\.\.?$/;
				my $destroyed = "$dossier/$scrubbed";
				print "Suppression de $destroyed\n";
				if (-d $destroyed)
				{
					&rmfolder($destroyed);
					rmdir($destroyed);
				}
				else
				{
				
					unlink $destroyed; 
				}
			}
		closedir(DIR);
		print ("Done\n");
	}


sub outputting
	{
		my ($chemin,$date,$file,$rubrique,$xmlitems,$textitems) = @_;
		my $cheminXML="$chemin$rubrique.xml";
		
		if (! -e $cheminXML) 
		{
			
			open (FILEOUT,">:encoding(UTF-8)",$cheminXML) or die utf8("Probleme a la creation du fichier $cheminXML : $!");
			print FILEOUT "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<parcours>\n<nom>Lapraye</nom>\n\n<$rubrique>\n";
			
		}
		else 
		{
			open (FILEOUT,">>:encoding(UTF-8)",$cheminXML) or die "Probleme a l'ouverture du fichier $cheminXML : $!";
		}
		print FILEOUT "<file><name>$file</name><date>$date</date><items>$xmlitems</items></file>";
		close(FILEOUT);
		
		my $cheminTXT=$chemin.$rubrique.".txt";
		if (! -e $cheminTXT )
		{
			open (FILEOUT,">:encoding(UTF-8)",$cheminTXT) or die "Problème a l'ouverture du fichier $cheminTXT";
		}
		else
		{
			open (FILEOUT,">>:encoding(UTF-8)",$cheminTXT) or die "Problème a l'ouverture du fichier $cheminTXT";
		}
			print FILEOUT "$textitems";
		close(FILEOUT);
	}


sub pureperl 
{
	my $file = $_[0];
	open(FILE,$file);
	my $firstLine=<FILE>;
	my $encodage="";
	my $xmlitems= "";
	my $textitems= "";
	my $titre = "";
	my $description = "";
	
	if($firstLine=~/encoding= ?['"]([^\'"]+)['"]/) 
	{
	    $encodage=$1; 
	}
	close(FILE);

	if (!($encodage eq "")) 
	{
		open(FILE,"<:encoding($encodage)",$file);
		my $texte="";
		
		#Stocker le contenu du fichier
		#harmoniser les fichiers - sur une seule ligne
		
		while (my $ligne=<FILE>) 
		{
			$ligne =~s/\n//g;
			$ligne=~s/\r//g;
			$texte .= $ligne;	
		}
		close FILE;
	
		$texte =~ s/> *?</></g; # coller les balises
	
		$texte=~/<channel>.*?<title>(.*?)<\/title>.*?<pubDate>(.*?)<\/pubDate>.*?<\/channel>/;
	
		my $rubrique=&nettoyerRubriques($1); #nettoyer les rubriques
	
		#print "PERL : $rubrique\n";
	
		my $date=&nettoyerTexte($2); 
		my $name=$file; 
	
		$name=~s/.*?(20.*)/$1/; 
		
		while ($texte=~/<item>.*?<title>(.*?)<\/title>.*?<description>(.*?)<\/description>/g) 
		{
			$titre=$1;
			$description=$2;
			
			if ( !( ($titre eq "") or ($description eq "") ))
			{
				$titre=&nettoyerTexte($titre);
				$description=&nettoyerTexte($description); 
		
				if (! (((exists $rssdicti{$rubrique.$titre})) && ((exists $rssdicdesc{$rubrique.$description}))) )
				{
					$rssdicti{$rubrique.$titre}="1";
					$rssdicdesc{$rubrique.$description}="1";
					
					$xmlitems .= "\n<item>\n<titre>$titre</titre>\n<description>$description\n</description>\n</item>\n";
					$textitems .= "$titre.$description.";

				}
			}
	
		}
		$globtext .= $textitems;
		$xmldump{$rubrique} .= $xmlitems;
		
		outputting($ppfolder,$date,$file,$rubrique,$xmlitems,$textitems);
		

	}
	else
	{
		print utf8("Erreur d'encodage pour $file");
	}
}


sub rssperl 
	{
		
		#			Extraire les infos : rubrique, date, nom
		my $xmlitems= "";
		my $textitems= "";
		my $titre = "";
		my $description = "";
	
		my $file = $_[0];
		my $rss = new XML::RSS;
		$rss->parsefile($file) or die utf8("Erreur lors du parsage de $file");
		my $canal = $rss->{'channel'};
		my $rubrique=$canal->{'title'};
		$rubrique=nettoyerRubriques($rubrique);
		#print "RSS : $rubrique\n";
		my $date=$canal->{'pubDate'};
		my $name=$file; 
		$name=~s/.*?(20.*)/$1/; 
		
		my $itemnum = 0;
	
		foreach my $item (@{$rss->{'items'}}) 
		{
			$itemnum += 1;
			
		
			if (!( ($item->{'title'} eq "") or ( $item->{'description'} eq "") ))
			{
				$titre = $item->{'title'};
				$description = $item->{'description'};
		
				$description=&nettoyerTexte($description);
				$titre=&nettoyerTexte($titre);
				
				if (!(((exists $dicti{$rubrique.$titre})) && ((exists $dicdesc{$rubrique.$description}))))
				{
					$dicti{$rubrique.$titre}="1";
					$dicdesc{$rubrique.$description}="1";
					
					$xmlitems .= "\n<item>\n<titre>$titre</titre>\n<description>$description\n</description>\n</item>\n";
					$textitems .= "$titre.$description.";

				}
			}
		}
		
		$xmlrssdump{$rubrique} .= $xmlitems;
		$rssglobtext .= $textitems;
		
		outputting($rssfolder,$date,$file,$rubrique,$xmlitems,$textitems);
	
		
	}


sub arbo 
{
    my $path = shift(@_); # chemin vers le dossier en entrée
    opendir(DIR, $path) or die "Probleme d'ouverture du dossier: $!\n";
    my @files = readdir(DIR);
    closedir(DIR);
    my $firstline = "";
    
    foreach my $file (@files) 
	{
		next if $file =~ /^\.\.?$/; 
		$file = $path."/".$file;
		
		if (-d $file)
		{
			&arbo($file)
		}
		    
		if (-f $file)  
		{
			if ($file=~/^[^f]+?\.xml$/) 
			{
				open(FILE,$file);
					$firstline=<FILE>;
				close FILE;
				
				if ($firstline=~/^<\?xml[^\?]+\?>/)
				{
					$garbagein++;
					print $file,"\n";
					&pureperl($file);
					&rssperl($file);
				}
				else
				{
					print utf8("$file n'est pas un vrai fichier XML ! \nEn-tête : $firstline");
				}
			}
		}
    }
}


sub ttagging
	{
		my $taggee = $_[0];
		my $concat = "";
		open(IN,"<:encoding(UTF-8)",$taggee);
		
		while (my $sentence = <IN>)
		{
			$sentence =~ s/<br clear='all'\/>//g;
			$sentence =~ s/(l'|d')([aeiouyAEIOUY])/$1 $2/g;
			$sentence =~ s/([\.;:\?,!\< \>\+-])/\n$1\n/g;
			$concat .= $sentence;
		}
		close IN;
		
		$taggee = basename($taggee);
		
		open(OUT,">:encoding(UTF-8)","/tmp/brotherrat");
		print OUT $concat;
		close OUT;
		system("cat /tmp/brotherrat | bin/tree-tagger french.par -lemma -token -no-unknown -sgml > $tagged/tagged-$taggee");
	}


#=================================================>
#		Subroutine - Nettoyage du texte
#=================================================>
sub nettoyerTexte
{
	my $tx=$_[0];
	
	$tx=~s/&#38;/&/g;
	$tx=~s/&amp;/&/g;
	$tx=~s/&amp;/&/g;
	$tx=~s/&#34;/"/g;
	$tx=~s/&quot;/"/g;
	$tx=~s/&#39;/'/g;
	$tx=~s/&apos;/'/g;
	$tx=~s/&#60;/</g;
	$tx=~s/&lt;/</g;
	$tx=~s/&#62;/>/g;
	$tx=~s/&gt;/>/g;
	$tx=~s/&#160;//g;
	$tx=~s/&nbsp;//g;
	$tx=~s/&#163;/£/g;
	$tx=~s/&pound;/£/g;
	$tx=~s/&#169;/©/g;
	$tx=~s/&#171;/«/g;
	$tx=~s/&laquo;/«/g;
	$tx=~s/&#187;/»/g;
	$tx=~s/&raquo;//g;
	$tx=~s/&#201;/É/g;
	$tx=~s/&Eacute;/É/g;
	$tx=~s/&#237;/î/g;
	$tx=~s/&icirc;/î/g;
	$tx=~s/&#239;/ï/g;
	$tx=~s/&iuml;/ï/g;
	$tx=~s/&#224;/à/g;
	$tx=~s/&agrave;/à/g;
	$tx=~s/&#226;/â/g;
	$tx=~s/&acirc;/â/g;
	$tx=~s/&#231;/ç/g;
	$tx=~s/&ccedil;/ç/g;
	$tx=~s/&#232;/è/g;
	$tx=~s/&egrave;/è/g;
	$tx=~s/&#233;/é/g;
	$tx=~s/&eacute;/é/g;
	$tx=~s/&#234;/ê/g;
	$tx=~s/&ecirc;/ê/g;
	$tx=~s/&#244;/ô/g;
	$tx=~s/&ocirc;/ô/g;
	$tx=~s/&#251;/û/g;
	$tx=~s/&ucirc;/û/g;
	$tx=~s/&#252;/ü/g;
	$tx=~s/&uuml;/ü/g;
	$tx=~s/&uuml;/ü/g;
	$tx=~s/\x9c/œ/g;
	$tx=~s/<br\/\>//g; 
	$tx=~s/<img.*?\/>//g; 
	$tx=~s/<a.*?>.*?<\/a>//g;
	$tx=~s/<![CDATA[(.*?)]]>/$1/g;
	$tx=~ s/<[^>]>//g;
	$tx=~s/\.$//;
	$tx=~s/&/et/g;
	return $tx;
}

sub nettoyerRubriques
{
	my $rubrique=shift;
	$rubrique=~s/Le Monde.fr//g;
	$rubrique=~s/LeMonde.fr//g;
	
	$rubrique=~s/É/e/g;
	$rubrique=~s/é/e/g;
	$rubrique=~s/è/e/g;
	$rubrique=~s/ê/a/g;
	$rubrique=~s/ë/e/g;
	$rubrique=~s/ï/i/g;
	$rubrique=~s/î/i/g;
	$rubrique=~s/à/a/g;
	$rubrique=~s/ô/o/g;
	$rubrique=~s/,/_/g;
	$rubrique=lc($rubrique);
	$rubrique=~s/[\.\:;\'\"\- ]+//g;
	$rubrique=~s/toutelactualitesur//g;
	$rubrique=~s/actualite//g;
	return $rubrique;
}


		
 
			Revenir en haut