BàO 1

BÀO 1 - Version regex

Étape I - Détection et extraction des données

Avant de plonger dans les répertoires et repérer nos données nous essayerons d'abord d'extraire les contenus textuels d'un seul fichier RSS, en le passant en argument depuis le terminal.

#!/usr/bin/perl

my $fichier = $ARGV[0];

open my $rss, "<:encoding(utf-8)", $fichier;      
open my $txt, ">:encoding(utf-8)", "sortie.txt";  
open my $xml, ">:encoding(utf-8)", "sortie.xml";

Cette opération est faite grâce à la variable de système $ARGV, une liste indicée qui prend comme premier élément de la liste [0] le premier argument inséré en ligne de commande après le programme principale (perl programme.pl premier_argument).
Dans le Perl « moderne » tout est scalaire. Voici donc l'ouverture des fichiers $rss (en lecture <), $txt et $xml (en écriture >). Pour pouvoir chercher le contenu des balises <titre> et <description> du $rss il faut d'abord charger le texte en mémoire.

my $tout_le_texte = "";
while (my $ligne = <$rss>){
  chomp $ligne;
  $ligne =~ s/\r//g;
  $tout_le_texte = $tout_le_texte . $ligne . " ";
  print $tout_le_texte;
  #my $reponse = <STDIN>;
}
close $rss;

Il se peut toutefois que notre motif soit étendu sur plusieurs lignes. Il est donc plus prudent d'éliminer les passages à la ligne \n et lire les fichiers $rss d'un coup.
Cela ce fait grâce à la fonction chomp qui pourtant ne supprime pas le Carriage Return \r Windows. Pour être complétement à l'abri nous allons donc le supprimer par nous même avec l'opérateur s/à substituer/substituant/g, la substitution globale.
C'est fait ! La chaîne vide $tout_le_texte a été rempli, nous sommes prêts à chercher le motif chargé de capturer la configuration XML illustrée sur la droite.

#configuration n°1
<item>
  <title>TEXTE À EXTRAIRE</title>
  <description>TEXTE À EXTRAIRE</description>
</item>

#configuration n°2
<item>
  <title>TEXTE À EXTRAIRE</title>
  <description/>
</item>

Le motif ressemble à ceci :

/<item>.*?<title>([^<]*)<\/title>.*?<description>([^<]*)<\/description>.*?<\/item>/

Petite remarque : cette expression régulière est très performante sur la configuration n°1 mais elle ne prend pas en considération les cas où la balise <description/> est vide (configuration n°2). Cependant la perte reste négligeable et la version XML::RSS de ce script nous permettra d'optimiser la sortie. Une fois le motif trouvé il ne reste que tester.

print $xml "<?xml version='1.0' encoding='UTF-8'?>\n";
print $xml "<file>\n";
my $count = 1;
while ($tout_le_texte =~ /<item>.*?<title>([^<]*)<\/title>.*?<description>([^<]*)<\/description>.*?<\/item>/g) {

  my $title = $1;
  my $description = $2;

  print $txt "TITRE : $title\n" ;
  print $txt "DESCRIPTION: $description\n";
  print $xml "\t<item n='$count'>\n" ;
  print $xml "\t\t<titre>$title</titre>\n" ;
  print $xml "\t\t<description>$description</description>\n";
  print $xml "\t</item>\n";
  print $count;
  $count++;
}
print $xml "</file>\n";
close $txt;
close $xml;

Comme la sortie texte n'est pas structurée, aucune modification est prévue au moment de l'impression. Par contre, le document XML en sortie doit être bien formé. Pour cette raison, avant le traitement il est nécessaire d'écrire un préambule XML et d'expliciter un élément racine.

