Projet Encadré II

Toolbox I

Codes

Posted on 6 March 2015 by Fahad - Michael - Sina
#!/usr/bin/perl
use strict;
use Unicode::String qw(utf8);
use HTML::Entities;

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

my $sortie="Sorties/";
if (! -e $sortie){	
mkdir($sortie) or die ("Problème à la création du répertoire : $!");
}

$sortie="Sorties/BAO1/";
if (! -e $sortie){
mkdir($sortie) or die ("Problème à la création du répertoire : $!");
}

my %titles=();
my %descriptions=();
my %sections=();
&brwoser($rep);

my @list_section = keys(%sections);    
foreach my $rub (@list_section) {
my $output1 = $sortie.$rub.".xml"; 
my $output2 = $sortie.$rub.".txt";
if (!open (OUTXML,">:encoding(utf-8)", $output1)) { die "Can't open file $output1"};   
if (!open (OUTTXT,">:encoding(iso-8859-1)", $output2)) { die "Can't open file $output2"};   
print OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print OUTXML "<EXTRACTION>\n";
close(OUTXML);
close(OUTTXT);
}

&directoryBrowsing($rep);

foreach my $rub (@list_section) {
my $output1=$sortie.$rub.".xml";
if (!open (OUTXML,">>:encoding(utf-8)", $output1)) { die "Can't open file $output1"};
print OUTXML "</EXTRACTION>\n";
close(OUTXML);
}
exit;

sub directoryBrowsing {
my $path = shift(@_);
opendir(DIR, $path) or die "Can't open $path: $!\n";
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
$file = $path."/".$file;
if (-d $file) {
&directoryBrowsing($file);	
}
if (-f $file) {
if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
open(FILE, $file);
print "Traitement de : $file\n";
my $texte="";
while (my $ligne=<FILE>) {
$ligne =~ s/\n//g;
$ligne =~ s/\r//g;
$texte .= $ligne;
}
close(FILE);
$texte=~s/> *</></g;
$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
my $encodage=$1;
print "ENCODAGE : $encodage\n";
if ($encodage ne "") {
my $texteXML="<file>\n";
$texteXML.="<name>$file</name>";
$texteXML.="<items>\n";
my $texteBRUT="";
open(FILE,"<:encoding($encodage)", $file);
$texte="";
while (my $ligne=<FILE>) {
$ligne =~ s/\n//g;
$ligne =~ s/\r//g;
$texte .= $ligne;
}
close(FILE);
$texte=~s/> *</></g;
$texte=~/[<channel>|<atom.+>]<title>([^<]+)<\/title>/;
my $rub=$1;
$rub=~s/Le ?Monde.fr ?://g;
$rub=~s/ ?: ?Toute l'actualité sur Le Monde.fr.//g;
$rub=~s/\x{E8}/e/g;
$rub=~s/\x{E0}/a/g;
$rub=~s/\x{E9}/e/g;
$rub=~s/\x{C9}/e/g;
$rub=~s/ //g;
$rub=uc($rub);
$rub=~s/-LEMONDE.FR//g;
$rub=~s/:TOUTEL'ACTUALITESURLEMONDE.FR.//g;
print "RUBRIQUE : $rub\n";
my $output1=$sortie.$rub.".xml";
my $output2=$sortie.$rub.".txt";
if (!open (OUTXML,">>:encoding(utf-8)", $output1)) { die "Can't open file $output1"};
if (!open (OUTTXT,">>:encoding(iso-8859-1)", $output2)) { die "Can't open file $output2"};
while ($texte =~ /<item><title>(.+?)<\/title>.+?<description>(.+?)<\/description>/g) {
	my $titre=$1;
	my $desc=$2;
	my $rss = new XML::RSS;
$rss->parsefile($file);

foreach my $item(@{$rss->{'items'}}){
	my $titre = $item->{'title'};
	my $desc = $item->{'description'};

	if (uc($encodage) ne "UTF-8"){
	   utf8($titre);
	   utf8($desc);
	}
	
	$titre = HTML::Entities::decode($titre);
	$desc = HTML::Entities::decode($desc);
	$titre = &clean($titre);
	$desc = &clean($desc);

	if (!(exists $titles{$titre}) and (!(exists $descriptions{$desc}))){	 
		$titles{$titre}++;
		$descriptions{$desc}++;
		$texteXML.="<item>\n<title>$titre</title>\n<description>$desc</description>\n</item>\n";  
		print OUTTXT "$titre\n";
		print OUTTXT "$desc\n";
	}
}
$texteXML.="</items>\n</file>\n";

print OUTXML $texteXML;
print OUTTXT $texteBRUT;

close(OUTXML);
close(OUTTXT);
}
else {
print "$file ==> encodage non détecté\n";
}
}
}
}
}
sub clean {
my $texte=shift;
$texte=~s/<img[^>]+>//g;
$texte=~s/<a href[^>]+>//g;
$texte=~s/<\/a>//g;
$texte=~s/<[^>]+>//g;
$texte=~s/&/et/g;
$texte=~s/\x{201c}/“/g;
$texte=~s/\x{201d}/”/g;
$texte=~s/\x{2019}/’/g;
$texte=~s/\x{2018}/‘/g;
$texte=~s/\x{2013}/-/g;
$texte=~s/\x{2192}/→/g;
$texte=~s/\x{2026}/.../g;
$texte=~s/\x{0153}/œ/g; 
$texte=~s/\x{0152}/Œ/g;
$texte=~s/\x{fffd}/�/g;
$texte=~s/\x{20ac}/€/g;
$texte=~s/\x{2009}/ /g;
return $texte;
}

sub browser {
my $path = shift(@_);
opendir(DIR, $path) or die "can't open $path: $!\n";
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
$file = $path."/".$file;
if (-d $file) {
&brwoser($file);	
}
if (-f $file) {
if (($file=~/\.xml$/) && ($file!~/\/fil.+\.xml$/)) {
open(FILE,$file);
my $texte="";
while (my $ligne=<FILE>) {
$ligne =~ s/\n//g;
$ligne =~ s/\r//g;
$texte .= $ligne;
}
close(FILE);
$texte=~s/> *</></g;
$texte=~/encoding ?= ?[\'\"]([^\'\"]+)[\'\"]/i;
my $encodage = $1;
if ($encodage ne "") {
open(FILE,"<:encoding($encodage)", $file);
$texte="";
while (my $ligne=<FILE>) {
$ligne =~ s/\n//g;
$ligne =~ s/\r//g;
$texte .= $ligne;
}
close(FILE);
$texte =~ s/> *</></g;
if ($texte=~ /[<channel>|<atom.+>]<title>([^<]+)<\/title>/) {
my $rub=$1;
$rub=~s/Le ?Monde.fr ?://g;
$rub=~s/ ?: ?Toute l'actualité sur Le Monde.fr.//g;
$rub=~s/\x{E8}/e/g; 
$rub=~s/\x{E0}/a/g;   
$rub=~s/\x{E9}/e/g;  
$rub=~s/\x{C9}/e/g;          
$rub=~s/ //g;      
$rub=uc($rub);  
$rub=~s/-LEMONDE.FR//g;  
$rub=~s/:TOUTEL'ACTUALITESURLEMONDE.FR.//g;
$sections{$rub}++;    
}
}
else {
print "$file ==> encodage non détecté \n";
}
}
}
}
}