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

#/usr/bin/perl

my $rep="$ARGV[0]"; # 1er argument repertoire
my $rubrique="$ARGV[1]"; # 2eme argument rubrique
open(OUT,">:encoding(UTF8)","sortie_slurp_$rubrique.txt");
open(OUTXML,">:encoding(UTF8)","sortie_slurp_$rubrique.xml");
print OUTXML "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n";
print OUTXML "<sortieCorpus>\n";
my %dico;
# on s'assure que le nom du r�pertoire ne se termine pas par un "/"
$rep=~ s/[\/]$//;
# # on initialise une variable contenant le flux de sortie 
# my $DUMPFULL1="";
# #----------------------------------------
# my $output1="SORTIE.xml";
# if (!open (FILEOUT,">$output1")) { die "Pb a l'ouverture du fichier $output1"};
# #----------------------------------------
&parcoursarborescencefichiers($rep);	#recurse!
#----------------------------------------
close OUT;
print OUTXML "</sortieCorpus>\n";
close OUTXML;
exit;
#----------------------------------------------
sub parcoursarborescencefichiers {
    my $path = shift(@_);
    opendir(DIR, $path) or die "can't open $path: $!\n";
    my @files = readdir(DIR);
    closedir(DIR);
    foreach my $file (@files) {
      # supprimer les repertoires caches . et ..
	    next if $file =~ /^\.\.?$/;
	    $file = $path."/".$file;
	    if (-d $file) { # -d permet de verifier si c'est un repertoire
      # si c'est un repertoire, je relance le programme
	    &parcoursarborescencefichiers($file);	#recurse!
	    }
	    if (-f $file) { # -f permet de verifier si c'est un fichier
#       TRAITEMENT � r�aliser sur chaque fichier
#       Ins�rer ici votre code (le filtreur)
	      if ($file=~/$rubrique.+xml$/) {
          open(FIC,"<:encoding(UTF8)",$file);
          $/=undef; #equivalent a $\=""
          my $textelu=<FIC>; # remplace la boucle while 
          close FIC;
          while ($textelu =~ /<item>.*?<title>(.+?)<\/title>.+?<description>(.+?)<\/description>/gs) {
            # memorisation des variables $1 pour la premiere parenthese, etc
            my $titre=$1;
            my $description=$2;
            ## nettoyage & qui signifie que ceci fair reference a un sous-programme
            # supprimer les bruits ht='1' src='http://rss.lemonde.fr/c/205/f/3050/s/4c93b4eb/sc/3/mf.gif'           border='0'/&gt ...
            # () est une liste en perl, cette liste reste ici et sert qu'a l'affectation
            # my $titre_nettoye=&nettoyage($titre);

            if (not exists $dico{$titre}){
            $dico{$titre}=$description;
            ($titre,$description)=&nettoyage($titre,$description);
            # sortie txt
            print OUT "TITRE : ", $titre, "\n";
            print OUT "DESCRIPTION :", $description, "\n";
            # print "DESCRIPTION :", $description, "\n";
            print OUT "------------\n";
            # grammire d'un document xml
            # sortie -> item+
            # item -> titre, description
            # titre -> texte
            # description -> texte
            print OUTXML "<item>\n";
            print OUTXML "<titre>$titre</titre>\n";
            print OUTXML "<description>$description</desciption>\n";
            print OUTXML "</item>\n";
            }
          }
        }
      }
    }
}
#----------------------------------------------
##################### sous-programmes (sub)
sub nettoyage {
  # @_ liste recu, pour acceder a des liste, on utilise $
  # on veut que les variables soit utilisees ici, my est obligatoire
  # shift/shift(@_) : on prend le premier element d'une liste et on le renvoie
  # my $titre=shift(@_);
  # my $description=shift(@_);
  my $titre=$_[0];
  my $description=$_[1];
  # foreach my $element(@_){

  # }
  $description =~ s/&lt;.+?&gt;//g;
  $titre =~ s/&lt;.+?&gt;//g;
  $description =~ s/&#38;&#34;/"/g;
  $titre =~ s/&#38;&#34;/"/g;
  $description =~ s/&#38;&#39;/'/g;
  $titre =~ s/&#38;&#39;/'/g;
  # $ sert a reconnaitre la fin de chaine
  $titre =~ s/$/\./g;
  return $titre,$description;
}