<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#/usr/bin/perl
#-----------------------------------------------------------
&lt;&lt;DOC; 
 Lara DUNUAN et Siyu WANG
 Project EncadrÃ©: Mai 2019
 usage : perl parcours-arborescence-fichiers repertoire-a-parcourir rubrique
 Le programme prend en entrÃ©e le nom du rÃ©pertoire contenant les fichiers
 Ã&nbsp; traiter et le nom de la rubrique Ã&nbsp; 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 utf8;
use open ':utf8';
binmode(STDIN,":utf8");
binmode(STDOUT,":utf8");

#on rÃ©cupÃ¨re le nom du rÃ©pertoire, fourni en argument au programme
my $rep="$ARGV[0]";
#on rÃ©cupÃ¨re le nom du  identifiant rubrique, fourni en argument au programme
my $rubrique="$ARGV[1]";
# on s'assure que le nom du rÃ©pertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
#compteur de $file
my $i=0;
#hashage pour traiter les doublons
my %doublons;
#on crÃ©e les fichiers outputs
open(OUT, "&gt;:encoding(utf-8)", "sortie-$rubrique-regexp.txt");
open(OUTXML, "&gt;:encoding(utf-8)", "sortie-$rubrique-regexp.xml");
print OUTXML "&lt;?xml version=\"1.0\" encoding=\"UTF-8\"?&gt;\n";
print OUTXML "&lt;racine&gt;\n";

#----------------------------------------
#on recurse
&amp;parcoursarborescencefichiers($rep);
#on ferme tout les fichiers outputs	
close OUT;
print OUTXML "&lt;/racine&gt;\n";
close OUTXML;
exit;


#----------------------------------------------
sub parcoursarborescencefichiers {
    #on rÃ©cupÃ¨re le nom du rÃ©pertoire fourni en arg de la fonction
    my $path = shift(@_);
    #on ouvre le rÃ©pertoire fourni en arg
    opendir(DIR, $path) or die "can't open $path: $!\n";
    #on lit le rÃ©pertoire grÃ¢ce Ã&nbsp; readdir
    my @files = readdir(DIR);
    closedir(DIR);
    foreach my $file (@files) {
		next if $file =~ /^\.\.?$/;
		$file = $path."/".$file;
		#on teste s'il s'agit d'un rÃ©pertoire
		if (-d $file) {
		    print "on entre dans $file \n";
			&amp;parcoursarborescencefichiers($file);	#recurse!
		}
		#on teste s'il s'agit d'un fichier
		if (-f $file) {
		    if ($file=~/$rubrique.+\.xml$/) {			
				print $i++," : $file \n";
				open(FIC, "&lt;:encoding(utf-8)", $file);
				my $tout_le_texte="";
				while (my $ligne = &lt;FIC&gt;) {
					chomp $ligne;
					$tout_le_texte = $tout_le_texte . $ligne . " ";
				}
				close FIC;
				#on parcourt tout l'ensemble pour trouver les balises title et description et on mÃ©morise leur contenu
				while ($tout_le_texte =~ /&lt;item&gt;.*?&lt;title&gt;([^&lt;]*)&lt;\/title&gt;.*?&lt;description&gt;([^&lt;]*)&lt;\/description&gt;.*?&lt;\/item&gt;/g) {
					my $titre = $1;
					my $description = $2;
					my $date = $file;
					$date =~ s/,1-0,0.xml/ /g;
					my ($titrenettoye,$descriptionnettoye) = &amp;nettoyage($titre,$description);
					#pour traiter les doublons
					if (exists $doublons{$titrenettoye}) {
						$doublons{$titrenettoye}++;
					}
					else {
						$doublons{$titrenettoye}=1;
						print OUT "DATE: $date\n";
						print OUT "## $titrenettoye\n";
						print OUT "## $descriptionnettoye\n";
						print OUTXML "&lt;article&gt;\n";
						print OUTXML "&lt;titre&gt;$titrenettoye&lt;/titre&gt;\n";
						print OUTXML "&lt;description&gt;$descriptionnettoye&lt;/description&gt;\n";
						print OUTXML "&lt;/article&gt;\n";
					}
				}
			}
		}
    }
}

#----------------------------------------------

sub nettoyage {

	my ($tit, $des) = @_;
	#my $t = shift @_; pour recupÃ©rer le premier element de la liste et le supprimer de la liste d'origine
	#my $d = shift @_; pour recupÃ©rer le 2eme
	$tit = $tit . "."; #$tit .= ".";
	$des = $des;
    
    $tit=~s/&amp;lt;.+?&amp;gt;//g;
	$tit=~s/&amp;#38;#39;/'/g;
	$tit=~s/&amp;#38;#34;/"/g;
	$tit=~s/&amp;amp;/&amp;/g;
	$tit=~s/Â&nbsp;/ /g;
	$tit=~s/â€Š//g;

    $des=~s/&amp;lt;.+?&amp;gt;//g;#on veut supprimer les succession de balises transcodÃ©es $lt; &amp;gt;	
	$des=~s/&amp;#38;#39;/'/g;#on veut Ã©galement remplacer les apostrophes transcodÃ©es &amp;#38;#39;	
	$des=~s/&amp;#38;#34;/"/g;#remplacement des guillemets doubles &amp;#38;#34;
	$des=~s/&amp;amp;/&amp;/g;
	$des=~s/Â&nbsp;/ /g; #on remplace les espaces insÃ©cables par des espaces 'normaux'
	$des=~s/â€Š//g;
    
	return $tit, $des;
}
#----------------------------------------------
</pre></body></html>