#/usr/bin/perl

<<DOC; 
 usage : perl parcours-arborescence-fichiers repertoire-a-parcourir
 Le programme prend en entrée le nom du répertoire contenant les fichiers à traiter
DOC

#-----------------------------------------------------------#
#------------------0. étapes préliminaires------------------#
#-----------------------------------------------------------#

my $rep="$ARGV[0]"; # nom du répertoire à parcourir
my $rubrique="$ARGV[1]"; # numéro de la rubrique recherchée
$rep=~ s/[\/]$//;
my %dico; # dictionnaire permettant d'éviter les doublons
my $codage = "utf-8";
my $compteurfile=1;
my $compteurItem=0;

#------------------------------------------------------------#
#------------------1. création des fichiers------------------#
#------------------------------------------------------------#

my $output1=$rubrique.".xml"; # création d'un fichier xml qui nous servira à l'étiquetage dans la BàO2
my $output2=$rubrique.".txt"; # création d'un fichier txt qui nous servira à l'étiquetage dans Cordial

if (!open (FILEOUT,">:encoding($codage)",$output1)) { die "Pb a l'ouverture du fichier $output1"};
if (!open (FILEOUT2,">:encoding($codage)",$output2)) { die "Pb a l'ouverture du fichier $output2"};

print FILEOUT "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>\n";
print FILEOUT "<PARCOURS>\n";
print FILEOUT "<NOM>Victorien Villiers, 2017-2018</NOM>\n";
print FILEOUT "<FILTRAGE>\n";


#--------------------------------------------------------------------------------------------------#
#------------------2. appel du programme principal : parcoursarborescencefichiers------------------#
#--------------------------------------------------------------------------------------------------#

&parcoursarborescencefichiers($rep);	# parcours de l'ensemble de l'arborescence

#-----------------------------------------------------------#
#------------------3. clôture des fichiers------------------#
#-----------------------------------------------------------#

if (!open (FILEOUT,">>:encoding($codage)",$output1)) { die "Pb a l'ouverture du fichier $output1"};
print FILEOUT "\n</FILTRAGE>\n";
print FILEOUT "</PARCOURS>\n";
close(FILEOUT);
exit;

#----------------------------------------------------------------#
#------------------parcoursarborescencefichiers------------------#
#----------------------------------------------------------------#

sub parcoursarborescencefichiers {
    my $path = shift(@_);
    opendir(DIR, $path) or die "can't open $path: $!\n";
    my @files = readdir(DIR);
    closedir(DIR);
	
	# -- Parcours de l'arborescence -- #
	
    foreach my $file (@files) {
		next if $file =~ /^\.\.?$/;
		$file = $path."/".$file;
		
		# -- Si l'élément est un dossier, on relance le programme récursivement -- #
		
		if (-d $file) {
			print "<NOUVEAU REPERTOIRE> ==> ",$file,"\n";
			&parcoursarborescencefichiers($file);	# appel récursif
			print "<FIN REPERTOIRE> ==> ",$file,"\n";
		}
		
		# -- Sinon, on ouvre le fichier pour récupérer les motifs -- #
		
		if (-f $file) {
			if ($file=~/$rubrique.+\.xml$/) {
				print "<",$compteurfile++,"> ==> ",$file,"\n";
				open (FIC, "<:encoding($codage)", $file);
				my $texte="";
				while (my $ligne = <FIC>) {
					chomp $ligne;
					$ligne =~ s/\r//g;
					$texte = $texte . $ligne;
				}
				
				close FIC;
				$texte =~ s/>\s+</></g;
				
				# -- Récupération des motifs -- #
				
				while ($texte =~m/<item>.*?<title>([^<]*?)<\/title>.*?<description>([^<]*?)<\/description>/g) {
					my $titre = $1;
					my $description = $2;
					($titre,$description) = &nettoyage ($titre,$description);
					
					if (!(exists $dico{$titre})) {
						$dico{$titre} = 1;
						print FILEOUT2 "§ $titre\n$description\n\n";

						$compteurItem++;
						print FILEOUT "<item number=\"$compteurItem\">\n<titre>$titre</titre>\n<description>$description</description>\n</item>\n"; 						
						
					}
				}
			}
		}
    }
}

#---------------------------------------------#
#------------------nettoyage------------------#
#---------------------------------------------#

sub nettoyage {
    my $var1 = shift(@_);
    my $var2 = shift(@_);
    $var1=~s/&lt;.+?&gt;//g;
    $var2=~s/&lt;.+?&gt;//g;
	$var1.=".";
	$var1=~s/\?\.$/\?/;
    return $var1,$var2 ;
}