#biblioteca de funções necessárias para converter vários formatos para CQP

# BIBLIOTECA.PL

# contém
# - tratar_pontuacao_interna
# - recupera_ortografia_certa
# - separa_frases 
# - protege_atributos_estruturais 

# última alteração DMS, 7 de Maio de 2000

sub tratar_pontuacao_interna {

    local($par);
    $par=$_[0];
    $par=~s/\.\.\.+/§/g;    # tratar das reticências
    $par=~s/([A-Z])\. *([A-Z])\.\s*$/$1+$2+ /g; # tratar de iniciais seguidas por ponto no fim de uma frase
    $par=~s/ ([A-Z])\./ $1+/g; # tratar de iniciais seguidas por ponto
    $par=~s/^([A-Z])\./$1+/g; # tratar de iniciais seguidas por ponto

    $par=~s/\+([A-Z])\./+$1+/g; #tratar dos pontos seguidos

# 					tratar dos pontos nas abreviaturas
    $par=~s/\.º/º+/g;
    $par=~s/º\./+º/g;
    $par=~s/\.ª/+ª/g;
    $par=~s/ª\./ª+/g;
    $par=~s/º\. ([^A-ZÀÁÉÍÓÚÂÊ«])/º+ $1/g; #só mudar se não for ambíguo com ponto final

# formas de tratamento
    $par=~s/Ex\./Ex+/g; # Ex.
    $par=~s/ ex\./ ex+/g; # ex.
    $par=~s/Exa(s*)\./Exa$1+/g; # Exa., Exas.
    $par=~s/ exa(s*)\./ exa$1+/g; # exa., exas
    $par=~s/Pe\./Pe+/g;
    $par=~s/Dr(a*)\./Dr$1+/g; # Dr., Dra.
    $par=~s/ dr(a*)\./ dr$1+/g; # dr., dra.
    $par=~s/ drs\./ drs+/g; # drs.
    $par=~s/Eng(a*)\./Eng$1+/g; # Eng., Enga.
    $par=~s/ eng(a*)\./ eng$1+/g; # eng., enga.
    $par=~s/([Ss])r(t*)a\./$1r$2a+/g; # Sra., sra., Srta., srta.
    $par=~s/([Ss])r(s*)\./$1r$2+/g; # Sr., sr., Srs., srs.
    $par=~s/ arq\./ arq+/g; # arq.
    $par=~s/Prof(s*)\./Prof$1+/g; # Prof., Profs.
    $par=~s/ prof(s*)\./ prof$1+/g; # prof., profs.

# partes de nomes (pospostos)
    $par=~s/ ([lL])da\./ $1da+/g;
    $par=~s/Jr\./Jr+/g;

# moradas
    $par=~s/Av\./Av+/g;
    $par=~s/ av\./ av+/g;
    $par=~s/Est(r*)\./Est$1+/g;
    $par=~s/Lg(o*)\./Lg$1+/g;
    $par=~s/T(ra)*v\./T$1v+/g; # Trav., Tv.

    $par=~s/Tel(e[fm])*\./Tel$1+/g; # Tel., Telef., Telem.
    $par=~s/ tel(e[fm])*\./ tel$1+/g; # tel., telef., telem.

# abreviaturas greco-latinas
    $par=~s/ a\.( *)C/ a+C/g;
    $par=~s/ a\.( *)c\./ a+c+/g;
    $par=~s/ d\.( *)C/ d+C/g;
    $par=~s/ d\.( *)c\./ d+c+/g;
    $par=~s/ ca\./ ca+/g;
    $par=~s/etc\.([.,;])/etc+$1/g;
    $par=~s/etc\.\)([.,;])/etc+)$1/g;
    $par=~s/etc\. --( *[a-záéíóúâêà,])/etc+ --$1/g;
    $par=~s/etc\.(\)*) ([^A-ZÀÁÉÍÓÂÊ])/etc+$1 $2/g;
    $par=~s/ et\. *al\./ et+al+/g;
    $par=~s/ q\.b\./ q+b+/g;
    $par=~s/ i\.e\./ i+e+/g;
    $par=~s/ibid\./ibid+/g;
    $par=~s/ id\./ id+/g; # se calhar é preciso ver se não vem sempre precedido de um (
    $par=~s/op\.( )*cit\./op+$1cit+/g;

