#!/usr/bin/perl -w -s

use Encode::Guess;
use utf8;
use strict;

our($v,$vv,$l,$L,$t,$lat1,$utf8,$f,$suf);

my $w =   qr{[\w]+(?:-\w)*};
my $htag = qr{<.*?>};
my $href = qr{href=\".*?\"};
my $ltag = qr/\\$w(?:\[$w\])*(?:\{)?(?:$w\})?/;

my (%pt,%br);
my $ptcount=0;
my $brcount=0;

while (<DATA>){
	if (/^\+ ($w)$/){ $pt{$1} = $1	}
	if (/^- ($w)$/)	{ $br{$1} = $1	}
	 
}

if (@ARGV==0){	procfile("-",*STDIN);	}
else{
	for my $fn (@ARGV){
		next if (defined($suf) and $fn =~ /\.pt(?:PT|BR)$/);
		my $handle_enc = encguess($fn);
		open(FILE,"-|:utf8","$handle_enc '$fn'");
		my $res = procfile($fn,*FILE);
		close FILE;
		if(defined($suf) and $res =~ /pt|br/){
			my $sufix = 'pt'.uc $res;
			my $new_fn = "$fn.$sufix";
			if(-e $new_fn)	{ warn "Can't move '$fn' to '$new_fn': destination file exists!" }
			else 			{ rename $fn, $new_fn  or warn "Failed renaming '$fn' to '$new_fn'!"; }
		}
	}
}

########################################################## subs

sub encguess{
    if (defined $lat1){ return "iconv -f latin1 -t utf8"  }
    elsif (defined $utf8){ return "cat"}
    else{
        my $fn = shift;
        local $/; 
#        open(FILE,"head -20 $fn |");
#        my $data = <FILE>;
#        close FILE;
        open (FILE,$fn) or die("Cant open $fn\n");;
        my $data ; read(FILE,$data,2048);  ## ... linhas em branco ou pouco informativas
        close FILE;
        my $enc = guess_encoding($data,"utf8");
        if (!ref $enc) { return "iconv -f latin1 -t utf8"  }
        elsif ($enc->name eq "utf8"){ return "cat" }
        else {  return "iconv -f ".$enc->name." -t utf8"  }  ## assim tambem aceita UTF16
    }   
}

sub procfile{
	my $fn = shift;
	my $fp = shift;
	my $res;
	while (<$fp>){
		my @htags;
		my @hrefs;
		my @ltags;
		if (defined($t)){ save($htag,'{{{HTAG}}}',\@htags);}
		if (defined($l)){ save($href, '{{{HREF}}}', \@hrefs);}
		if (defined($L)){ save($ltag,'{{{LTAG}}}',\@ltags);}

		s/($w)/proc($1)/ge;

        last if ( $ptcount> 20 || $brcount > 20 and $f);
	
		restore('{{{HTAG}}}',\@htags);
		restore('{{{HREF}}}',\@hrefs);
		restore('{{{LTAG}}}',\@ltags);
	}
	print $fn."\t";
	if		(defined($v) || defined($vv)){ print "pt: $ptcount\tbr: $brcount\n";}
	elsif	($ptcount>$brcount)	{print "pt\n"; $res = 'pt'; }
	elsif	($ptcount<$brcount)	{print "br\n"; $res = 'br'; }
	else 						{print "?\n" ; $res = '?' ; }
	$ptcount=0; $brcount=0;
	return $res;
}
	
sub proc{
	my $p=shift;
	if (defined($pt{$p})) {
		if (defined($vv)){print "pt\t$p\n"}
		$ptcount++;}
	if (defined($br{$p})) {
		if (defined($vv)){print "br\t$p\n"}
		$brcount++;}
}
		

sub save{
	my $pattern = shift;
	my $replace = shift;
	my $list = shift;
	while (s/($pattern)/$replace/){	push(@$list, $1);}
}

sub restore{
	my $replace = shift;
	my $list = shift;
	while(@$list){
		my $temp = shift(@$list);
		s/$replace/$temp/;}
}

=encoding utf8

=head1 NAME

whichPT - Identificador da variante de portugues (Portugues Europeu ou Portugues Brasileiro).

=head1 SYNOPSIS

 whichPT [option] file > file2

=head1 DESCRIPTION

Faz a contagem das palavras Portugues Europeu e com Português Brasileiro
e decide a variante com base na diferença.

=head2 Options

B<-t> Nao contabiliza tags HTML

B<-l> Nao contabiliza  links HTML

B<-L> Nao contabiliza comandos LaTex

B<-v> Imprime o numero de palavras identificadas como pertencentes a cada uma das variantes.

B<-vv> Imprime as palavras que foram encontradas para cada variante.
		
B<-f> fast mode (leaves when counts > 20)

B<-suf> appends to each filename a .ptPT or .ptBR.
		Will skip file if already has .ptPT or .ptBR suffix.


=head1 AUTHOR

Andre F. Santos, andrefs@andrefs.com

J.Joao Almeida, jj@di.uminho.pt

=head1 SEE ALSO

jspell(1), perl(1)

=cut