#!/usr/bin/perl

use POSIX qw:setlocale:;
setlocale(LC_CTYPE,   "pt_PT.utf8");
setlocale(LC_COLLATE, "pt_PT.utf8");
use locale;

use utf8;
use warnings;
use strict;
use Text::RewriteRules;
use XML::Writer::Simple partial => 1,
                        tags => [qw/dic head form orth phon gramGrp def
                                    entry sense etym cit usg quote bibl ref term/];

my @Genres = (qr/Fig\. alg\./i,
              qr/(?:Chul|Gír)\.? (?:lisb\.?|(?:ant\. )?d[aeo] \S+(?: lis\S+)?)/i,
              qr/Pleb\. do Bras\.?/i,
              qr/t\. onom/i,
              "p. us","us. p",
              qw/Gír Fam Pop Des Fig Vulg Ant Chul Euph Ext Irón Infant Deprec Neol Improp
		 Burl Obsol Poét Restrict Prolóq Pleb Mod/);

my @Domains = qw/Agr Anat Anthrop Apicult Arith Artilh Archit Arm Astrol Astron Archeol
                 Bacter Biol
                 Eccles Bot Carp Chapel Chím Chron Cir Constr Cutel Cyn Comm
                 Enol Entom Equit Escol Espir Fin Geneal Geod Geogr Geol For Fort
                 Geom Glot Gram Gymn Heráld Hortic Hydrogr Ichthyol Jur Marit Ind
                 Marcen Marn Mathem Med Mil Mecan Miner Mús Náut Myth Ópt Ornit
                 Pathol Pesc Pharm Rhet Philol Philos Phot Phýs Physiol Veloc
                 Pint Polit Sal Serralh Serr Taur Terat Theol Typ Techn Ven Vers
                 Topogr Veter Vit Vin Zool/;


my @Geos = (qr/(?:Açor|Port|Bras)\.? d[aoe]s? (?:S(?:ão|\.) Paulo|Rio Grande|\S+(?: d[aeo] \S+)?)(?: do [NS]| do Rio| e S(?:\.|ão) Paulo)?/i,
            qr/Bras\.? riograndense\.?/i,
            qr/Lisbôa/i,
            qw/sanscrit Mad Afr Bras Açor trasm minh alent Angl Gal Port Caboverd Gal Lisb(?:ôa)? sertanejo lat/);

my $Domains = "(?:".join("|", @Domains)."|Econ. polít|Hist. Nat".")";
my $Genres  = join("|", @Genres);
my $Geos    = join("|", @Geos);
my $PTR     = qr/\b(?:alent|alg|Ribatejo|beir|Beira-Baixa|dur|extrem|baía|minh|trasm|minas|N)\b/i;

my $n   = qr{(?:\^\d+)};      # ^3
my $fon = qr{(?: *\(.*?\))}; #(...)

my $letter = shift;
$letter =~ s!xml/(.+).xml!$1!;
$letter = substr $letter, 0, 1 unless $letter eq "Geo" or $letter eq "Names";
$letter = uc($letter) unless $letter eq "Geo" or $letter eq "Names";

print STDERR "txt2xml: Originais/$letter.txt => xml/$letter.xml ";

open IN, "Originais/$letter.txt" or die $!;
open OUT, ">xml/$letter.xml" or die $!;
binmode IN, ":utf8";
binmode OUT, ":utf8";
print OUT xml_header;
print OUT start_dic;
print OUT " ",head($letter),"\n";
$/="";
my $i = 0;
while(<IN>){

    $i++;
    print STDERR "\rtxt2xml: $letter.txt => xml/$letter.xml [$i entries]" unless $i % 100;

    # chomp;
    s/[ \t]+/ /g;
    s/\n\n+/\n/;

    # tentei colocar estes no sistema de reescrita, mas nao consegui.
    # devo estar a dormir :-S
    s/&/&amp;/g;
    s/>/&gt;/g;
    s/</&lt;/g;
    s/ _ou_ / ou /g;
    my $entry = examp(fixXML(pentrada($_) . end_def . end_sense . end_entry));
    print OUT add_xmlid($entry), "\n";
}
print OUT end_dic;
close OUT;
close IN;
print STDERR "\rtxt2xml: $letter.txt => xml/$letter.xml [$i entries]\n";