# unidades de medida
    $par=~s/([0-9][hm])\. ([^A-ZÁÉÍÚÁÊ])/$1+ $2/g; # 19h., 24m.
    $par=~s/([0-9][km]m)\. ([^A-ZÁÉÍÚÁÊ])/$1+ $2/g; # 20km., 24mm.
    $par=~s/([0-9]kms)\. ([^A-ZÁÉÍÚÁÊ])/$1+ $2/g; # kms. !!

# outros
    $par=~s/séc\./séc+/g;
    $par=~s/pág(s*)\./pág$1+/g;
    $par=~s/pg\./pg+/g;
    $par=~s/ ed\./ ed+/g;
    $par=~s/Ed\./Ed+/g;
    $par=~s/ sáb\./ sáb+/g;
    $par=~s/ dom\./ dom+/g;
    $par=~s/ id\./ id+/g;
    $par=~s/ min\./ min+/g;
    $par=~s/ n\.o(s*) / n+o$1 /g; # abreviatura de numero no MLCC-DEB
    $par=~s/ no\.(s*) / no+$1 /g; # abreviatura de numero no.
    $par=~s/ p\.ex\./ p+ex+/g;
    $par=~s/ p\./ p+/g;
    $par=~s/ pp\./ pp+/g;
    $par=~s/ art(s*)\./ art$1+/g;
    $par=~s/Min\./Min+/g;
    $par=~s/vol(s*)\./vol$1+/g;

# Abreviaturas inglesas
    $par=~s/Bros\./Bros+/g;
    $par=~s/Co\. /Co+ /g;
    $par=~s/Corp\. /Corp+ /g;
    $par=~s/Inc\. /Inc+ /g;
    $par=~s/Ltd\. /Ltd+ /g;
    $par=~s/Mr(s*)\. /Mr$1+ /g;

# Abreviaturas francesas
    $par=~s/Mme\./Mme+/g;

    $par=~s/\. *,/+,/g; # de qualquer maneira, se for um ponto seguido de uma vírgula, é abreviatura...
    $par=~s/\. *\./+./g; # de qualquer maneira, se for um ponto seguido de outro ponto, é abreviatura...

# tratamento de URLs ou será melhor não separar quando os pontos se
# encontram dentro de palavras?
#    $par=~m/ ([a-z-]+\.[a-z-])+\.([a-z])/;

# tratamento de numerais

    $par=~s/([0-9]+)\.([0-9]+)\.([0-9]+)/$1_$2_$3/g;
    $par=~s/([0-9]+)\.([0-9]+)/$1_$2/g;

# tratamento de numerais cardinais
    $par=~s/^([0-9]+)\. /$1+ /g;  # tratar dos números com ponto no início da frase
    $par=~s/([0-9]+)\. ([a-záéíóúâêà])/$1+ $2/g;  # tratar dos números com ponto antes de minúsculas

# tratamento de numerais ordinais acabados em .o
    $par=~s/([0-9]+)\.([oa]s*) /$1+$2 /g;
# ou expressos como 9a. 
    $par=~s/([0-9]+)([oa]s*)\. /$1$2+ /g;

# tratar numeracao decimal em portugues
    $par=~s/([0-9]),([0-9])/$1#$2/g; 
#print "TRATA: $par\n";

# Proteger os pontos dentro de palavras 
# por exemplo por causa dos URLs...
    $par=~s/([a-z])\.([a-z])/$1+$2/g;
    $par;
}

sub recupera_ortografia_certa {

# os sinais literais de + são codificados como "++" para evitar transformação
# no ponto, que é o significado do "+"

    local($par);
    $par=$_[0];

    $par=~s/([^+])\+/$1./g;
    $par=~s/\+\+/+/g;
    $par=~s/§/.../g;
    $par=~s/_/./g;
    $par=~s/#/,/g;
    $par;

}


