# -*- coding: utf-8 -*-

# Author: Franck Sajous
# Copyright: CNRS/CLLE-ERSS
# Last update: 2018-03-21
# See info and licence at: http://redac.univ-tlse2.fr/lexicons/glawi/tools/

use strict;
use warnings;
use utf8;
use XML::DOM;
use Getopt::Std;

our ($opt_c, $opt_e, $opt_f, $opt_p, $opt_t, $opt_v);
getopts('c:ef:p:t:v:');

binmode (STDOUT, ":encoding(utf8)");
binmode (STDERR, ":encoding(utf8)");

&usage () if (($#ARGV < 0) || ($#ARGV > 1) || (defined ($opt_f) && defined ($opt_v)));

my $dom_parser = new XML::DOM::Parser;
my $glawiFile  = $ARGV[0];
my $outFile    = $ARGV[1];

open (GLAWI, "<", $glawiFile) or die ("Unable to read: $glawiFile\n");
binmode (GLAWI, ":encoding(utf8)");

if (defined ($outFile))
{
    open (OUTFILE, ">", $outFile) or die ("Unable to write: $outFile\n");
    binmode (OUTFILE, ":encoding(utf8)");
    print OUTFILE "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
} # if (defined ($outFile))

my %labelValues;
&readLabelValuesFile ($opt_f) if (defined ($opt_f));

my ($line, $currentTitle);
my $currentBuffer = "";
my ($inArticle, $inGloss) = (0, 0);

while ($line = <GLAWI>)
{
    if ($line =~ /<article>/)
    {
        $currentBuffer = $line;
    } # if ($line =~ /<article>/)
    else
    {
        $currentBuffer .= $line;
	
        if ($line =~ /<\/article>/)
        {
	    if (&parseArticle ($currentBuffer))
	    {
		my $result = (defined ($opt_e) ? $currentTitle : $currentBuffer);

		if (defined ($outFile))
		{
		    print OUTFILE $result . "\n";
		}
		else
		{
		    print $result . "\n";
		}
            } # if ($matches)
        } # if ($line =~ /<\/article>/)
    } # if ($line =~ /<article>/) else {
} # while (<INFILE>)

close (OUTFILE) if (defined ($outFile));
close (GLAWI);

sub parseArticle ()
{
    my $articleBuffer = shift;
    my ($domArticle, $root, $result);

    eval {
        $domArticle = $dom_parser->parse($articleBuffer);
    };
    
    if (defined ($domArticle))
    {
        $root = $domArticle->getFirstChild;
	$result = &testCriteria ($root);
    } # if (defined ($domArticle))
    else
    {
        print STDERR ("$currentTitle: [ERROR] unable to parse article.\n");
	$result = 0;
    } # # if (defined ($domArticle))
} # sub parseArticle ()

sub testCriteria ()
{
    my $domArticle = shift;
    $currentTitle  = $domArticle->getElementsByTagName("title", 0)->item(0)->getFirstChild->toString;
    my $textNode   = $domArticle->getElementsByTagName("text", 0)->item(0);
    my $result = 1;
    $currentTitle =~ s/^\s*//;
    $currentTitle =~ s/\s*$//;
    
    $result = 0 if (defined ($opt_t) && ($currentTitle !~ /$opt_t/i));

    if ($result && (defined ($opt_p) || defined ($opt_c) || (defined ($opt_v) || (defined ($opt_f)))))
    {
	my $found = 0;

	foreach my $pos ($textNode->getElementsByTagName ("pos", 0))
	{
	    my $posType = $pos->getAttribute ("type");

	    if (defined ($opt_p))
	    {
		$found = ($found || (($posType eq $opt_p) && &testLabelCriterion ($pos)));
	    } # if (defined ($opt_p))
	    else
	    {
		# no constraint on POS type
		$found = ($found || &testLabelCriterion ($pos));
	    } # if (defined ($opt_p)) else {
	} # if (defined ($opt_p))

	$result = $found;
    } # if ($result)

    return $result;
} # testCriteria ()

sub testLabelCriterion ()
{
    my $posSection = shift;
    my $result = 0;

    if (defined ($opt_c) || defined ($opt_v) || defined ($opt_f))
    {
	foreach my $definitions ($posSection->getElementsByTagName("definitions", 0))
	{
	    # Note: all foreach below could be avoided by replacing the line above by:
	    # foreach my $label ($posSection->getElementsByTagName("label"))
	    # without the optional "0" arg. Execution would be slower however.

	    foreach my $definition ($definitions->getElementsByTagName("definition", 0))
	    {
		foreach my $gloss ($definition->getElementsByTagName("gloss", 0))
		{
		    foreach my $labels ($gloss->getElementsByTagName("labels", 0))
		    {
			foreach my $label ($labels->getElementsByTagName("label", 0))
			{
			    my $labelType  = $label->getAttribute ("type");
			    my $labelValue = $label->getAttribute ("value");

			    my $matchingType  = ((!defined ($opt_t)) || ($labelType =~ /$opt_t/i));
			    my $matchingValue = ((!defined ($opt_v)) || ($labelValue =~ /$opt_v/i));
			    $matchingValue = $matchingValue && ((!defined ($opt_f)) || (defined ($labelValues{$labelValue})));

			    return 1 if ($matchingValue && $matchingType);
			    # dirty breaking return could be avoided too, it enables however a faster execution.
			} # foreach my $label ($labels->getElementsByTagName("label", 0))w
		    } # foreach my $labels ($gloss->getElementsByTagName("labels", 0))
		} # foreach my $gloss ($definition->getElementsByTagName("gloss", 0))		
	    } # foreach my $definition ($definitions->getElementsByTagName("definition", 0))
	} # foreach my $definitions ($posSection->getElementsByTagName("definitions", 0))
    } # if ($defined ($opt_c) || defined ($opt_v))
    else
    {
	$result = 1;
    } # if (defined ($opt_c) || defined ($opt_v)) else {

    return $result;
} # testLabelCriterion ()

sub readLabelValuesFile ()
{
    my $filePath = shift;
    my $line;

    open (VALUES, "<", $filePath) or die ("Unable to read: $filePath\n");
    binmode (VALUES, ":encoding(utf8)");

    while ($line = <VALUES>)
    {
	chomp ($line);
	$labelValues{$line} = 1 if ($line !~ /^\s*$/);
    } # while ($line = <VALUES>)

    close (VALUES);
} # readLabelValuesFile ()

sub usage ()
{
    print ("Usage: $0 [-e] [-p POS] [-t titleRegexp] [-c labelCategory] [-v labelValue] [-f labelValuesFile] GLAWIfile [outFile]\n");
    print "\tExtracts articles matching a set of criteria.\n";
    print ("\t-e (entry): ouputs entry's title instead of the whole article\n");
    print ("\t-p POS: selects only articles having a part of speech=POS\n");
    print ("\t-t titleRegexp: selects only articles whose title matches against titleRegexp (case insensitive)\n");
    print ("\t-c labelCategory: selects articles having at least a definition including a label of the specified category\n");
    print ("\t-v labelValue: selects articles having at least a definition including a label with of the specified value\n");
    print ("\t-f lavelValuesFile: selects articles having at least a definition including a label whose value is included in the specified file\n");
    print ("\t   File format: text file, UTF-8 encoded, one value per line\n");
    print ("\tNote: if -c and -v are used, they apply on the same label\n");
    print ("\t      If -c and/or -v are used with the -p option, the label is searched in the matching POS sections.\n");
    print ("\t      -f and -v options are mutually exclusive.\n");
    die  ("\n");
} # usage ()
