1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102

#/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;
  }