sub separa_frases {

(local $par = $_[0]);

#	$num++;

	$par=&tratar_pontuacao_interna($par);

#print "Depois de tratar_pontuacao_interna: $par\n";

# separar esta pontuação, apenas se não for dentro de aspas, ou seguida 
# por vírgulas
	$par=~s/([?!])([^»,§?!)"])/$1.$2/g; 

#print "Depois de tratar do ?!: $par";

# separar as reticências entre parenteses apenas se forem seguidas de nova 
# frase, e se não começarem uma frase elas próprias
	$par=~s/([a-záéíóúâêàã])§([)»]) *([A-ZÁÉÍÓÚÀ])/$1§$2.$3/g; 
	$par=~s/([a-záéíóúâêàã]\")§([)»]) *([A-ZÁÉÍÓÚÀ])/$1§$2.$3/g; 

#print "Depois de tratar das retic. seguidas de ): $par";

# separar os pontos antes de parênteses se forem seguidos de nova frase
	$par=~s/([a-záéíóúâêàã])\.([)]) *([A-ZÁÉÍÓÚÀ])/$1 + $2.$3/g; 

# separar as reticências apenas se forem seguidas de nova frase, e se não 
# começarem uma frase elas próprias
	$par=~s/([a-záéíóúâêàã!?])§ ([^»a-záéíóúâêà,;?!)])/$1§.$2/g; 

#print "depois de tratar das reticencias seguidas de nova frase: $par\n";

# tratar dos dois pontos: apenas se seguido por discurso directo em maiúsculas
	$par=~s/: «([A-ZÁÉÍÓÚÀ])/:.«$1/g;  

# tratar dos dois pontos se eles acabam o parágrafo (é preciso pôr um espaço)
        $par=~s/:\s*$/:. /;

# tratar dos pontos antes de aspas
	$par=~s/\.»([^.])/+».$1/g; 

# tratar das reticências antes de aspas
	$par=~s/§»([^.])/§».$1/g; 

# tratar das aspas quando seguidas de novas aspas
        $par=~s/»\s*«/». «/g;

# tratar de ? e ! seguidos de aspas quando seguidos de maiúscula
        $par=~s/([?!])» ([A-ZÁÉÍÓÚÀÊÂ])/$1». $2/g;

# tratar dos pontos antes de aspas precisamente no fim
	$par=~s/\.»$/+». /g; 

# tratar das reticências e outra pontuação antes de aspas precisamente no fim
	$par=~s/([!?§])»\s*$/$1». /g;

#tratar das reticências precisamente no fim
	$par=~s/§\s*$/§. /g;

# tratar dos pontos antes de parêntesis precisamente no fim
	$par=~s/\.\)$/+\). /g;

# tratar de parágrafos que acabam em letras ou +, chamando-os fragmentos
        if ($par =~/[A-Za-záéíóúêãÁÉÍÓÚÀ0-9]\s*\)*\s*$/) {$fragmento=1;}

# se o parágrafo acaba em "+", deve-se juntar "." outra vez.
        $par=~s/([^+])\+\s*$/$1+. /;

# se o parágrafo acaba em abreviatura (+) seguido de aspas, deve-se juntar "."
        $par=~s/([^+])\+\s*(["»])\s*$/$1+$2. /;

	@sentences=split/\./,$par;
        if (($#sentences > 0) and not $fragmento) {
           pop(@sentences);
        }

        $resultado="";
        $num_frase_no_paragrafo=0; # para saber em que frase pôr <s frag>
        foreach $frase (@sentences) {
	    $frase=&recupera_ortografia_certa($frase);

	    if ( ($frase=~/[.?!:;][»"]*\s*$/) or ($frase=~/[.?!] *\)[»"]*$/) ) { # frase normal acabada por pontuação
                $resultado.="<s> $frase </s>\n";
            }
	    elsif (($fragmento) and ($num_frase_no_paragrafo == $#sentences)) {
                $resultado.="<s frag> $frase </s>\n";
                $fragmento=0;
            }
            else {
                $resultado.="<s> $frase . </s>\n";
            }
            $num_frase_no_paragrafo++;
	}

$resultado;
}

sub protege_atributos_estruturais {

(local $linha_CQP = $_[0]);

$linha_CQP=~s/p par=/p_par=/g;
$linha_CQP=~s/marca num=/marca_num=/g;
$linha_CQP=~s/nota num=/nota_num=/g;
$linha_CQP=~s/titulo id=/titulo_id=/g;
$linha_CQP=~s/texto id=/texto_id=/g;
$linha_CQP=~s/<s frag/<s_frag/g;
$linha_CQP=~s/<ext n=(.*?) sec=(.*?) sem=(.*?)>/<ext_n=$1_sec=$2_sem=$3>/ig;
$linha_CQP;
}

1;