File Coverage

blib/lib/Lingua/Stem/UniNE/BG.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	34	36	94.4
condition	17	18	94.4
subroutine	11	11	100.0
pod	0	3	0.0
total	123	129	95.3

package Lingua::Stem::UniNE::BG;

use v5.8.1;
use utf8;
use strict;
use warnings;
use parent 'Exporter';
use Unicode::CaseFold qw( fc );
use Unicode::Normalize qw( NFC );

our $VERSION   = '0.08';
our @EXPORT_OK = qw( stem stem_bg );

*stem_bg = \&stem;

sub stem {
    my ($word) = @_;

    $word = NFC fc $word;

    my $length = length $word;

    return $word
        if $length < 4;

    if ($length > 5) {
        return $word
            if $word =~ s{ ища $}{}x;
    }

    $word = remove_article($word);
    $word = remove_plural($word);
    $length = length $word;

    if ($length > 3) {
        $word =~ s{ я $}{}x;  # masculine

        # normalization (e.g., -а could be a definite article or plural form)
        $word =~ s{ [аео] $}{}x;

        $length = length $word;
    }

    if ($length > 4) {
        $word =~ s{ е (?= н $) }{}x;  # -ен → -н

        $length = length $word;
    }

    if ($length > 5) {
        $word =~ s{ ъ (?= \p{Cyrl} $) }{}x;  # -ъ� → -�
    }

    return $word;
}

sub remove_article {
    my ($word) = @_;
    my $length = length $word;

    if ($length > 6) {
        # definite article with adjectives and masculine
        return $word
            if $word =~ s{ ият $}{}x;
    }

    if ($length > 5) {
        return $word
            if $word =~ s{ (?:
                  ия  # definite articles for nouns:
                | ът  # ∙ masculine
                | та  # ∙ feminine
                | то  # ∙ neutral
                | те  # ∙ plural
            ) $}{}x;
    }

    if ($length > 4) {
        return $word
            if $word =~ s{ ят $}{}x;  # article for masculine
    }

    return $word;
}

sub remove_plural {
    my ($word) = @_;
    my $length = length $word;

    # specific plural rules for some words (masculine)
    if ($length > 6) {
        return $word
            if $word =~ s{ ове  $}{}x
            || $word =~ s{ еве  $}{й}x
            || $word =~ s{ овци $}{о}x;
    }

    if ($length > 5) {
        return $word
            if $word =~ s{ зи               $}{г}x
            || $word =~ s{ е ( \p{Cyrl} ) и $}{я$1}x  # -е�и → -я�
            || $word =~ s{ ци               $}{к}x
            || $word =~ s{ (?: та | ища )   $}{}x;
    }

    if ($length > 4) {
        return $word
            if $word =~ s{ си $}{х}x
            || $word =~ s{ и  $}{}x;  # plural for various nouns and adjectives
    }

    return $word;
}

1;

__END__