Tant que le texte contient (=~) le motif, nous allons affecter le résultat du matching $1 et $2 à des variables. Les backreferences ne sont pas des vraies variables ils font référence respectivement au premier et au deuxième group () de l'expression régulière i.e. le contenu textuel cherché.
Le script téléchargeable ci-dessous contient un premier test avec un fichier du 2008 dont l'encodage est ISO-8859-1. Pour traiter ces anciens XMLs il faudrait éventuellement prévoir une phase de conversion en UTF-8 ou expliciter en ouverture l'encodage du fichier en entrée.

Étape II - Nettoyage des données

Ce premier test a produit deux sorties mais d'autres problèmes ont émergé :

certains fils RSS contiennent des « éléments polluants » comme les entités XML, parfois doubles à cause, probablement, des traitements automatique effectués sur les données avant leurs téléchargement.
la sortie XML doit être adéquatement structurée : une fois supprimé ces éléments et les doubles entités XML, il faudra les recoder proprement

L'avantage de programmer en Perl est de pouvoir très facilement modifier les chaînes de caractères. Remplacer, substituer, transcoder, détecter des motifs très complexes à l'aide des expressions régulières... c'est l'univers Perl. Nous allons donc exploiter son potentiel pour supprimer le bruit textuel.

          sub cleaning {

  my ($title, $description) = @_;

  # cleaning <title>
  $title =~ s/ +\./\./g;
  $title =~ s/<[^>]+>//g;
  $title =~ s/&amp;/&/g;
  $title =~ s/&lt;/</g;
  $title =~ s/&gt;/>/g;
  $title =~ s/&quot;/"/g;
  $title =~ s/&apos;/'/g;

  # cleaning <description>
  $description =~ s/\n//g;
  $description =~ s/&#39;/'/g;
  $description =~ s/&#34;/"/g;
  $description =~ s/&#38;#39;/'/g;
  $description =~ s/&#38;#34;/"/g;
  $description =~ s/&amp;/&/g;
  $description =~ s/&lt;/</g;
  $description =~ s/&gt;/>/g;
  $description =~ s/&quot;/"/g;
  $description =~ s/&apos;/'/g;
  $description =~ s/<[^>]+>//g;

  return $title, $description;
} # cleaning

          sub xml_entities {
  
  my ($title, $description) = @_;
  
  # re-encoding <title>
  $title =~ s/</&lt;/g;
  $title =~ s/>/&gt;/g;
  $title =~ s/&/&amp;/g;
  $title =~ s/"/&quot;/g;
  $title =~ s/'/&apos;/g;
  
  # re-encoding <description>
  $description =~ s/</&lt;/g;
  $description =~ s/>/&gt;/g;
  $description =~ s/&/&amp;/g;
  $description =~ s/"/&quot;/g;
  $description =~ s/'/&apos;/g;
  
  return $title, $description;
} #xml_entities

Avant la phase d'impression des données nous allons faire passer les variables à travers une subroutine (encadré de gauche, cleaning). En exploitant le fait d'être encore dans la boucle while, on pourra itérer l'opération de nettoyage sur chaque ligne du fichier en entrée.
Puisque les RSS sont tout à fait des fichiers XML, nous y trouvons des entités. Pour des raisons inconnues, certains fichiers présentent également des entités HTML (cliquer ici pour voir un exemple).
Pour produire une sortie TXT propre nous allons supprimer tous ces éléments en les remplaçant par leurs homologues.
Nos valeurs de retour sont maintenant prêtes pour être stockées et imprimée dans la sortie TXT. Quant à la sortie XML, elle doit être soumise à un autre traitement chargé de recoder adéquatement les caractères réservés comme les chevrons, les single quotes et les double quotes. Une deuxième fonction permet d'obtenir ce résultat (encadré de droite, xml_entities). Cette deuxième version du script améliore les deux sorties :

Étape III - Parcours de l'arborescence

Il ne nous reste que itérer le même traitement pour tous les fichiers des rubriques 3224 et 3236 dans l'arborescence de travail.

          my $folder="$ARGV[0]";
