#!/usr/bin/perl
<<DOC;
Filtreur
Sébastien Delahaye <seb@delahaye.net>

Usage : ./filter.pl répertoire fichier_de_sortie [TreeTagger | Cordial]
Il y a deux paramètres obligatoires : 
- le répertoire contenant les fichiers XML à analyser
- le fichier XML de sortie
- le troisième paramètre est optionnel et indique au programme s'il doit ou non
  faire analyser les fichiers par TreeTagger
DOC


use strict;

#
# Quelques variables de départ
#
my $author = 'Sébastien Delahaye';
my $parseMode = 'filter';
my $tmp = 'tmp.txt';
my $tmptt = 'treetemp.txt';
my $cordialtmp = 'cordial';

# On compte nos arguments :
# - s'il y en a 3, on se prépare à utiliser le TreeTagger
# - s'il n'y en a ni 2 ni 3, on affiche un bref mode d'emploi
#   et on quitte le programme
if ((my $count = @ARGV) == 3
    && ($ARGV[2] eq 'TT' || $ARGV[2] =~ /treetagger/i)) {
    $parseMode = 'treetagger';
} elsif ($count == 3 && $ARGV[2] =~ /cordial/i) {
    $parseMode = 'cordial';
} elsif ($count != 2) {
    dispUsage();
}

# une dernière petite vérif...
dispUsage() unless (-d $ARGV[0]);
my $dir = $ARGV[0];
my $out = $ARGV[1];
# On supprime un éventuel / final
$dir =~ s/\/$//;


#
# Les quelques lignes initiant le programme
#

beginXML();
goThroughDir($dir);
if ($parseMode eq 'cordial') {
    cordialUsage(0);
    my $dir = cordialWait();
    $parseMode = 'cordialXml';
    goThroughDir($dir);
}
endXML();



#
# Traitements XML
#

#
# beginXML()
# Génère l'entête du fichier XML
#
sub beginXML {
    open (OUT, ">:utf8", $out) or die dispFileErr($out);
    print OUT "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
    print OUT "<parcours>\n";
    print OUT "\t<nom>$author</nom>\n";
    print OUT "\t<filtrage>\n";
}

#
# endXML()
# Génère le footer du fichier XML
#
sub endXML {
    print OUT "\t</filtrage>\n";
    print OUT "</parcours>\n";
    close OUT;
}

#
# treatEntities(string)
# Nettoie une chaîne XML des entités restantes
#
sub treatEntities {
    my $str = shift;
    $str =~ s/&#38;//g;
    $str =~ s/&?#39;/'/g;
    $str =~ s/&?#34;/"/g;
    $str =~ s/&#233;/é/g;
    $str =~ s/&#234;/ê/g;
    return $str;
}

#
# filter(string)
# Nettoie une chaîne XML et la place dans un autre fichier XML
#
sub filter {
    return "\t\t\t<content>".treatEntities($_[0])."</content>\n";
}

