#/usr/bin/perl
#-----------------------------------------------------------
use utf8;
<<DOC; 

 usage : perl parcours-arborescence-fichiers repertoire-a-parcourir rubrique
 Le programme prend en entrée le nom du répertoire contenant les fichiers
 à traiter et le nom de la rubrique à traiter (via une suite de chiffres)
 Le programme construit en sortie 2 fichiers :
 - un fichier TXT
 - un fichier structuré en XML 
 Les 2 fichiers contiennent les zones textuelles extraites des fils RSS
DOC
#-----------------------------------------------------------
use XML::RSS;
#-----------------------------------------------------------
my $rep="$ARGV[0]";
my $rubrique="$ARGV[1]";
# on s'assure que le nom du répertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
my $i=0;
my %doublons;
open(OUT, ">:encoding(utf-8)", "sortie-$rubrique-xmlrss.txt");
open(OUTXML, ">:encoding(utf-8)", "sortie-$rubrique-xmlrss.xml");
print OUTXML "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print OUTXML "<racine>\n";

#----------------------------------------
&parcoursarborescencefichiers($rep);	#procédure récursive
close OUT;
print OUTXML "</racine>\n";
close OUTXML;
exit;
#----------------------------------------------
sub parcoursarborescencefichiers {
    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) {
		    print "on entre dans $file \n";
			&parcoursarborescencefichiers($file);	#procédure récursive
		}
		if (-f $file) {
		    if ($file=~/$rubrique.+\.xml$/) {			
				print $i++," : $file \n";
				my $rss=new XML::RSS;
				eval {$rss->parsefile($file); };
				if( $@ ) {
					$@ =~ s/at \/.*?$//s;               #  module line number
					print STDERR "\nERROR in '$file':\n$@\n";
				} 
				else {
					foreach my $item (@{$rss->{'items'}}) {
						my $description=$item->{'description'};
						my $titre=$item->{'title'};
						my ($titrenettoye,$descriptionnettoye) = &nettoyage($titre,$description);
						if (exists $doublons{$titrenettoye}) {
							$doublons{$titrenettoye}++;
						}
						else {
							$doublons{$titrenettoye}=1;
							print OUT "$titrenettoye\n";
							print OUT "$descriptionnettoye\n";
							print OUTXML "<article>\n";
							print OUTXML "<titre>$titrenettoye</titre>\n";
							print OUTXML "<description>$descriptionnettoye</description>\n";
							print OUTXML "</article>\n";
						}
					}
				}
						
			}
		}
    }
}

sub nettoyage {

	my ($element1, $element2) = @_; # on accède aux éléments de la variable @_ qui contient les données textuelles des titres et des descriptions
	
	# traitement

	$element1 .= "." ; # on rajoute un point à la fin de chaque phrase, deuxième élément n'en a pas besoin

	$element1, $element2 =~ s/&#38;#39;/'/g; # on change les &#38;#39; en apostrophes
	$element1, $element2 =~ s/&#39;/'/g; # on change les &#39; en apostrophes
	$element1, $element2 =~ s/&#38;#34;/"/g; # on change les /&#38;#34; en guillements
	$element1, $element2 =~ s/&#34;/"/g; # on change les /&#34; en guillements
	$element1, $element2 =~ s/&#233;/é/g; # on change les &#3233; en é (bien transcodé grace à l'usage de utf8 au début du script)
	$element1, $element2 =~ s/&#234;/ê/g; # on change les &#234 en ê (bien transcodé grace à l'usage de utf8 au début du script)
	$element1, $element2 =~ s/<br clear=.+?border='0'\/>//g;


	return $element1, $element2; # on renvoit deux éléments passés par le nettoyage
}
#-----------------------