#!/usr/bin/perl
# usage : perl bao3_rb.pl fichier_tag fichier_motif
# on appelle les bibliothèques
use XML::XPath;
use File::Copy;
use File::Path;
# On vérifie le nombre d'arguments de l'appel au script ($0 : le nom du script)
if($#ARGV!=1){print "### ATTENTION ### usage : perl $0 fichier_tag fichier_motif ###\n";exit;}
# Enregistrement des arguments dans les variables idoines
my $tag_file= shift @ARGV;
my $patterns_file = shift @ARGV;
# Quelques initialisations fortes utiles
my @patterns;
my $nb_patterns=0;
my $nb_tokens=0;
#
#On crée un dossier pour les résultats
mkpath("./patternResults/");
open(PATTERNSFILE, $patterns_file) or die "can't open $patterns_file: $!\n";


# lecture du fichier .txt contenant les motifs, un motif par ligne (par exemple : NOM ADJ)
while ($ligne = ) {
    # on supprime avec la fonction chomp un éventuel retour à la ligne
    chomp($ligne);
    # 
    $nb_patterns = push(@patterns,$ligne);
}
# création de l'objet XML::XPath pour explorer le fichier de sortie tree-tagger XML
my $xp = XML::XPath->new( filename => $tag_file ) or die "Problème";
#
# recherche des motifs dans le fichier de sortie treetagger xml
foreach my $pattern (@patterns){
    # construction au moyen de la fonction split d'un tableau dont chaque élément a pour valeur  un token du motif recherché
    @tokens=split(/ /,$pattern);
    # définition du nom du fichier de sortie pour le motif en utilisant la fonction join
    my $match_file = "res_extract-".join('_', @tokens).".txt";
    open(MATCHFILE, ">$match_file") or die "can't open $match_file: $!\n";
    # appel de la procédure d'extraction des formes correspondants au motif
    &extract_pattern(@tokens);
    close(MATCHFILE);
    move($match_file,"./patternResults/");

}
# routine d'extraction d'un motif
sub extract_pattern{
    @tokenz=@_;
    # la fonction shift coupe le premier élement d'un tableau et le revoie en résultat
    $first_token=shift @tokenz;
    chomp($first_token);
    # Initialisation du chemin xpath correspondant au motif recherché
    # ATTENTION ici aux effets de bord dus à la structure choisie pour le fichier tree-tagger XML
    # par exemple pour le motif NOM ADJ : une description d'un fil rss qui se termine par un NOM suivie d'une autre description qui commence par un ADJ !
    $search_path="//element/data[1][contains(text(),\"$first_token\")]";
    foreach my $token (@tokenz){# construction  recursive du chemin xpath correspondant au motif recherché
        chomp($token);
        $search_path.="/ancestor::element/following-sibling::element[1]/data[1][contains(text(),\"$token\")]";
    }
    # boucle sur les nœud s reconnus du chemin xpath
    # c'est ici qu'on rentre dans le clou du programme
    #sur l'objet mynoeud on appelle la fonction FIND= elle cherche le chemin $search_path et collecte tous les blocs fils
    #getnodelist retourne une liste de noeuds 
    foreach my $noeud ( $xp->find($search_path)->get_nodelist ) {
        # initialisation du tableau des formes
        # on le fait ici pour des raisons évidentes d'économie de mémoire et donc de performance
        my @matching_tokens;
        # on remonte d'un cran au nœud  parent pour extraire la forme trouvée
        # dans le cas d'un motif NOM ADJ, c'est la forme de l'adjectif qu'on atteint
        # getParentNode donne le noeud parent
        $noeud_tmp=$noeud->getParentNode;
        $i=0;
        foreach (@tokens){
            $i++;
            # on récupère la forme
            # noter que le "3" de getChildNode(3) correspond au "data[3]" de la feuille XSLT
            $motif=$noeud_tmp->getChildNode(3)->string_value;
            # unshift(@matching_tokens,$motif) ajoute au début du tableau @matching_tokens un élément dont la valeur est le contenu de la variable $motif
            $nb_tokens=unshift(@matching_tokens,$motif);
            $motif="";
            # on remonte recursivement aux nœuds précedents pour extraire la forme
            # dans le cas d'un motif NOM PRP NOM, on récupère ainsi PRP puis NOM (le premier)
            # noter que "precding-sibling" est l'axe inverse de "following-sibling"
            @noeudtmp=$xp->find("./preceding-sibling::element[1]",$noeud_tmp)->get_nodelist;
            $noeud_tmp=shift(@noeudtmp);
        }
        # écriture des résultats dans un fichier en utilisant la fonction join, pratique !
        print MATCHFILE join(' ', @matching_tokens)."\n";
    }
}