#
# treetagger(string)
# Nettoie et prépare une chaîne issue d'un fichier XML pour traitement
#   dans TreeTagger
# Le résultat est placé dans un fichier XML
#
sub treetagger {
    my $str = shift;
    my $output = '';

    $str = treatEntities($str);
    # on sépare pronoms à apostrophe du mot suivant de façon arbitraire
    $str =~ s/(d|s|t|l)'/$1e /ig;
    # on supprime toute la ponctuation afin d'avoir un mot par ligne
    $str =~ s/[ ?.,!;:'"]/\n/g;
    
    open (TEMP, ">:utf8", $tmp) or die dispFileErr($tmp);
    print TEMP $str;
    close TEMP;
    # pour éviter des problèmes de path entre commandline et cygwin, on présume que
    #    tree-tagger.exe et son dictionnaire sont dans le même répertoire que le script
    system ("./tree-tagger.exe -token -lemma -no-unknown french.par $tmp $tmptt");
    
    open (TT, "<:utf8", $tmptt) or die dispFileErr($tmptt);
    while (<TT>) {
        # TreeTagger créant parfois en fin de fichier une ligne au contenu rigolo,
        #    on vérifie qu'on n'est pas dans ce cas de figure.
        if (/\n$/) {
            s/(\r)?\n//g;
            # Là, on prend la ligne du fichier de TreeTagger et on extrait toutes
            #    les infos pour les replacer dans du XML
            # Au lieu d'utiliser une expression rationnelle, on se contente
            #    d'exploser la chaîne sur la tabulation.
            # C'est un peu plus lent, mais tellement plus lisible...
            # Bug (issu de TT ?) : la string contenant le lemme bugge en unicode
            #   et les fonctions de type decode() et utf8_encode() 
            #   se cassent les dents dessus.
            split /\t/;
            $output .= generateElement(@_);
        }
    }
    close TT;
    # Soyons propres, virons nos fichiers temporaires
    unlink $tmp, $tmptt;
    return $output;
}

#
# generateElement(array)
# Prend en entrée un tableau, renvoie un bloc XML contenant
#    les caractéristiques d'un terme
#
sub generateElement {
    return "\t\t\t<element>\n\t\t\t\t<data type=\"type\">".$_[1].
        "<\/data>\n\t\t\t\t<data type=\"lemma\">".$_[2].
        "<\/data>\n\t\t\t\t<data type=\"string\">".$_[0].
        "<\/data>\n\t\t\t<\/element>\n";
}

#
# cordial(string, filename)
# Ecrit une chaîne de caractères dans un fichier (nouvellement créé si besoin)
#    afin d'être ensuite analysé par Cordial.
#
sub cordial {
    my $str = shift;
    my $file = shift;
    
    if (! -d $cordialtmp) {
        mkdir($cordialtmp);
    }
    
    $file =~ s/\//--/g;
    open (CORDIAL, ">>:utf8", $cordialtmp.'/'.$file.'.txt');
    print CORDIAL treatEntities($str)."\n";
    close CORDIAL;
}

#
# cordialXml(string)
# Transforme l'analyse d'un terme par Cordial en bloc XML
#
sub cordialXml {
    split(/\s/, $_[0]);
    return generateElement(($_[4], $_[9], $_[5]));
}

#
# cordialWait()
# Attend de l'utilisateur le nom du dossier où se trouvent les fichiers .cnr
#    produits par l'analyse de Cordial.
#
sub cordialWait {
    while (<STDIN>) {
        chomp;
        if (-d $_) {
            return $_;
        } else {
            cordialUsage(1);
        }
    }
}

#
# cordialUsage(int)
# Affiche un peu d'aide et fait patienter pendant l'étiquetage par Cordial
#
sub cordialUsage {
    if ($_[0] == 0) {
        print STDOUT "Le programme a préparé les flux RSS pour étiquetage par Cordial.\n".
            "Vous devez désormais ouvrir Cordial et utiliser le menu Syntaxe pour étiquetter un ensemble de fichiers.\n".
            "Sélectionnez l'ensemble des fichiers préparés (ils se trouvent dans le dossier $cordialtmp) et lancez l'analyse.\n".
            "Une fois l'analyse effectuée, suivez les instructions ci-dessous : \n";
    } elsif ($_[0] == 1) {
        print STDOUT "Erreur ! \n";
    }
    print STDOUT "Veuillez indiquez le sous-répertoire où vous avez enregistré les fichiers étiquettés par Cordial : \n";
}



#
# Balade dans les répertoires
#

#
# goThroughDir(dir)
# Produit à partir d'un répertoire une liste de fichiers,
#   et s'enfonce si besoin dans l'arborescence
# Si le fichier courant n'est pas un dossier, on présume qu'il
#   s'agit d'un fichier XML et on le parse
# Le traitement suivant est effectué par les fonctions
#   filter() ou treetagger()
#
sub goThroughDir {
    my $path = shift;
    opendir(DIR, $path) or die dispDirErr($path);
    # on évite d'ouvrir . et ..
    my @files = grep { /^[^.]/ } readdir(DIR);
    closedir DIR;

    foreach my $file (@files) {
        $file = $path.'/'.$file;
        
        if (-d $file) {
            goThroughDir($file);
        } elsif (-f $file && $file =~ /(xml|cnr)$/) { # on n'ouvre que les .xml ou .cnr, pas les éventuels .txt
            # Si on a bien affaire à un fichier, on l'ouvre en UTF-8
            open (XML, "<:utf8", $file) or die dispFileErr($file);

            if ($parseMode eq 'cordialXml') { # on se débrouille pour conserver le nom du fichier original avec Cordial
                $file =~ s/$path\///;
                $file =~ s/--/\//g;
                $file =~ s/.txt//;
            }

            print OUT "\t\t<file>\n\t\t\t<name>$file</name>\n" unless $parseMode eq 'cordial';

            while (<XML>) {
                chomp;
                if (/<description>(.*)<\/description>/) {
                    if ($parseMode eq 'filter') {
                        print OUT filter($1);
                    } elsif ($parseMode eq 'treetagger') {
                        print OUT treetagger($1);
                    } elsif ($parseMode eq 'cordial') {
                        cordial($1, $file);   
                    } 
                } elsif (/^[1-9]/ && $parseMode eq 'cordialXml') { # on ne prend dans l'analyse de Cordial que les lignes utiles
                    print OUT cordialXml($1);
                }
            }
            print OUT "\t\t</file>\n" unless $parseMode eq 'cordial';
            
            close XML;
        }
    }
}



#
# Gestion des erreurs
#

#
# dispUsage()
# Affiche le bon usage du programme en ligne de commande
# Apparaît quand le mauvais nombre d'arguments est passé
#
sub dispUsage {
    print STDERR "Usage :\n".
        __FILE__." nom_du_répertoire_à_analyser fichier_de_sortie [TT | TreeTagger]";
    exit;
}

#
# dispDirErr(dir)
# Affiche une erreur en cas de problème à l'ouverture d'un dossier
#
sub dispDirErr {
    my $dir = shift;
    print STDERR "Interruption du programme : impossible d'ouvrir le dossier ".
        $dir." !\nErreur : $!";
}

#
# dispFileErr(file)
# Affiche une erreur en cas de problème à l'ouverture d'un fichier
#
sub dispFileErr {
    my $file = shift;
    print STDERR "Interruption du programme : impossible d'ouvrir le fichier ".
        $file." !\nErreur : $!";
}
