#!/usr/bin/perl 
# última mod.: Paulo Rocha 28 Nov 2008

# versão simplificada de milhafre.cgi, apresentando os resultados em formato TXT

use locale;
use Digest::MD5;
use POSIX qw(locale_h);

setlocale(LC_CTYPE, "pt_PT.UTF-8");
setlocale(LANG,"pt_PT");

$temp=$ENV{'QUERY_STRING'};
$temp=~y#\+# #;
$temp=~s#%3D#IGUAL#g;
$temp=~s/%([A-F0-9]{2})/chr(hex($1))/egi;
%opc=split(/[&=]/,$temp || shift);

$opc{pedido}=~s#MV#P\?MV#g;
$opc{pedido}=~s#AUX#P\?AUX#g;
$opc{pedido}=~s#IGUAL#=#g;
$opc{inicial}=0 unless ($opc{inicial});

binmode(STDOUT, ":latin1");
print "Content-type: text/plain;";

$pedido=$opc{pedido};

print "CORPUS: \U$opc{corpus}\n";
print "CONSULTA: $pedido\n";

open F1, "./tgrep2 -c $opc{corpus}.tg -a \' $pedido \' -m \"\%tw:::\%th:::\%yh:::\%zh:::\%um\\n\" |";
@resultado=split /\n/, join "", <F1>;
close F1;

if ($opc{corpus} eq "bosque") {
        if (!$opc{variantebr}) { @resultado=grep ! /CF\d+/, @resultado; }
        if (!$opc{variantept}) { @resultado=grep ! /CP\d+/, @resultado; }
	print "VARIANTES: ".($opc{variantebr} ? "BR " : " ").($opc{variantept} ? "PT" : "")."\n";
}

if ($opc{corpus} eq "selva") {
        if (!$opc{generoLIT}) { @resultado=grep ! /LIT-\d+/, @resultado; }
        if (!$opc{generoFAL}) { @resultado=grep ! /FAL-\d+/, @resultado; }
        if (!$opc{generoCIE}) { @resultado=grep ! /CIE-\d+/, @resultado; }
	print "TIPOS: ".($opc{generoLIT} ? "LIT " : " ").($opc{generoFAL} ? "FAL " : " ").($opc{generoCIE} ? "CIE " : " ")."\n";
}

print "\nResultados: ".($#resultado+1)."\n";

foreach (@resultado) {
        $qfac{$_}=&ordff($_);
        $contando{$qfac{$_}}++;
	$tot{$qfac{$_}}.=&limpa($_)."\n";
}

@resultado=sort { $contando{$qfac{$b}}<=>$contando{$qfac{$a}} || $qfac{$a} cmp $qfac{$b}} @resultado;

@resultado=@resultado[$a1..$a2];

foreach (@resultado) {
        $contando2{$qfac{$_}}++;
        $ex{$qfac{$_}}.="<li>".&limpa($_)."\n";
}

if ($opc{op1} || $opc{op2} || $opc{op3} || $opc{op4} || $opc{op5}) {
	foreach (sort {$contando{$b}<=>$contando{$a} || $a cmp $b} keys %contando) {
		print sprintf("%6d %s\n",$contando{$_},&para_texto($_));
	}
}

foreach (sort {$contando{$b}<=>$contando{$a} || $a cmp $b} keys %contando) {
	print "\n\nCHAVE DE AGRUPAMENTO: ".&para_texto($_)."\n\n" if ($_=~/\S/);
	print &para_texto($tot{$_}); 
}

sub ordff {
	$_=pop;
	@t=();
	split /:::/, $_;
	$_[4]=~s#>#&gt;#g;
	$_[4]=~s#<#&lt;#g;
        @ac=split /:/, $_[4];
	if ($opc{op1}) { push @t, $ac[0]; }
        if ($opc{op2}) { push @t, $ac[1]; }
        if ($opc{op3}) { push @t, $ac[2]; }
        if ($opc{op4}) { push @t, $ac[3]; }
	return join ":", @t;
}

sub limpa {
	$k=pop;
	$k=~s#\[#AbPR#g;
	$k=~s#\]#FxPR#g;
	$k=~s#\.#PntF#g;
	$k=~s#\$#CIFRÃO#g;
	($fr,$pt,$ddi,$ddf)=split /:::/, $k;
	$fr=~s#(C[FP]\d+-\d+[abc]?|(LIT|CIE|FAL)-\S+|AM-\S+)##;
	$id=$1;
	if ($opc{tiporesp} eq "t") { $fr=$pt; }
        else {
                @fr=split /\s+/, $fr;
                $fr[$ddi-1]="|".$fr[$ddi-1];
                $fr[$ddf-1]=$fr[$ddf-1]."|";
                $fr=join " ", @fr;
#		$fr=~s#inM(.+?)fiM#\U$1#;
        }
        $fr=~s#_# #g;
        $fr=~s#\b([Dd])e\+(</u>)? #$1$2#g;
        $fr=~s#\bem\+(</u>)? #n$1$2#g;
        $fr=~s#\bEm\+(</u>)? #N$1$2#g;
        $fr=~s#\b([Pp])or\+(</u>)? #$1el$2#g;
	$fr=~s#\b([Aa])(</u>)? (<u>)?o(s?)\b#$1$2$3o$4#g;
	$fr=~s#\ba a(s?)\b#à$1#g;
	$fr=~s#\bA a(s?)\b#À$1#g;
	$fr=~s#\ba (aqu.l\w+)\b#à$1#g;
	$fr=~s#\bA (aqu.l\w+)\b#À$1#g;
        $fr=~s#([Cc])om\+(</u>)? (<u>)?([nv]).s#$1on$2$3$4osco#g;
        $fr=~s#([Cc])om\+(</u>)? (<u>)?mim\b#$1om$2$3igo#g;
        $fr=~s#([Cc])om\+(</u>)? (<u>)?ti\b#$1on$2$3tigo#g;
        $fr=~s#([Cc])om\+(</u>)? (<u>)?si\b#$1on$2$3sigo#g;
        $fr=~s#ar-\s*(l[oa]s?)#â-$1#g;
        $fr=~s#er-\s*(l[oa]s?)#ê-$1#g;
        $fr=~s#ir-\s*(l[oa]s?)#í-$1#g;
	$fr=~s#-\s+(<u>)?(me|te|nos|vos|se)#-$1$2#g;
	$fr=~s#\b(anti|arqui|auto|contra|ex|inter|intra|mal|neo|pós|pré|pró|recém|sub|vice)-\s+#$1-#ig;
	$fr=~s#\}#\)#g;
        $fr=~s#\{#\(#g;
	$fr=~s#AbPR#\[#g;
	$fr=~s#FxPR#\]#g;
	$fr=~s#PntF#\.#g;
	$fr=~s#CIFRÃO#\$#g;
	$fr=~s#DOISPONTOS#:#g;
	$fr=~s#([\(\«]) +#$1#g;
        $fr=~s# +([\.,\)\!\?:;])#$1 #g;
	$fr=~s#(\W) +(\W)#$1$2#g;
	return "$id: $fr";
}

sub para_texto {
	$k=pop;
	$k=~s#(<li>|<[iu]>|</[iu]>)##g;
	$k=~s#\&gt;#>#g;
	$k=~s#\&lt;#<#g;
	$k=~s# +# #g;
	return $k;
}