#/usr/bin/perl
<<DOC;
CARON Juliette REY Camille
2020
 usage : perl bao1_regx.pl repertoire-a-parcourir rubrique
 Le programme prend en entrée le nom du répertoire-racine contenant les fichiers
 à traiter et le nom de la rubrique à traiter parmi ces fichiers
DOC
#--------------------------------------------------------------------------------------------

#Récupération des arguments de notre programme:
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/[\/]$//;

#Initialisation d'un compteur et d'une table (dico) pour les doublons
my $i=0;
my %doublons=();

#fichier de sortie
open(FICOUT, ">:encoding(utf8)", "./SORTIE/sortie_bao1_$rubrique.txt") or die("Ouverture a échoué");
open(FICOUTXML, ">:encoding(utf8)", "./SORTIE/sortie_bao1_$rubrique.xml") or die("Ouverture a échoué");

#Ecriture du début du fichier xml
print FICOUTXML "<?xml version=\"1.0\" encoding=\"utf8\" ?>\n";
print FICOUTXML "<articles rubrique=\"$rubrique\">\n";
#----------------------------------------

#parcours de l'arborescence via une fonction récursive
&parcoursarbo($rep);

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

#Fermeture des fichiers
print FICOUTXML "</articles>";
close(FICOUT);
close(FICOUTXML);
exit;

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

sub parcoursarbo {
    my $path = shift(@_); #chemin du premier element
    opendir(DIR, $path) or die "can't open $path: $!\n";#ouverture repertoire (ou probleme)
    my @files = readdir(DIR); #extraction du contenu du repertoire
    closedir(DIR); #fermeture repertoire
    foreach my $file (@files) {   #boucle sur tous les éléments du contenu du repertoire
      next if $file =~ /^\.\.?$/; #passer a l'élément suivant s'il s'agit d'un repertoire caché/./..
      $file = $path."/".$file; #chemin relatif de l'élément traité
      if (-d $file) { # si l'élément est un répertoire
        &parcoursarbo($file);	#récursion!
      }
      if (-f $file) { # si l'élément est un fichier
        if ($file=~/$rubrique.+\.xml$/) { #si le fichier correspond a un fichier xml contenant la rubrique qu'on chercher
          print $i++," Traitement de : ",$file,"\n";
          open(FICIN, "<:encoding(utf8)", $file) or die("Echec à l'ouverture de $file"); #ouvrir le fichier (ou erreur)
          $/=undef;
          my $texte_lu=<FICIN>;
      		close FICIN;
          while ($texte_lu =~ /<item>.*?<title>(.+?)<\/title>.+?<description>(.+?)<\/description>/sg) {
              my $titre = $1;
              my $description = $2;
              ($titre, $description) = &nettoyage($titre, $description); #nettoyer tout ça
              if ( !(exists($doublons{$titre}))) { #ne pas réécrire de doublon
                  $doublons{$titre} = 1;  #update de la liste des doublons

                  #ecriture dans fichier txt
                  print FICOUT "$titre\n";
                  print FICOUT "$description\n\n";
                  #ecriture dans fichier xml
                  print FICOUTXML "\t<item>\n";
                  print FICOUTXML "\t\t<titre>$titre</titre>\n";
                  print FICOUTXML "\t\t<description>$description</description>\n";
                  print FICOUTXML "\t</item>\n";
              }
          }
        }
      }
    }
  }

  #----------------------------------------------
  sub nettoyage { #remplacer les codes des guillemets, apostrophes etc par ce qui leur correspond
      my $titre = $_[0];
      my $description = $_[1];
  	  $titre=~s/^<!\[CDATA\[//;
  	  $titre=~s/\]\]>$//;
  	  $description=~s/^<!\[CDATA\[//;
  	  $description=~s/\]\]>$//;
      $description=~s/&lt;.+?&gt;//g;
      $description=~s/&#38;#39;/'/g;
      $description=~s/&#38;#34;/"/g;
      $titre =~ s/&(amp;)?/et/g;
    	$description =~ s/&(amp;)?/et/g;
      $titre=~s/&lt;.+?&gt;//g;
      $titre=~s/&#38;#39;/'/g;
      $titre=~s/&#38;#34;/"/g;
      $titre=~s/$/\./g;
      return $titre,$description;
  }