sub add_xmlid {
    my $string = shift;
    $string =~ m!orth>(.*)<!;
    my $term = lc($1);


    my $n = ($string =~ m!n="(\d+)"!)?":$1":"";

    if ($string =~ /<entry>/) {
        $string =~ s/<entry>/<entry id="$term$n">/;
    } else {
        $string =~ s/<entry /<entry id="$term$n" /;
    }
    return $string;
}

sub gterm{                    #generate term
    my ($a, $b, $c, %args) = @_;
    if ($b) {
        $b =~ s!^\^!!;
        $args{n} = $b;
        $args{type} = "hom";
    }
    my $phon = "";
    if ($c) {
        $c =~ s/[(_) ]//g;
        $phon = "\n".phon({extent => 'part'},$c)
    }
    return "\n".start_entry({%args}).form("\n", orth($a), $phon, "\n")
}

RULES/m examp
(«(?:[^«»]++|(?-1))*+»)=e=>$a = $1; cit({type=>'example'},quote($a))
ENDRULES

RULES fixXML
\*([^\* ]+)\*==>$1
</form></sense>==></form>
</form></def>\n</sense>==></form>
</form>(.+)==></form>\n<sense><def>$1
(<etym.*/etym>)\n</def>==></def>\n$1
(<etym.*/etym>)\n</sense>==></sense>\n$1

</gramGrp>\n<gramGrp>=e=>" "
<gramGrp>(.*?)[_;](.*?)</gramGrp>=e=>$a="$1 $2";gramGrp($a)
<gramGrp>\s+==><gramGrp>
\s+</gramGrp>==></gramGrp>

\b(T\.\s+us.\s+por\s+clássicos)\s*</gramGrp>=i=e=>$a=$1;"</gramGrp>\n".usg({type=>'obs'}, $a)
\b(us.\s+ainda\s+na\s+.aía)\s*</gramGrp>=i=e=>$a=$1;"</gramGrp>\n".usg({type=>'geo'}, $a)
\b(Us\.\s+na\s+loc\.\s+adv\.)\s*</gramGrp>=i=e=>$a=$1;"</gramGrp>\n".usg({type=>'obs'}, $a)

<gramGrp>(.*?)\s*($Genres)\b\.?\s*(.*?)</gramGrp>=i=e=>($a,$b) = ("$1 $3",$2);gramGrp($a)."\n".usg({type=>'style'},"$b.")

<gramGrp>(.*?)\s*(\bT\. (?:afr|eccles|caboverd|santomense|d[oea]s? .*?))\b\.?</gramGrp>=i=e=>($a,$b)=($1,$2);gramGrp($a)."\n".usg({type => 'geo'},$b)

<gramGrp>(.*?)\s*(\bProv\.? (?:d[aeo] )?)($PTR\.?)\s+e\s+($PTR\.?)(.*?)</gramGrp>=i=e=>gramGrp("$1 $2 $3 $2 $4 $5")

<gramGrp>(.*?)\s*(?:\bProv\.?\s+(?:d[aeo]\s+)?)($PTR\.?)(.*?)</gramGrp>=i=e=>gramGrp("$1 Prov. $3")."\n".usg({type => 'geo'}, "$2")

Prov\. Prov\.=i=>Prov.

<gramGrp>(.*?)\s*(\bLoc\. (?:escolar\.?|d[aeo] \S+))\s*(.*)</gramGrp>=i=e=>$a="$1 $3 Loc."; $b = $2; gramGrp($a)."\n".usg({type => 'geo'},$b)

<gramGrp>(.*?)\s*((?:\bT\. )?\b$Domains\b\.?\s+de\s+.oimbra)\.?\s*(.*?)</gramGrp>=i=e=>($a,$b) = ("$1 $3",$2);gramGrp($a)."\n".usg({type=>'dom'},"$b.")."\n".usg({type=>'geo'},"Coimbra")

