#!/usr/bin/perl
#
# Скрипт для створення зворотніх форм дієслів з файлу афіксів
# Цей скрипт залежить від форматування файлу афіксів, навіть у коментарях
# Притримуйтесь, будь ласка, цього формату
#
# (c) Андрій Рисін, 2001, 2005
#
use strict;
use locale;
use utf8;
use encoding 'utf8';


my $UK_CAP	="'АБВГҐДЕЄЖЗИІЇЙКЛМНОПРСТУФХЦЧШЩЬЮЯ";
my $UK_LOW	="'абвгґдеєжзиіїйклмнопрстуфхцчшщьюя";

my $start = '0';
my $tmp;

my $section_header;
my $line_count;
my @lines;
    
my %SFX_REV = (
    A => "B", I => "J", K => "L", M => "N",
    G => "H", C => "D", E => "F"
);

# для слів, які мають і "-ся" і "-сь"
#my $GENERIC	="([аяийіїоуюв])|(те)";
my $GENERIC	="([аяийіїоуюв])|(те)";

print "# DO NOT EDIT!! Use bin/verb_reverse.pl instead to generate this file from ukrainian.aff.VERB!\n";
print "\n";

while(<>) {

    if( /^#/ ) {
	if( $start eq '1' ) {	# cutting off leading comments
	    push(@lines, $_);
	}
	next;
    }
    if( /^[\s]*$/ ) {
	push(@lines, $_);
	next;
    }
    
    $tmp = $_;
    $start = '1';
    $_ = $tmp;
    
# Заміна груп відповідними парами та зворотні інфінітиви

    if( /SFX\s[AIKMGCE]\s[YN]\s[0-9]+/ ) {
	my @SFX = split /\s+/, $_;
	my $sfx_rev = $SFX_REV{$SFX[1]};

	if( $line_count > 0 ) {
	    print "\n";
	    print $section_header, $line_count, "\n";
	
	    print @lines;
	}

	$section_header = $SFX[0] . ' ' . $sfx_rev . ' ' . $SFX[2] . ' ';
	@lines = ();
	$line_count = 0;
	
	if( $SFX[1] =~ /[AIKM]/ ) {
	    push(@lines, "# Зворотня форма дієслів (-ся та -сь)\n");
	    push(@lines, "SFX ", $sfx_rev, "   0\tся	ти		#  ~ти  ~тися\n");
	    push(@lines, "SFX ", $sfx_rev, "   0\tсь	ти		#  ~ти  ~ись\n");
	    push(@lines, "SFX ", $sfx_rev, "   ся	сь	тися		#  ~тися  ~ись\n");

	    $line_count += 3;
	}
	
	next;
    }

    if( /SFX\s[AIKMGCE]\s/ ) {

	my @LINE = split /\s+/, $_;
	my @LINE_COMMENT = split /#/, $_;
	my $comment = $LINE_COMMENT[1];
	my $sfx_rev = $SFX_REV{$LINE[1]};
	my $suffix_oldbody = $LINE[2];
	my $suffix_newbody = $LINE[3];
	my $suffix_match = $LINE[4];


# Створення правил для афіксів та прикладів

    # перші дві умови для спецвипадку "мести - мететься"
    if( ( !($suffix_oldbody =~ /^сти$/) || !($suffix_newbody =~ /^те$/)) 
            &&  ( !($suffix_oldbody =~ /^ти$/) || !($suffix_newbody =~ /^те$/) || !($suffix_match =~ /^ости$/)) 
            && $suffix_newbody =~ s/($GENERIC)$/$1сь/ ) {
	$comment =~ s/([^#\s]\s+[$UK_LOW]+$GENERIC)(\s)/$1сь$4/;

	push(@lines, $LINE[0]. " ". $sfx_rev. "   ". $suffix_oldbody. "\t". $suffix_newbody. "\t". $suffix_match. "\t\t#". $comment);
	push(@lines, $LINE[0]. " ". $sfx_rev. "   ". get_reversed($suffix_oldbody, $suffix_newbody, $suffix_match, $comment));

	$suffix_newbody =~ s/($GENERIC)сь$/$1ся/;
	$comment =~ s/([^#\s]\s+[$UK_LOW]+$GENERIC)сь(\s)/$1ся$4/;

	push(@lines, $LINE[0]. " ". $sfx_rev. "   ". $suffix_oldbody. "\t". $suffix_newbody. "\t". $suffix_match. "\t\t#". $comment);
	push(@lines, $LINE[0]. " ". $sfx_rev. "   ". get_reversed($suffix_oldbody, $suffix_newbody, $suffix_match, $comment));

	$line_count += 4;
    }
    else {
        if( $suffix_newbody =~ s/([еє])$/$1ться/ ) { # для слів, які мають тільки "-ться"
	    $comment =~ s/([^#\s]\s+[$UK_LOW]+)(\s)/$1ться$2/;
	}
	else {
	    if ( $suffix_newbody =~ s/([$UK_LOW])$/$1ся/ ) { # для слів, які мають тільки "-ся"
		$comment =~ s/([^#\s]\s+[$UK_LOW]+)(\s)/$1ся$2/;
	    }
	    else { # для слів, які не мали закінчень"
		$suffix_newbody =~ s/0/ся/;
		$comment =~ s/([^#\s]\s+[$UK_LOW]+)(\s)/$1ся$2/;
	    }
	}
	push(@lines, $LINE[0], " ", $sfx_rev, "   ", $suffix_oldbody, "\t", $suffix_newbody, "\t", $suffix_match, "\t\t#", $comment);
	push(@lines, $LINE[0], " ", $sfx_rev, "   ", get_reversed($suffix_oldbody, $suffix_newbody, $suffix_match, $comment));

	$line_count += 2;
    }

  }
     
}
	if( $line_count > 0 ) {
	    print "\n";
	    print $section_header, $line_count, "\n";
	
	    print @lines;
	}

# для слів що мають лише зворотню форму
# тобто для кожного напр. "вбити - вбитись ..." зробити додатково "вбитися - вбитись ..."
# suff_old, suff_new, suff_match, comment
sub get_reversed {
    my $suffix_oldbody = @_[0];
    my $suffix_newbody = @_[1];
    my $suffix_match = @_[2];
    my $comment = @_[3];
    
	if( $suffix_oldbody eq "0" ) {
	    $suffix_oldbody = "ся";
	}
	else {
	    $suffix_oldbody .= "ся";
	}
	$suffix_match .= "ся";
	$comment =~ s/^([\s]*[$UK_LOW]+ти)([\s]+)/$1ся$2/;
	
    return $suffix_oldbody . "\t" . $suffix_newbody . "\t" . $suffix_match . "\t\t#" . $comment;
}