#!/usr/bin/perl
require '/home/ferramentas/pauloteca.pl';
# Última alteração DMS 10 Junho de 2003

use locale;
use POSIX qw(locale_h);
setlocale(LC_CTYPE, "pt_PT") or die;

sub QuantosTokens {
#    print "Primeiro: $_[0]\n";
    shift @_; # o primeiro é o tipo...
    return scalar @_;
}

sub QuantasAnalises {
	return scalar &ObtemAnalises(@_);
}

sub ObtemAnalises {
	local @res;
	foreach (@_) {
		push @res, grep /\xf7/, split /\n/, $_;
	}
	return @res;
}


# &Formas("\W+",@lista) devolve a quantidade de tokens sem letras na @lista de tokens
sub cmFormas {
    local $expr_reg=$_[0];
    shift @_;
	local @formas=&ObtemColuna ( 0, @_);
	open F1, ">debug.txt" or die "Não consegui abrir o debug.txt\n";
#	print F1 "Formas:", join "\n", @formas;

	local @res=grep /^$expr_reg$/,@formas;

	print F1 "Resultado:\n", join "\n", @res;
	close F1;
	return scalar @res;
}

sub cmPoS {
    local $expr_reg=$_[0];
    shift @_;
        local @a_ver=&ObtemColuna( 1, &ObtemAnalises(@_) );
        return scalar grep /^$expr_reg$/,@a_ver;
}

sub FiAnaPos {
# já recebe as análises
    local $expr_reg=$_[0];
    shift @_;
        local @a_ver=&ObtemColuna( 1, @_ );
        return grep /^$expr_reg$/,@a_ver;
    }

sub cmAnaPos {
# já recebe as análises
    local $expr_reg=$_[0];
    shift @_;
        local @a_ver=&ObtemColuna( 1, @_ );
        return scalar grep /^$expr_reg$/,@a_ver;

   }

sub cmAnaOutros {
# já recebe as análises
    local $expr_reg=$_[0];
    shift @_;
        local @a_ver=&ObtemColuna( 10, @_ );
        return scalar grep /^$expr_reg$/,@a_ver;

   }

sub cmOutros {
    local $expr_reg=$_[0];
    local $num=0;
    shift @_;
	open (DEBUG, ">debug.txt") or die "Não consegui abrir o DEBUG.txt\n";
    foreach (@_) {
	local @forma=&ObtemColuna( 10, &ObtemAnalises($_));

        @sub=grep /^$expr_reg$/, @forma;
	if (@sub) {
	    $num++;
	    print DEBUG  @sub, "\n";
	}
    }
    close (DEBUG);
    return $num;
}

sub cmAmbPos {
    local @sub=();
	$verif=shift @_; 
#	print "Condição: $verif\n";
	local @a_ver=&PosPalavra ( @_ );
	open (DEBUG, ">debug.txt") or die "Não consegui abrir o DEBUG.txt\n";
        @sub=grep /== PoS ==\s*$verif\s*$/, @a_ver;
        print DEBUG (join "ZZZ\n", @sub);
        close (DEBUG);

#	print "Cardinal de sub: $#sub\n";
	return scalar grep /== PoS ==\s*$verif\s*$/, @a_ver

}

sub JuntaColunas {
    local @res;
    $col1=shift @_;
    $col2=shift @_;
    shift @_;
    @exp=@_;
    foreach (@_) {
	push @res, (split /\xf7/, $_)[$col1].(split /\xf7/, $_)[$col2];
	}
#    print join "==", @res;
    return @res;
}
sub JuntaTresColunas {
    local @res;
    $col1=shift @_;
    $col2=shift @_;
    $col3=shift @_;
    shift @_;
    @exp=@_;
    foreach (@_) {
	push @res, (split /\xf7/, $_)[$col1].(split /\xf7/, $_)[$col2].(split /\xf7/, $_)[$col3];
	}
#    print join "==", @res;
    return @res;
}

sub ObtemColuna {
    local @res;
    $col=shift @_;
#    shift @_;
    @exp=@_;
#	print STDERR "Coluna $col, Cardinal do vector: $#exp\n";
    foreach (@_) {
		push @res, (split /\xf7/, $_)[$col];
	}
#	print join "==", @res;
	return @res;
}


# &PoSDupla("SUB","V",@lista) devolve o números de tokens na @lista com análises V e SUB simultaneamente
sub PoSDupla {
        return grep /(^|\n)[^\xf7]+\xf7$_[1]\xf7/, grep /(^|\n)[^\xf7]+\xf7$_[0]\xf7/, @_;
}

# &PosPalavra(@lista) devolve uma lista, onde cada elemento contem a lista de PoS atribuídos a cada token
sub PosPalavra {
	local @el;
	foreach (@_) {
#	    print "No PosPalavra: $_\n";
		($el)=($_=~/(.+?)\xf7/);
		@el=();
		foreach $l (split /\n/, $_) {
			push @el, (split /\xf7/, $l)[1];
#	 @el= ($_=~/\xf7(.+?)\xf7.+\n/g);
		}
		push @lel, "F == $el == Q == ".($#el+1)." == PoS == ".(join " ", @el)." ";
	}
	return @lel;
}


sub ObtemComBaseEmLista {
        ($fxd,$fxz,$orden)=@_;
	print "Argumentos: $fxd; $fxz";
	open F1, $fxd or die "Não consegui abrir $fxd\n";
	foreach (<F1>) {
	        chomp;
	        if (/\xf7/) { $_=(split /\xf7/)[0] }
	        $dour{$_}=1;
	}
	close F1;
        $/="\xd7\n";
        open F1, $fxz  or die "Não consegui abrir $fxd\n";
        foreach (<F1>) {
                $p=(split /\xf7/)[0];
                push @lista, $_ if ($dour{$p});
        }
        close F1;
        @lista=sort @lista if ($orden);
	print @lista;
}

sub FiltraLista {
    local $tam_lista=shift @_;
    local $i=0; $el=$p=0; @lista=();
#    print "Tamanho da lista: $tam_lista\n";
    while ($i < $tam_lista) {
	$el=shift @_;
	($p)=($el=~/^(.+?)\xf7/);
#	print "P:$p\n";
	$dour{$p}=1 if ($p);
	$i++;
    }
    @exp=@_;
    foreach (@_) {
	($p)=($_=~/^(.+?)\xf7/);
	if ($dour{$p}) {	
	    push @lista, $_;
	    $filtro{$p}=1;
	}
    }
    print "Número de formas da lista dourada reconhecidas pelo sistema... ".(scalar keys %filtro)."\n";
# Aqui retiro da dourada as formas que não se encontram no output
    @exp=@dourada;
    @dourada=();
    foreach (@exp) {
	($p)=($_=~/^(.+?)\xf7/);
	push @dourada, $_ if ($filtro{$p});
#	print "Este não encontrou: $p\n" if (not $filtro{$p});
    }
    print "Tamanho da nova lista dourada:", $#dourada+1,"\n";
    return @lista;
}
1;