<gramGrp>(.*?)\s*((?:\bT\. )?\b$Domains\b)\.?\s*(.*?)</gramGrp>=i=e=>($a,$b) = ("$1 $3",$2);gramGrp($a)."\n".usg({type=>'dom'},"$b.")

<gramGrp>(.*?)\s*\b($Geos)\b\.?\s*(.*?)</gramGrp>=i=e=>($a,$b)=("$1 $3",$2);gramGrp($a)."\n".usg({type => 'geo'},$b)

($PTR\.?)</gramGrp>=i=e=>$a=$1;"</gramGrp>".usg({type=>'geo'}, $a)

Prov\.\s*(.*?)</gramGrp>=i=e=>"$1</gramGrp>\n".usg({type=>'style'},"Prov.")

inútil\.?(.*?)</gramGrp>=i=e=>"$1</gramGrp>\n".usg({type=>'obs'}, "inútil")
dispensável\.?(.*?)</gramGrp>=i=e=>"$1</gramGrp>\n".usg({type=>'obs'}, "dispensável")


\s+</gramGrp>==></gramGrp>
\s+\.</gramGrp>==></gramGrp>
\s*,</gramGrp>==></gramGrp>
<gramGrp>\s+==><gramGrp>
<gramGrp>([^<]*)\s*\*\s*([^<]*)</gramGrp>=e=>$a="$1 $2"; "ast=\"1\"".gramGrp($a)
<sense>\nast="1"==><sense ast="1">
\be\s*</gramGrp>==></gramGrp>
<gramGrp>\s*e\s+==><gramGrp>
<gramGrp/>==>
<gramGrp></gramGrp>==>
<sense>\n\n==><sense>\n

</cit>\.?\s*([^<].+)\n=e=>$a=$1;bibl($a)."</cit>"

<term>([^_]+)_\s*;\s*_([^_]+)</term>=e=>($a,$b)=($1,$2); term($a)."; ".term($b)
ENDRULES





RULES/m pentrada
&amp; \* \} \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=> gterm($1,$2,$3,ast=>1, chaveta=>1, name=>1)
&amp; \} \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>   gterm($1,$2,$3,chaveta=>1, name=>1)
&amp; \* \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>  gterm($1,$2,$3,ast=>1, name=>1)
&amp; \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>     gterm($1,$2,$3,name=>1)

@ \* \} \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=> gterm($1,$2,$3,ast=>1, chaveta=>1, geo=>1)
@ \} \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>   gterm($1,$2,$3,chaveta=>1, geo=>1)
@ \* \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>  gterm($1,$2,$3,ast=>1, geo=>1)
@ \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>     gterm($1,$2,$3,geo=>1)

\* \} \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=> gterm($1,$2,$3,ast=>1, chaveta=>1)
\* \+ \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=> gterm($1,$2,$3,ast=>1, mais=>1)
\} \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>    gterm($1,$2,$3,chaveta=>1)
\* \*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>    gterm($1,$2,$3,ast=>1)
\*([^*\{\n]+)\*\s*,($n?)($fon?)\n=e=>       gterm($1,$2,$3)

((\* )?_([^_\n]|_[^_\n]{1,5}_)+_( \*)?)\n=e=>  $a=$1; end_def.end_sense.start_sense.gramGrp($a)."\n".start_def
\*\n=e=>                                   end_def.end_sense.start_sense.gramGrp("*")."\n".start_def

(\(De (.*)n\. p\.\))\n=e=>        $a=$1; etym({ori=>"nome"},$a)."\n"
(\(De .*\))\n=e=>                 $a=$1; etym($a)."\n"
(\((Fr|Gr|Lat|Ingl|It|Hebr|Al)\. (.*)\))\n=e=>      $a=$1; $b=$2; etym({orig=>$b},$a)."\n"
(\(([Dd]o (\S+)\. (.*?))\))\.?\n=e=>     $a=$3;$b=$1; etym({ori=>"$a"},"$b")."\n"
(\(T\. .*\))\n=e=>                $a=$1; etym($a)."\n"

\(V\. _(.*)_\)=e=>              $a=$1; ref("(V. ".term($a).")")

(.+)==>$1
\n==>\n
ENDRULES

__END__