<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># -*- coding: utf-8 -*-

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

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

our ($opt_f, $opt_l, $opt_H, $opt_p, $opt_w);
getopts('f:lp:w:H');

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

&amp;usage () if (($#ARGV &lt; 0) || ($#ARGV &gt; 1) || (defined ($opt_f) &amp;&amp; defined ($opt_w)) || ((!defined ($opt_f)) &amp;&amp; (!defined ($opt_w))));

my $glawiFile  = $ARGV[0];
my $outFile    = $ARGV[1];

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

if (defined ($outFile))
{
    open (OUTFILE, "&gt;", $outFile) or die ("Unable to write: $outFile\n");
    binmode (OUTFILE, ":encoding(utf8)");
} # if (defined ($outFile))

my %wordValues;
&amp;readWordValuesFile ($opt_f) if (defined ($opt_f));

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

&amp;outputHTMLheader () if (defined ($opt_H));

while ($line = &lt;GLAWI&gt;)
{
    if ($line =~ /&lt;article&gt;/)
    {
        $currentBuffer = $line;
    } # if ($line =~ /&lt;article&gt;/)
    else
    {
        if ($line =~ /&lt;\/article&gt;/)
        {
	    $inArticle = 1;
	    &amp;parseLine ($'); #'
        } # if ($line =~ /&lt;\/article&gt;/)
	elsif ($inArticle)
	{
	    if ($line =~ /&lt;\/article&gt;/)
	    {
		&amp;parseLine ($`);
		$inArticle = 0;		    
	    } # elsif ($line =~ /&lt;\/article&gt;/)
	    else
	    {
		&amp;parseLine ($line);
	    } # elsif ($line =~ /&lt;\/article&gt;/) else {
	} # elsif ($inArticle)	    
    } # if ($line =~ /&lt;article&gt;/) else {
} # while (&lt;INFILE&gt;)

close (GLAWI);

&amp;outputHTMLfooter () if (defined ($opt_H));
close (OUTFILE) if (defined ($outFile));

sub parseLine ()
{
    my $currentLine = shift;

    if ($currentLine =~ /&lt;title&gt;(.*?)&lt;\/title&gt;/)
    {
	$currentTitle = $1;
    }
    elsif ($currentLine =~ /&lt;pos .*?type=\"(.*)\"/)
    {
	$currentPOS = $1;
	$posMatches = ((!defined ($opt_p)) || ($currentPOS =~ /$opt_p/));

	if ($posMatches)
	{
	    $posMatches = ((!defined ($opt_l)) || ($currentLine !~ /lemma="0"/));
	} # if ($posMatches)
    } # elsif ($currentLine =~ /&lt;pos .*?type=\"(.*)\"/)
    elsif ($currentLine =~ /&lt;gloss&gt;/)
    {
	my ($l, $r) = ($`, $'); #'
	&amp;parseLine ($l);
	$inGloss = 1;
	&amp;parseLine ($r);
    } # if ($currentLine =~ /&lt;gloss&gt;/)
    elsif ($currentLine =~ /&lt;\/gloss&gt;/)
    {
	my ($l, $r) = ($`, $'); #'
	&amp;parseLine ($l);
	$inGloss = 0;
	&amp;parseLine ($r);
    } # elsif ($currentLine =~ /&lt;\/gloss&gt;/)
    elsif ($posMatches &amp;&amp; $inGloss)
    {
	if ($currentLine =~ /&lt;txt&gt;/)
	{
	    my ($l, $r) = ($`, $'); #'
	    &amp;parseLine ($l);
	    $inText = 1;
	    $currentBuffer = "";
	    &amp;parseLine ($r);
	} # elsif ($currentLine =~ /&lt;txt[^&lt;&gt;]*&gt;/)
	elsif ($inText)
	{
	    if ($currentLine =~ /&lt;\/txt&gt;/)
	    {
		my ($l, $r) = ($`, $'); #'
		&amp;parseLine ($l);
		$inText = 0;

		my $matches = &amp;testMatches ($currentBuffer);
		if ($matches ne "")
		{
		    &amp;output ($matches);
		} # if ($matches)

		&amp;parseLine ($r);
	    } # elsif ($currentLine =~ /&lt;\/txt&gt;/)
	    else
	    {
		$currentBuffer .= $currentLine;
	    } # if ($currentLine =~ /&lt;\/txt&gt;/) else {
	} # elsif ($inText)	
	
    } # elsif ($inGloss)
} # parseLine ()

sub testMatches ()
{
    my $glossTxt = shift;
    my $result = "";

    if (defined ($opt_w))
    {
	my $regex = "(\\W)(" . $opt_w . ")(\\W)";

	if ($glossTxt =~ /$regex/)
	{
	    my ($l, $m, $r) = ($` . $1, $2, $' . $3); #'
	    $result = &amp;formatOutput ($l, $m, $r);
	}
    } # if (defined ($opt_w))
    elsif (defined ($opt_f))
    {
	foreach my $wordRegexp (keys (%wordValues))
	{
	    my $regex = "(\\W)(" . $wordRegexp . ")(\\W)";

	    if ($glossTxt =~ /$regex/)
	    {
		my ($l, $m, $r) = ($` . $1, $2, $3 . $'); #'
	    
		$result .= &amp;formatOutput ($l, $m, $r);
	    } # if ($glossTxt =~ /$wordRegexp/)
	} # foreach my $wordRegexp (keys (%wordValues))
    } # elsif (defined ($opt_f))

    return $result;
} # testMatches ()

sub formatOutput ()
{
    my ($l, $m, $r) = @_;
    my $result;

    if (defined ($opt_H))
    {
	$result = "&lt;tr&gt;&lt;td class='articleTitle'&gt;" . $currentTitle . "&lt;/td&gt;&lt;td class='left'&gt;" . $l . "&lt;/td&gt;&lt;td class='match'&gt;" . $m . "&lt;/td&gt;&lt;td class='right'&gt;" . $r . "&lt;/td&gt;&lt;/tr&gt;\n";	
    } # if (defined ($opt_H))
    else
    {
	$result = $currentTitle . ":\t" . $l . "\t" . $m . "\t" . $r . "\n";	
    } # if (defined ($opt_H)) else {

    return $result;
} # formatOutput ()

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

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

    while ($line = &lt;VALUES&gt;)
    {
	chomp ($line);
	$wordValues{$line} = 1 if ($line !~ /^\s*$/);
    } # while ($line = &lt;VALUES&gt;)

    close (VALUES);
} # readWordValuesFile ()

sub output ()
{
    my $txtToOutput = shift;

    if (defined ($outFile))
    {
	print OUTFILE $txtToOutput;
    } # if (defined ($outFile))
    else
    {
	print $txtToOutput;
    } # if (defined ($outFile)) else {    
} # sub output ()

sub outputHTMLheader ()
{
    &amp;output ("&lt;!DOCTYPE html&gt;\n&lt;html&gt;\n&lt;head&gt;\n");
    &amp;output ("&lt;meta charset=\"UTF-8\"&gt;\n");
    &amp;output ("&lt;title&gt;GLAWI's glosses\n");
    &amp;output ("&lt;style type=\"text/css\"&gt;\n");
    &amp;output (".articleTitle {font-weight: bold; vertical-align: top}\n");
    &amp;output (".match {font-weight: bold; color: darkgreen; text-align:center; vertical-align: top}\n");
    &amp;output (".left {text-align: right; vertical-align: top}\n");
    &amp;output (".right {text-align: left; vertical-align: top}\n");
    &amp;output ("&lt;/style&gt;\n&lt;/head&gt;\n&lt;body&gt;\n");
    &amp;output ("&lt;table&gt;\n");
} # outputHTMLheader ()

sub outputHTMLfooter ()
{
    &amp;output ("&lt;/table&gt;\n");
    &amp;output ("&lt;/body&gt;\n");
    &amp;output ("&lt;/html&gt;\n");
} # outputHTMLheader ()

sub usage ()
{
    print ("Usage: $0 [-p POS] [-l] [-w word] [-f lexiconFile] GLAWIfile [outFile]\n");
    print "\tExtracts glosses matching a set of criteria.\n";
    print ("\t-p POS: selects only glosses corresponding to a given part of speech (regexp match).\n");
    print ("\t-l: lemmas only.\n");
    print ("\t-w word: extracts glosses including a given word\n");
    print ("\t-f lexiconFile: file containing words to be found in glosses (format: one word perl line, UTF-8 encoded)\n");
    print ("\t-H: HTML output.\n");
    print ("\tNote: -f and -w options are mutually exclusive. Regexp matches are performed to test word occurences.\n");
    die  ("\n");
} # usage ()
</pre></body></html>