Boite à outils 2 : (avec Perl)
Présentation
La boîte à outils 2 écrite en perl, comme vu en cours. Pour lancer le script :
perl etiquetageTagger.pl repertoire-a-parcourir numero_rubrique(exemple'3232')
Le programme
BAO2.pl
Le Script
#/usr/bin/perl
<<DOC;
usage : perl etiquetageTagger.pl repertoire-a-parcourir numero_rubrique(exemple'3232')
Le programme construit en sortie 2 fichiers: un TXT (en iso) et un XML avec étiquettes
DOC
#-----------------------------------------------------------
my $rep="$ARGV[0]";
my $rubrique = "$ARGV[1]";
my %dico;
$rep=~ s/[\/]$//; # on s'assure que le nom du répertoire ne se termine pas par un "/"
my $output0="$rubrique.txt"; #fichier de sortie txt s'appelle avec le nom de la rubrique
if (!open (FILEOUT,">$output0")) { die "problème a l'ouverture du fichier $output0"};
close(FILEOUT);
my $output1="$rubrique.xml";#création du fichier xml
if (!open (FILEOUT,">$output1")) { die "problème a l'ouverture du fichier $output1"};
close (FILEOUT);
#----------------------------------------
&parcoursarborescencefichiers($rep);
&suppr_fichiers();
#----------------------------------------
open (FILEOUT,">>:encoding(utf-8)", $output1);
print FILEOUT "</PARCOURS>\n";
close(FILEOUT);
#----------------------------------------------
sub parcoursarborescencefichiers {
my $path = shift(@_);
opendir(DIR, $path) or die "impossible d'ouvrir $path: $!\n";
my @files = readdir(DIR);
closedir(DIR);
foreach my $file (@files) {
next if $file =~ /^\.\.?$/;
next if $file =~ /^\._/;
next if $file =~ /^fil/;
$file = $path."/".$file;
if (-d $file) {
print "<on commence pour> ==> ",$file,"\n";
&parcoursarborescencefichiers($file);
print "<on a fini avec> ==> ",$file,"\n";
}
if (-f $file) {
if ($file =~ /$rubrique.+\.xml$/) {
print "<",$i++,"> ==> ",$file,"\n";
$codage = "utf-8";
$codage2 = "ISO-8859-1";
open (FIC, "<:encoding($codage)", $file);
open (OUT, ">>:encoding($codage2)", "$rubrique.txt");
open (OUT2, ">>:encoding($codage)", "$rubrique.xml");
my $texte="";
while (my $ligne = <FIC>) {
chomp $ligne;
$ligne =~ s/\r//g;
$texte = $texte . $ligne;
}
close FIC;
$texte =~ s/>\s+</></g;
while ($texte =~/<item>.*?<title>([^<]+?)<\/title>.*?<description>([^<]+?)<\/description>/g) { # mettre un point à la place de item, le pb vient de là
my $titre = $1;
my $description = $2;
#### insérer sub nettoyage !!!!!!!!!!!!!!!!!
$titre.=".";
$titre=~s/\?\.$/\?/;
$description=~s/<.+?>//g;
$description=~s/\x{2019}/'/g;
$titre=~s/\x{2019}/'/g;
$d=~s/\x{2019}/'/g;
$titre=~s/\x{0153}/oe/g;
$titre=~s/\x{0152}/oe/g;
$description=~s/\x{0153}/oe/g;
$description=~s/\x{0152}/oe/g;
$description=~s/\x{200a}//g;
$titre=~s/\x{200a}//g;
$description=~s/\x{201c}//g;
$titre=~s/\x{201c}//g;
$description=~s/\x{201d}//g;
$titre=~s/\x{201d}//g;
$titre=~s/\x{2026}//g;
$titre=~s/\x{2013}//g;
$description=~s/\x{2026}//g;
$description=~s/\x{2013}//g;
if (!(exists $dico{$titre})) {
$dico{$titre} = 1;
print OUT "§ $titre\n"; #on écrit le titre et un retour à la ligne
print OUT "$description\n\n"; #on écrit le titre et deux retours à la ligne
my ($titretag,$descriptiontag) = &etiquetageTagger($titre,$description);
print OUT2 "<item>.*?<title>$titretag</title>.*?<description>$descriptiontag</description>.*?</item>\n";
}
}
close OUT;
close OUT2;
}
}
}
}
#----------------------------------------------
sub etiquetageTagger {
my ($t,$d)= @_;
open(TMP,">:encoding(utf8)","titre.txt"); #création d'un fichier temporaire pour stocker les titres
print TMP $t;
close TMP;
system("perl tokenise-utf8.pl titre.txt | tree-tagger.exe -token -lemma -no-unknown french-utf-8.par > titre_tag.txt");
system("perl treetagger2xml-utf8.pl titre_tag.txt utf8"); #résultat est contenu dans titre_tag.txt.xml
open(TMP2, "<:encoding(utf8)","titre_tag.txt.xml");#création d'un fichier temporaire pour stocker les titres taggués
my $t_tag="";
my $ligne = <TMP2>;
while (my $ligne = <TMP2>) {
#chomp $ligne;
$t_tag = $t_tag . $ligne;
}
close TMP2;
open(TMP,">:encoding(utf8)","description.txt"); #création d'un fichier temporaire pour stocker les descriprions
print TMP $d ;
close TMP;
system("perl tokenise-utf8.pl description.txt | tree-tagger.exe -token -lemma -no-unknown french-utf-8.par > description_tag.txt"); #on a tokenisé et treetaggé
system("perl treetagger2xml-utf8.pl description_tag.txt utf8"); #résultat est contenu dans titre_tag.txt.xml #on a reformatté le résultat de la ligne du dessus en xml et on l'a mis dans un fichier
open(TMP2, "<:encoding(utf8)","description_tag.txt.xml");#création d'un fichier temporaire pour stocker les descriptions tagguées
my $d_tag="";
my $ligne = <TMP2>;
while (my $ligne = <TMP2>) {
$d_tag = $d_tag . $ligne;
}
close TMP2;
return($t_tag,$d_tag);
}
#----------------------------------------------
sub suppr_fichiers{ #supprime tous les fichiers temporaires
my $titre = 'titre.txt';
unlink $titre;
my $titre__tag = 'titre_tag.txt';
unlink $titre__tag;
my $titre__tag_xml = 'titre_tag.txt.xml';
unlink $titre__tag_xml;
my $description = 'description.txt';
unlink $description;
my $description_tag = 'description_tag.txt';
unlink $description_tag;
my $description_tag_xml = "description_tag.txt.xml";
unlink $description_tag_xml;
}
#----------------------------------------------
sub nettoyage {
my ($titre,$description)=@_;
$d=~s/<.+?>//g;#on veut supprimer les succession de balises transcodées $lt; >
$d=~s/&#39;/'/g;#on veut également remplacer les apostrophes transcodées &#39;
$d=~s/&#34;/"/g;#remplacement des guillemets doubles &#34;
$t=~s/<.+?>//g;
$t=~s/&#39;/'/g;
$t=~s/&#34;/"/g;
$titre=~s/<.+?>//g;
$titre.=".";
$titre=~s/\?\.$/\?/;
$description=~s/<.+?>//g;
$description=~s/\x{2019}/'/g;
$titre=~s/\x{2019}/'/g;
$d=~s/\x{2019}/'/g;
$titre=~s/\x{0153}/oe/g;
$description=~s/\x{0153}/oe/g;
$description=~s/\x{2026}/.../g;
$description=~s/\x{200a}//g;
$titre=~s/\x{200a}//g;
$titre=~s/<.+?>//g;
$titre.=".";
$titre=~s/\?\.$/\?/;
$description=~s/<.+?>//g;
$description=~s/\x{2019}/'/g;
$titre=~s/\x{2019}/'/g;
$titre=~s/\x{0153}/oe/g;
$description=~s/\x{0153}/oe/g;
$description=~s/\x{2026}/.../g;
return $titre,$description;
}