#-*-perl-*-

package Uplug::PreProcess::Tokenizer;

=head1 NAME

Uplug::PreProcess::Tokenizer

=head1 IMPLEMENTS

=head2 C<tokenize>

=head2 C<load_prefixes>

=cut

use strict;


use Uplug::Config;

# defaults: language = English

our $DEFAULT_LANG = 'en';

our %NONBREAKING_PREFIX;
our $NONBREAKING_PREFIX_DIR     = &shared_lang() . '/nonbreaking_prefixes';
our $DEFAULT_NONBREAKING_PREFIX = $NONBREAKING_PREFIX_DIR . '/nonbreaking_prefix.en';


sub new {
    my $class = shift;
    my %self  = @_;

    if ( $self{lang} ) {
        load_prefixes( $self{lang}, \%NONBREAKING_PREFIX );
    }

    return bless \%self, $class;
}


sub tokenize {
    my $self = shift;

    my ($text) = @_;
    chomp($text);
    $text = " $text ";

    # seperate out all "other" special characters
    $text =~ s/([^\p{IsAlnum}\s\.\'\`\,\-])/ $1 /g; #`

    #multi-dots stay together
    $text =~ s/\.([\.]+)/ DOTMULTI$1/g;
    while ( $text =~ /DOTMULTI\./ ) {
        $text =~ s/DOTMULTI\.([^\.])/DOTDOTMULTI $1/g;
        $text =~ s/DOTMULTI\./DOTDOTMULTI/g;
    }

    # seperate out "," except if within numbers (5,300)
    $text =~ s/([^\p{IsN}])[,]([^\p{IsN}])/$1 , $2/g;

    # separate , pre and post number
    $text =~ s/([\p{IsN}])[,]([^\p{IsN}])/$1 , $2/g;
    $text =~ s/([^\p{IsN}])[,]([\p{IsN}])/$1 , $2/g;

    # turn `into '
    $text =~ s/\`/\'/g; #`

    #turn '' into "
    $text =~ s/\'\'/ \" /g;

    if ( $$self{lang} eq "en" ) {
        #split contractions right
        $text =~ s/([^\p{IsAlpha}])[']([^\p{IsAlpha}])/$1 ' $2/g;
        $text =~ s/([^\p{IsAlpha}\p{IsN}])[']([\p{IsAlpha}])/$1 ' $2/g;
        $text =~ s/([\p{IsAlpha}])[']([^\p{IsAlpha}])/$1 ' $2/g;
        $text =~ s/([\p{IsAlpha}])[']([\p{IsAlpha}])/$1 '$2/g;

        #special case for "1990's"
        $text =~ s/([\p{IsN}])[']([s])/$1 '$2/g;
    }
    elsif ( ( $$self{lang} eq "fr" ) or ( $$self{lang} eq "it" ) ) {
        #split contractions left
        $text =~ s/([^\p{IsAlpha}])[']([^\p{IsAlpha}])/$1 ' $2/g;
        $text =~ s/([^\p{IsAlpha}])[']([\p{IsAlpha}])/$1 ' $2/g;
        $text =~ s/([\p{IsAlpha}])[']([^\p{IsAlpha}])/$1 ' $2/g;
        $text =~ s/([\p{IsAlpha}])[']([\p{IsAlpha}])/$1' $2/g;
    }
    else {
        $text =~ s/\'/ \' /g;
    }

    #word token method
    my @words = split( /\s/, $text );
    $text = "";
    for ( my $i = 0; $i < ( scalar(@words) ); $i++ ) {
        my $word = $words[$i];
        if ( $word =~ /^(\S+)\.$/ ) {
            my $pre = $1;
            if (( $pre =~ /\./ && $pre =~ /\p{IsAlpha}/ )
                || (   $NONBREAKING_PREFIX{$pre}
                    && $NONBREAKING_PREFIX{$pre} == 1 )
                || ( $i < scalar(@words) - 1
                    && ( $words[ $i + 1 ] =~ /^[\p{IsLower}]/ ) ) )
            {
                #no change
            }
            elsif (
                (      $NONBREAKING_PREFIX{$pre}
                    && $NONBREAKING_PREFIX{$pre} == 2
                )
                && ( $i < scalar(@words) - 1
                    && ( $words[ $i + 1 ] =~ /^[0-9]+/ ) ) )
            {
                #no change
            }
            else {
                $word = $pre . " .";
            }
        }
        $text .= $word . " ";
    }

    # clean up extraneous spaces
    $text =~ s/ +/ /g;
    $text =~ s/^ //g;
    $text =~ s/ $//g;

    #restore multi-dots
    while ( $text =~ /DOTDOTMULTI/ ) {
        $text =~ s/DOTDOTMULTI/DOTMULTI./g;
    }
    $text =~ s/DOTMULTI/./g;

    #ensure final line break
    $text .= "\n" unless $text =~ /\n$/;
    return split( /\s+/, $text );
}


sub load_prefixes {
    my ( $language, $PREFIX_REF ) = @_;

    my $prefixfile
        = $NONBREAKING_PREFIX_DIR . '/nonbreaking_prefix.' . $language;

    #default back to English if we don't have a language-specific prefix file
    if ( !( -e $prefixfile ) ) {
        $prefixfile = $DEFAULT_NONBREAKING_PREFIX;
        unless ( -e $prefixfile ) {
            return 0;
        }
    }

    if ( -e "$prefixfile" ) {
        open( PREFIX, "<:encoding(utf8)", "$prefixfile" );
        while (<PREFIX>) {
            my $item = $_;
            chomp($item);
            if ( ($item) && ( substr( $item, 0, 1 ) ne "#" ) ) {
                if ( $item =~ /(.*)[\s]+(\#NUMERIC_ONLY\#)/ ) {
                    $PREFIX_REF->{$1} = 2;
                }
                else {
                    $PREFIX_REF->{$item} = 1;
                }
            }
        }
        close(PREFIX);
    }
}


# this is the Moses detokenizer
# written by Josh Schroeder, based on code by Philipp Koehn

sub detokenize {
    my $self  = shift;
    my $token = shift;

    my $text = ref($token) eq 'ARRAY' ? join( ' ', @$token ) : $token;
    my $language = $self->{-lang} || 'en';

    #    chomp($text);
    $text =~ s/\n/ /gs;
    $text =~ s/\s\s+/ /gs;
    $text = " $text ";

    my $word;
    my $i;
    my @words = split( / /, $text );
    $text = "";
    my %quoteCount = ( "\'" => 0, "\"" => 0 );
    my $prependSpace = " ";
    for ( $i = 0; $i < ( scalar(@words) ); $i++ ) {
        if ( $words[$i] =~ /^[\p{IsSc}\(\[\{\¿\¡]+$/ ) {
            # perform right shift on currency and other random punctuation items
            $text         = $text . $prependSpace . $words[$i];
            $prependSpace = "";
        }
        elsif ( $words[$i] =~ /^[\,\.\?\!\:\;\\\%\}\]\)]+$/ ) {
            # perform left shift on punctuation items
            $text         = $text . $words[$i];
            $prependSpace = " ";
        }
        elsif (( $language eq "en" )
            && ( $i > 0 )
            && ( $words[$i] =~ /^[\'][\p{IsAlpha}]/ )
            && ( $words[ $i - 1 ] =~ /[\p{IsAlnum}]$/ ) )
        {
            # left-shift the contraction for English
            $text         = $text . $words[$i];
            $prependSpace = " ";
        }
        elsif (( $language eq "fr" )
            && ( $i < ( scalar(@words) - 2 ) )
            && ( $words[$i] =~ /[\p{IsAlpha}][\']$/ )
            && ( $words[ $i + 1 ] =~ /^[\p{IsAlpha}]/ ) )
        {
            # right-shift the contraction for French
            $text         = $text . $prependSpace . $words[$i];
            $prependSpace = "";
        }
        elsif ( $words[$i] =~ /^[\'\"]+$/ ) {
            # combine punctuation smartly
            if ( ( $quoteCount{ $words[$i] } % 2 ) eq 0 ) {
                if (   ( $language eq "en" )
                    && ( $words[$i] eq "'" )
                    && ( $i > 0 )
                    && ( $words[ $i - 1 ] =~ /[s]$/ ) )
                {
                   # single quote for posesssives ending in s... "The Jones' house"
                   # left shift
                    $text         = $text . $words[$i];
                    $prependSpace = " ";
                }
                else {
                    # right shift
                    $text         = $text . $prependSpace . $words[$i];
                    $prependSpace = "";
                    $quoteCount{ $words[$i] } = $quoteCount{ $words[$i] } + 1;
                }
            }
            else {
                # left shift
                $text                     = $text . $words[$i];
                $prependSpace             = " ";
                $quoteCount{ $words[$i] } = $quoteCount{ $words[$i] } + 1;
            }
        }
        else {
            $text         = $text . $prependSpace . $words[$i];
            $prependSpace = " ";
        }
    }

    # clean up spaces at head and tail of each line as well as any double-spacing
    $text =~ s/ +/ /g;
    $text =~ s/\n /\n/g;
    $text =~ s/ \n/\n/g;
    $text =~ s/^ //g;
    $text =~ s/ $//g;

    # add trailing break
    #$text .= "\n" unless $text =~ /\n$/;

    return $text;
}


1;