my $rubrique="$ARGV[1]";
# -----------------------------------------------------------------------------
# PREPARING ARGUMENTS
my $nom_rubrique = $rubrique;
my %rubrique_conv = ("france"=>"3224", "media"=>"3236");
my $rubrique = $rubrique_conv{"$rubrique"};
# on s'assure que le répertoire ne se termine pas par "/"
$folder=~ s/[\/]$//;
my %doublons;

Comme tous les langages de programmation, Perl permet de faire de la programmation système. Nous allons nous en servir pour parcourir l'arborescence de travail du dossier racine (2018) jusqu'aux fichiers concernés par notre recherche.
Pour cela il est nécessaire d'effectuer quelques changements au script précédent en passant le nom du dossier à parcourir et le code de la rubrique par paramètre. Au lieu de toujours rentrer l'ID de la rubrique, nous pouvons créer un tableau associatif et faire correspondre ce code à un nom plus parlant. La valeur rentrée sera stockée en $nom_rubrique qui sera également le nom des fichiers en sortie, quant à $rubrique, elle désignera l'ID de la rubrique et donc du fichier que nous allons chercher dans l'arborescence de travail. Enfin, %doublons contiendra tous les titres, il sera important pour se débarrasser de doublons et ne pas répéter de l'information dans le corpus final.

