
package RENA;

use warnings;
use strict;
use locale;

require Exporter;
our @ISA = qw(Exporter);

our $VERSION = '0.1';

## perEntity => &func
## perText => &func
## perChunk => &func
## text => $string

sub process {
    my $self = shift;

    my %options = @_;

    my $perChunk = $options{perChunk};
    my $perEntity = $options{perEntity};
    my $perText = $options{perText};

    my $m = "\x01";
    my $m_ = "\x02";
    my $n = "\x03";

    die "Can't process entities without text.\n" if not defined $options{text};
    my $text = "$m$options{text}$m";

    # Marca os candidatos a entidades -- "$m$m_Entidade$m_$m"
    $text =~ s/($self->{ent})/$m$m_$1$m_$m/sg;
    # Marca as marcas (!) quando estas estão no ínicio do texto a processar
    # ou são precedidas de pontuação -- "$m$n(Entidade)$m"
    # XXX documentar melhor estas expressões
    # XXX escape de [ ] correcto ?
    $text =~ s/^($m\s*[${\ '"\'«(\['}]?\s*)$m$m_/$1$m$n$m_/sg;
    $text =~ s/((?:[-:·.?!)\]]\s*[${\ '"\'«»()\[\]'}]?|:\s*\")\s*)$m$m_/$1$m$n$m_/sg;
    
    while ($text =~ /($m$n?$m_(.*?)$m_$m)|($m(.*?)$m)/smg) {
	if (defined($1) and (defined($perEntity) or defined($perChunk))) {
	    my $marcacao = $1;
	    my $entidade = $2;
	    if (defined($perChunk)) {
		&{$perChunk} (type => "entity",
			      text => $entidade,
			      ($marcacao =~ /$n/) ? (beginning =>  1) : ());
	    } else {
		&{$perEntity} ($entidade, $marcacao =~ /$n/);
	    }
	} elsif (defined($3)) {
	    if (defined($perChunk)) {
		&{$perChunk} (type => "raw",
			     text => $4);
	    } elsif (defined($perText)) {
		&{$perText} ($4);
	    }
	} else {
	    die "Uh?"; # XXX isto não pode acontecer ...
	}
	pos($text) = pos($text) - 1;
    }
}

sub new {
    my $proto = shift || __PACKAGE__;
    my $class = ref($proto) || $proto;

    my $abrev1 = q![[:upper:]]\.!;
    my $parte = q![[:upper:]][[:alpha:]\-\']*!;
    my $ent = qr{\b(?:(?:(?:$parte\s+)|(?:$abrev1\s*))(?:d[eao]s?\s+)?)*(?:(?:$parte)|(?:$abrev1))(?:\s*\d+(?=\b))?};

    my $self = { ent =>  $ent };
    bless($self, $proto);

    return $self;
}

1;

__END__

=head1 NAME

RENA - Named Entity Extraction for portuguese texts

=head1 SYNOPSIS

  use RENA;

  sub myCallback {
      my $b = $_[1] ? " (begin)" : "";
      print "ENTITY$b: '$_[0]'\n";
  }

  my $ne = new RENA;
  while (<>) {
    $ne->process(text => $_, perEntity => \&myCallback);
  }

=head1 DESCRIPTION

=head1 Data Tables

In order to tune RENA, you can change:

  data/contextos

To define the set of contexts and conclude the classes associated. Examples

  concelho (de do da) => concelho/90
  (tio tia avó avô) => pessoa/80
  (futebolista avançado treinador árbitro) => atleta !lctx
  (S. Santo Santa) => santo !entname


Table of translations Common-word -- Identifier:

  data/gaztable.yaml


Set of entities to be ignored:

  data/ignore

Names gazetteer -- common names and surnames to be used in name recognition:

  data/names_gazetteer

Gazetteer of geography, entities, etc.:

  data/thesaurus

Class hierarchy:

  data/tree.yaml

=head1 AUTHOR

=head1 COPYRIGHT AND LICENSE

=cut
