#!/usr/bin/perl -CS

use utf8;
use warnings "all";
no warnings "experimental","qw";

use feature "state";

my $man_page = <<'EOF';
NAME
        tokro - LIMSI tokenizer for Romanian

SYNOPSIS
        tokro [-h|--help] [-r|--rev] [< input_file] [> output_file]
        tokro [-h|--help] [-r|--rev] input_file [> output_file]
        tokro [-h|--help] [-r|--rev] input_file output_file

DESCRIPTION
        Home-made tokenizer and detokenizer for the Romanian language, using specifications close to Dan Tufiș's RACAI tokenizer.

        For both files the format is one sentence per line, with space-separated tokens. Empty lines are not removed.

        -h, --help
                show this help (ignore input)

        -r, --rev
                reverse the process: tokenized input is detokenized

AUTHOR
        Written by Lauriane Aufrant.

LICENSING
        tokro is distributed under the GNU GPLv3 license, copyright Lauriane Aufrant, LIMSI.
EOF
#'

do {print $man_page; exit} if $ARGV[0] ~~ ['--help','-h'];
my $rev = 0;
if ($ARGV[0] ~~ ['--rev','-r']) {
    $rev = 1;
    shift;
}
if (@ARGV) {
    close(STDIN);
    open(STDIN, "<:encoding(UTF-8)", $ARGV[0]) or die "cannot read from $ARGV[0]: $!";
    shift;
}
if (@ARGV) {
    close(STDOUT);
    open(STDOUT, ">:encoding(UTF-8)", $ARGV[0]) or die "cannot write to $ARGV[0]: $!";
    shift;
}

my @proclitics = qw/a A așa Așa c C ce Ce dă de De dintr Dintr e E i I într Într l L le Le li m M mi Mi n N ne Ne ni O P PE prim Prim printr Printr s S și Și te ți v V vi VI/;
my @enclitics = qw/a A Aceasta Această alta am Am ar Ar Aș așa Așa au cu Cu i l L le Le li mă Mă mi Mi n ne Ne ni o O s se si și te ți tip va vă Vă Veți Voi/;
my @punctuations = qw/. , : ; ? ! " ' « » ‘ ’ ‚ ‛ “ ” „ ‟ ‹ › ( ) [ ] { } + - \//;
my $except = join "|", qw/^[A-Z]\. nr\. etc\. dvs\. a\.m\. p\.m\. d\.r\. prof\. D\.r\. Jr\. ș\.a\.m\.d\./;

sub affixes {
    my @tokens = split /-/, $_[0];
    if (@tokens == 2 && $_[0] !~ /într-adevăr/i) {
        return ("$tokens[0]-","$tokens[1]") if $tokens[0] ~~ @proclitics && $tokens[1];
        return ("$tokens[0]","-$tokens[1]") if $tokens[1] ~~ @enclitics && $tokens[0];
    }
    if (@tokens == 3) {
        return ("$tokens[0]","-$tokens[1]","-$tokens[2]") if $tokens[1] ~~ @enclitics && $tokens[2] ~~ @enclitics && $tokens[0];
    }
    return "$_[0]";
}

my @quotes = qw/" « » ‘ ’ ‚ ‛ “ ” „ ‟ ‹ ›/;
my $isquote = join "|", @quotes;

sub attach {
    my ($prev, $curr) = @_;

    state $left_quote = 0;
    $left_quote = 0 unless $prev;
    $left_quote = !$left_quote if $curr =~ /(${isquote})/;

    return 0 unless $prev;

    return 1 if $prev =~ /[^-]-$/;
    return 1 if $curr =~ /^-[^-]/;

    return 1 if $prev =~ /[(\[{\/]$/;
    return 1 if $curr =~ /^[\.,:;?!)\]}\+\/]/;

    return 1 if $prev =~ /'$/ && $curr =~ /^\d/;

    return 1 if $prev =~ /\d[:\.]$/ && $curr =~ /^\d\d/;

    return 1 if substr($prev, -1) ~~ @quotes && $left_quote;
    return 1 if $curr ~~ @quotes && !$left_quote;

    return 0;
}

sub tok_snt {
    my @tokens = ();
    for (split) {

        ### TOKENIZER ###
        if (!$rev) {
            tr#\N{U+15E}\N{U+15F}\N{U+162}\N{U+163}#\N{U+218}\N{U+219}\N{U+21A}\N{U+21B}#;
            s#,,#"#g;
            s#''#"#g;
            unless ($_) {
                push @tokens, "$_";
                next;
            }
            if (/^nr\./) {
                push @tokens, substr($_, 0, 3);
                $_ = substr($_, 3);
            }
            while (substr($_, 0, 1) ~~ @punctuations && !(/^-/ && substr($_, 1) ~~ @enclitics)) {
                if (/^\.\.\./) {
                    push @tokens, substr($_, 0, 3);
                    $_ = substr($_, 3);
                    next;
                }
                if (/^--/) {
                    push @tokens, substr($_, 0, 2);
                    $_ = substr($_, 2);
                    next;
                }
                push @tokens, substr($_, 0, 1);
                $_ = substr($_, 1);
            }
            my @tail = ();
            while (substr($_, -1, 1) ~~ @punctuations && !(/-$/ && substr($_, 0, (length $_) - 1) ~~ @proclitics) && $_ !~ /(${except})$/) {
                if (/\.\.\.$/) {
                    unshift @tail, substr($_, -3, 3);
                    $_ = substr($_, 0, (length $_) - 3);
                    next;
                }
                unshift @tail, substr($_, -1, 1);
                $_ = substr($_, 0, (length $_) - 1);
            }
            if (/:\/\//) {
                push @tokens, affixes($_);
            } else {
                push @tokens, (map { affixes($_) } grep { length $_ } split(/(\/|(?<!\d),(?!\d)|(?<!\d):(?!\d))/));
            }
            push @tokens, @tail;
        }

        ### DETOKENIZER ###
        else {
            if (@tokens > 2 && $tokens[-1] eq "'" && $_ !~ /^\d/) {
                $tokens[-2] .= pop @tokens;
            }
            if (attach(@tokens ? $tokens[-1] : undef, $_)) {
                $tokens[-1] .= $_;
                next;
            }
            push @tokens, $_;
        }
    }
    return @tokens;
}

my $count;
while(<STDIN>) {
    chomp;
    print STDOUT (join ' ', tok_snt(split));
    print STDOUT "\n";
    $count++;
    print STDERR "$count..." unless $count % 10000;
    print STDERR "\n" unless $count % 100000;
}

print STDERR "$count sentences processed.\n";

close(STDOUT);
close(STDIN);