sub finding_files {
    # annee : /2018
    my $path = shift(@_);
    # on récupère la liste des fichiers de /2018
    opendir(DIR, $path) or die "can't open $path: $!\n";
    my @files = readdir(DIR);
    closedir(DIR);
    # on ordonne la liste de fichiers
    foreach my $file (sort { $a <=> $b } @files) {
    next if $file =~ /^\.\.?$/;
    $file = $path."/".$file;
    # /mois/jour/horaire...
    if (-d $file) {
        print "$file\t↵\n";
        &finding_files($file);
    }
    # ...les fichiers ont été trouvé !
    if (-f $file) {
        if ($file =~ /$rubrique.+\.xml$/) {
        ...

Pour parcourir l'arborescence nous allons utiliser la fonction finding_files qui fait appel à soi-même pour parcourir récurisivement les dossiers (-d) jusqu'au moment où un fichier (-f) est trouvé. Cette subroutine est un énorme contenant qui englobe le script vu dans l'étape II. Une fois détecté le dossier des fichiers RSS dont le nom correspond à l'ID passé en paramètre, ce même fichier sera traité et nettoyé.
La fonction opendir renvoie comme valeur de retour la liste des fichiers contenus dans un répertoire dont l'ordre n'est pas forcement alphabétique / numérique. Notre objectif est de pouvoir traiter les RSS en ordre chronologique donc nous faison recours à l'istruction (sort { $a <=> $b } @files) qui permet de trier une liste.

Ensuite, nous nous assurons d'ignorer à chaque fois les éventuels fichiers cachés (next if $file =~ /^\.\.?$/;) et de mettre à jour à chaque tour de boucle le parcours effectué ($file = $path."/".$file;) pour pouvoir descendre plus en profondeur dans l'arborescence.
Voici la troisième et dernière version du script (BAO1_regex.pl). Dans le dossier à télécharger vous trouverez également le corpus 2018 et des exemples de sorties pour les rubriques « France » et « Média » :

            #!/usr/bin/perl
  <<DOC;
  -------------------------------------------------------------------------------
  Nom : ANDREA F. MONACO
  
  BAO1_regex.pl -- nettoie et extrait le contenu textuel des balises <title> et 
  <description> des fichiers XML-RSS en entrée et produit deux sorties: 
  
    - un fichier texte brut
    - un fichier XML restructuré;
  
  Rubriques traitées ($nom_rubrique): france, media
  Mode d emploi: perl BAO1_regex.pl chemin_dossier nom_rubrique
  -------------------------------------------------------------------------------
  DOC;
  use strict;
  
  my $folder = "$ARGV[0]";
  my $rubrique = "$ARGV[1]";
  # -----------------------------------------------------------------------------
  # PREPARING ARGUMENTS
  my $nom_rubrique = $rubrique;
  my %rubrique_conv = ("france"=>"3224", "media"=>"3236");
  my $rubrique = $rubrique_conv{"$rubrique"};
  # on s'assure que le répertoire ne se termine pas par "/"
  $folder=~ s/[\/]$//;
  # -----------------------------------------------------------------------------
  my %doublons;
  my $i=1;
  # -----------------------------------------------------------------------------
  # OPENING FILES FOR WRITING
  open my $txt, ">:encoding(utf-8)", "./sorties/txt/bao1_regex_$folder-$nom_rubrique.txt";
  open my $xml, ">:encoding(utf-8)", "./sorties/xml/bao1_regex_$folder-$nom_rubrique.xml";
  # -----------------------------------------------------------------------------
  # PRINTING XML HEADERS
  print $xml "<?xml version='1.0' encoding='utf-8'?>\n";
  print $xml "<file>\n";
  print $xml "\t<name>Andrea F. Monaco</name>\n";
  # -----------------------------------------------------------------------------
  # RETRIEVING AND PROCESSING XML FILES
  &finding_files($folder);
  # -----------------------------------------------------------------------------
  # CLOSING FILES
  print $xml "</file>\n";
  close $xml;
  close $txt;
  exit;
  # -----------------------------------------------------------------------------
  # RETRIEVING AND PROCESSING XML FILES
  sub finding_files {
      # annee : /2018
      my $path = shift(@_);
      # on récupère la liste des fichiers de /2018
      opendir(DIR, $path) or die "can't open $path: $!\n";
      my @files = readdir(DIR);
      closedir(DIR);
      # on ordonne la liste de fichiers
      foreach my $file (sort { $a <=> $b } @files) {
      next if $file =~ /^\.\.?$/;
      $file = $path."/".$file;
      # /mois/jour/horaire...
      if (-d $file) {
          print "$file\t↵\n";
          &finding_files($file);
      }
      # ...les fichiers ont été trouvé !
      if (-f $file) {
          if ($file =~ /$rubrique.+\.xml$/) {
              print $xml "\t<fileid>$file</fileid>\n";  
              print $i++," : $file \n";
              # --------------------------------------------------------------
              # REGEX VERSION (BAO1)
              open my $rss_in, "<:encoding(utf-8)", $file;
              my $texte = "";
              while (my $line = <$rss_in>) {
              chomp $line;
              # suppression du Carriage Return \r
              $line =~ s/\r//g;
              $texte = $texte . $line ;
          }
          close $rss_in;
          my $count = 1;
          while ($texte =~ /<item>.*?<title>([^<]*)<\/title>.*?<description>([^<]*)<\/description>.*?<\/item>/g){
            my $title = "$1";
            my $description = "$2";
            if (!exists $doublons{$title}) {
                $doublons{$title}=1;
                my($title, $description) = &cleaning($title, $description);
                print $txt "#$title\n";
                print $txt "$description\n\n";
                my($title, $description) = &xml_entities($title, $description);
                print $xml "\t\t<item n='$count'>\n" ;
                print $xml "\t\t\t<title>$title</title>\n" ;
                print $xml "\t\t\t<description>$description</description>\n";
                print $xml "\t\t</item>\n";
                $count++; 
            }
          }   
        }
      }
    }
  } # finding_files
  # -----------------------------------------------------------------------------
  # CLEANING <TITLE> AND <DESCRIPTION> TEXT CONTENT
  sub cleaning {
  
    my ($title, $description) = @_;
  
    # cleaning <title>
    $title= "$title".".";
    $title =~ s/ +\./\./g;
    $title =~ s/<[^>]+>//g;
    $title =~ s/&amp;/&/g;
    $title =~ s/&lt;/</g;
    $title =~ s/&gt;/>/g;
    $title =~ s/&quot;/"/g;
    $title =~ s/&apos;/'/g;
  
    # cleaning <description>
    $description =~ s/\n//g;
    $description =~ s/&#39;/'/g;
    $description =~ s/&#34;/"/g;
    $description =~ s/&#38;#39;/'/g;
    $description =~ s/&#38;#34;/"/g;
    $description =~ s/&amp;/&/g;
    $description =~ s/&lt;/</g;
    $description =~ s/&gt;/>/g;
    $description =~ s/&quot;/"/g;
    $description =~ s/&apos;/'/g;
    $description =~ s/<[^>]+>//g;
  
    return $title, $description;
  
  } # cleaning
  
  # RE-ENCODING XML ENTITIES
  sub xml_entities {
  
    my ($title, $description) = @_;
  
    # re-encoding <title>
    $title =~ s/</&lt;/g;
    $title =~ s/>/&gt;/g;
    $title =~ s/&/&amp;/g;
    $title =~ s/"/&quot;/g;
    $title =~ s/'/&apos;/g;
  
    # re-encoding <description>
    $description =~ s/</&lt;/g;
    $description =~ s/>/&gt;/g;
    $description =~ s/&/&amp;/g;
    $description =~ s/"/&quot;/g;
    $description =~ s/'/&apos;/g;
  
    return $title, $description;
  
  } # xml_entities

BÀO 1 - Version XML::RSS

Le module XML::RSS

Cette deuxième version du programme vise à obtenir le même résultat du script précédent à l'aide du module XML::RSS. L'instruction my $rss = new XML::RSS; permet de créer une référence sur un objet XML::RSS sur lequel il est possible d'appliquer une série de méthodes. Dans notre cas, nous sommes intéressés à parser le fichier en entrée (méthode parsefile()). L'instance $rss ressemble maintenant à un jeu de données en format JSON contenant toutes les données du document RSS.

Avantages et inconvenients

Le grand avantage d'utiliser ce module est de ne pas avoir à s'inquiéter de l'extraction des données, le module il sait tout faire ! Par contre, l'inconvénient est que la structure des données est moins claire et donc l'accessibilité aux données peut être laborieuse. En outre, le fait de créer une instance aussi complexe à chaque tour de boucle ralenti énormément l'exécution du programme qui est de 6 jusqu'à 9 fois plus lent par rapport à la version regex. Dans les captures d'écran ci-dessous, une comparaison des temps d'exécution des deux programmes pour le traitement de la rubrique 'media' sur toute l'année 2018.

Version regex

Version XML::RSS

            #!/usr/bin/perl
    <<DOC;
    -------------------------------------------------------------------------------
    Nom : ANDREA F. MONACO
  
  BAO1_regex.pl -- nettoie et extrait le contenu textuel des balises <title> et 
  <description> des fichiers XML-RSS en entrée et produit deux sorties: 
  
    - un fichier texte brut
    - un fichier XML restructuré.
  
  Rubriques traitées : france (3224), media (3236)
  Mode d emploi : perl BAO1_regex.pl chemin_dossier nom_rubrique
  -------------------------------------------------------------------------------
  DOC
  use XML::RSS;
  use strict;
  
  my $folder="$ARGV[0]";
  my $rubrique="$ARGV[1]";
  # -----------------------------------------------------------------------------
  # PREPARING ARGUMENTS
  my $n_rubrique = $rubrique;
  my %rub_conv = ("france"=>"3224", "media"=>"3236", "international"=>"3210");
  my $rubrique = $rub_conv{"$rubrique"};
  # on s'assure que le répertoire ne se termine pas par "/"
  $folder=~ s/[\/]$//;
  # -----------------------------------------------------------------------------
  my %doublons;
  my $i=1;
  # -----------------------------------------------------------------------------
  # OPENING FILES FOR WRITING
  open my $txt, ">:encoding(UTF-8)", "./sorties/txt/bao1_RSS_sortie-$folder-$n_rubrique.txt";
  open my $xml, ">:encoding(UTF-8)", "./sorties/xml/bao1_RSS_sortie-$folder-$n_rubrique.xml";
  # -----------------------------------------------------------------------------
  # PRINTING XML HEADERS
  print $xml "<?xml version='1.0' encoding='UTF-8'?>\n";
  print $xml "<file>\n";
  print $xml "\t<name>Andrea F. Monaco</name>\n"
  # -----------------------------------------------------------------------------
  # RETRIEVING AND PROCESSING XML FILES
  &finding_files($folder);
  # -----------------------------------------------------------------------------
  # CLOSING FILES
  print $xml "</file>\n";
  close $xml;
  close $txt;
  exit;
  # -----------------------------------------------------------------------------
  # RETRIEVING AND PROCESSING XML FILES
  sub finding_files {
    # annee : /2018 ($folder)
      my $path = shift(@_);
      # on récupère la liste des fichiers de $folder
      opendir(DIR, $path) or die "can't open $path: $!\n";
      my @files = readdir(DIR);
      closedir(DIR);
      # on ordonne la liste de fichiers
      foreach my $file (sort { $a <=> $b } @files) {
      next if $file =~ /^\.\.?$/;
      $file = $path."/".$file;
      # /mois/jour/horaire...
      if (-d $file) {
          print "$file\t↵\n";
        &finding_files($file);  #recurse!
      }
      # ...les fichiers ont été trouvé !
      if (-f $file) {
          if ($file =~ /$rubrique.+\.xml$/) {
            print $xml "\t<fileid>$file</fileid>\n";  
          print $i++," : $file \n";
          # --------------------------------------------------------------
          # XML::RSS VERSION (BAO1)
          my $rss=new XML::RSS;
          eval {$rss->parsefile($file); };
          if( $@ ) {
            $@ =~ s/at \/.*?$//s;
            print STDERR "\nERROR in '$file':\n$@\n";
          } 
          else {
            my $count = 1;
            # le fichier a été parsé, on récupère les données
            my $date = $rss->{'channel'}->{'pubDate'};
            print $xml "\t<pubDate>$date</pubDate>\n";
              foreach my $item (@{$rss->{'items'}}) {
                # pour chaque item on extrait les infos de <title> et <description>
              my $description = $item->{'description'};
              my $title = $item->{'title'};
              my($title, $description) = &cleaning($title, $description);
              if (exists $doublons{$title}) {
                $doublons{$title}++;
              }
              else {
                $doublons{$title}=1;
                print $txt "\#$title\n";
                print $txt "$description\n\n";
                my($title, $description) = &xml_entities($title, $description);
                print $xml "\t<item n='$count'>\n" ;
                print $xml "\t\t<title>$title</title>\n" ;
                print $xml "\t\t<description>$description</description>\n";
                print $xml "\t</item>\n";
                $count++;
              }
            }
          }   
        }
      }
      }
  } # finding_files
  # -----------------------------------------------------------------------------
  # CLEANING <TITLE> AND <DESCRIPTION TEXT CONTENT
  sub cleaning {
  
    my ($title, $description) = @_;
  
    # cleaning <title>
    $title .= "." ;
    $title =~ s/ +\././g;
  
    # cleaning <description>
    $description =~ s/\n//g;
  
    return $title, $description;
  
  } # cleaning
  
  sub xml_entities {
  
    my ($title, $description) = @_;
  
    $description =~ s/</&lt;/g;
    $description =~ s/>/&gt;/g;
    $description =~ s/&/&amp;/g;
    $description =~ s/"/&quot;/g;
    $description =~ s/'/&apos;/g;
    $title =~ s/</&lt;/g;
    $title =~ s/>/&gt;/g;
    $title =~ s/&/&amp;/g;
    $title =~ s/"/&quot;/g;
    $title =~ s/'/&apos;/g;
  
    return $title, $description;
  
  } # xml_entities

BàO[ Boîte à outils 1 ]

BÀO 1