File Coverage

blib/lib/Lingua/RUS/Word2Num.pm

Criterion	Covered	Total	%
statement	32	42	76.1
branch	0	4	0.0
condition	2	28	7.1
subroutine	10	11	90.9
pod	3	3	100.0
total	47	88	53.4

# For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8 -*-

package Lingua::RUS::Word2Num;
# ABSTRACT: Word to number conversion in Russian

use 5.16.0;
use utf8;
use warnings;

# {{{ use block

use Export::Attrs;
use Carp;
use Parse::RecDescent;

# }}}
# {{{ variable declarations
our $VERSION = '0.2603300';
my  $parser  = ru_numerals();

# }}}

# {{{ w2n                                         convert text to number

sub w2n :Export {
    my $input = shift // return;

    $input .= " ";                             # Grant end space before normalizing

    $input =~ s/тысячи /тысяч /g;              # Thousand variations. Normalize to тысяч
    $input =~ s/тысячa /тысяч /g;
    $input =~ s/тысяча /тысяч /g;

    $input =~ s/миллиона /миллион /g;          # Million variations. Normalize to миллион
    $input =~ s/миллионов /миллион /g;

    return $parser->numeral($input);
}

# }}}
# {{{ ru_numerals                                 create parser for numerals

sub ru_numerals {
    return Parse::RecDescent->new(q{
      numeral:
      numeral: million   { return $item[1]; }                         # root parse. go from maximum to minimum value
        |      millenium { return $item[1]; }
        |      century   { return $item[1]; }
        |      decade    { return $item[1]; }
        |                { return undef; }

      number: 'девятнадцать ' { $return = 19; }                       # try to find a word from 0 to 19
        |     'восемнадцать ' { $return = 18; }
        |     'семнадцать '   { $return = 17; }
        |     'шестнадцать '  { $return = 16; }
        |     'пятнадцать '   { $return = 15; }
        |     'четырнадцать ' { $return = 14; }
        |     'тринадцать '   { $return = 13; }
        |     'двенадцать '   { $return = 12; }
        |     'одинадцать '   { $return = 11; }
        |     'десять '       { $return = 10; }
        |     'девять '       { $return = 9; }
        |     'восемь '       { $return = 8; }
        |     'семь '         { $return = 7; }
        |     'шесть '        { $return = 6; }
        |     'пять '         { $return = 5; }
        |     'четыре '       { $return = 4; }
        |     'три '          { $return = 3; }
        |     'два '          { $return = 2; }
        |     'две '          { $return = 2; }
        |     'одна '         { $return = 1; }
        |     'один '         { $return = 1; }
        |     'ноль '         { $return = 0; }

      tens:   'двадцать '    { $return = 20; }                        # try to find a word that represents
        |     'тридцать '    { $return = 30; }                        # values 20,30,..,90
        |     'сорок '       { $return = 40; }
        |     'пятьдесят '   { $return = 50; }
        |     'шестьдесят '  { $return = 60; }
        |     'семьдесят '   { $return = 70; }
        |     'восемьдесят ' { $return = 80; }
        |     'девяносто '   { $return = 90; }

     hundreds: 'сто '       { $return = 100; }                        # try to find a word that represents
        |      'сотня '     { $return = 100; }                        # values 200,300,..,900
        |      'двести '    { $return = 200; }
        |      'триста '    { $return = 300; }
        |      'четыреста ' { $return = 400; }
        |      'пятьсот '   { $return = 500; }
        |      'шестьсот '  { $return = 600; }
        |      'семьсот '   { $return = 700; }
        |      'восемьсот ' { $return = 800; }
        |      'девятьсот ' { $return = 900; }

      decade: tens(?) number(?)                                       # try to find words that represents values
              { $return = -1;                                         # from 0 to 99
                for (@item) {
                  if (ref $_ && defined $$_[0]) {
                    $return += $$_[0] if ($return != -1);
                    $return  = $$_[0] if ($return == -1);
                  }
                }
                $return = undef if ($return == -1);
              }

      century: hundreds(?) decade(?)                                  # try to find words that represents values
               { $return = 0;                                         # from 100 to 999
                 for (@item) {
                   $return += $$_[0] if (ref $_ && defined $$_[0]);
                 }
                 $return ||= undef;
               }

    millenium: century(?) decade(?) 'тысяч ' century(?) decade(?)      # try to find words that represents values
               { $return = 0;                                          # from 1.000 to 999.999
                 for (@item) {
                   if (ref $_ && defined $$_[0]) {
                     $return += $$_[0];
                   } elsif ($_ eq "тысяч ") {
                     $return = ($return>0) ? $return * 1000 : 1000;
                   }
                 }
                 $return ||= undef;
               }

      million: century(?) decade(?)                                   # try to find words that represents values
              'миллион '                                              # from 1.000.000 to 999.999.999
               millenium(?) century(?) decade(?)
               { $return = 0;
                 for (@item) {
                   if (ref $_ && defined $$_[0]) {
                     $return += $$_[0];
                   } elsif ($_ eq "миллион ") {
                     $return = ($return>0) ? $return * 1000000 : 1000000;
                   }
                 }
                 $return ||= undef;
               }
    });
}

# }}}
# {{{ ordinal2cardinal             convert ordinal text to cardinal text

sub ordinal2cardinal :Export {
    my $input = shift // return;

    # Russian (Cyrillic) ordinals: strip gender/case suffixes, then map stems.
    # Inflection: -ый/-ой/-ий/-ая/-ое/-ого/-ому/-ым/-ом.

    my %irregular = (
        'нулевой'         => 'ноль',
        'первый'          => 'один',
        'второй'          => 'два',
        'третий'          => 'три',
        'четвёртый'       => 'четыре',
        'пятый'           => 'пять',
        'шестой'          => 'шесть',
        'седьмой'         => 'семь',
        'восьмой'         => 'восемь',
        'девятый'         => 'девять',
        'десятый'         => 'десять',
        'одиннадцатый'    => 'одинадцать',
        'двенадцатый'     => 'двенадцать',
        'тринадцатый'     => 'тринадцать',
        'четырнадцатый'   => 'четырнадцать',
        'пятнадцатый'     => 'пятнадцать',
        'шестнадцатый'    => 'шестнадцать',
        'семнадцатый'     => 'семнадцать',
        'восемнадцатый'   => 'восемнадцать',
        'девятнадцатый'   => 'девятнадцать',
        'двадцатый'       => 'двадцать',
        'тридцатый'       => 'тридцать',
        'сороковой'       => 'сорок',
        'пятидесятый'     => 'пятьдесят',
        'шестидесятый'    => 'шестьдесят',
        'семидесятый'     => 'семьдесят',
        'восьмидесятый'   => 'восемьдесят',
        'девяностый'      => 'девяносто',
        'сотый'           => 'сто',
        'двухсотый'       => 'двести',
        'трёхсотый'       => 'триста',
        'четырёхсотый'    => 'четыреста',
        'пятисотый'       => 'пятьсот',
        'шестисотый'      => 'шестьсот',
        'семисотый'       => 'семьсот',
        'восьмисотый'     => 'восемьсот',
        'девятисотый'     => 'девятьсот',
        'тысячный'        => 'тысяч',
        'миллионный'      => 'миллион',
    );

    # Normalize gender/case to masculine nominative
    my $norm = $input;
    $norm =~ s{(и)его\z}{$1й}xms      # третьего → третий
        or $norm =~ s{ого\z}{ый}xms    # пятого → пятый
        or $norm =~ s{ому\z}{ый}xms    # пятому → пятый
        or $norm =~ s{ым\z}{ый}xms     # пятым → пятый
        or $norm =~ s{ом\z}{ой}xms     # шестом → шестой
        or $norm =~ s{ая\z}{ый}xms     # пятая → пятый
        or $norm =~ s{яя\z}{ий}xms     # третья → третий (gen fem → masc)
        or $norm =~ s{ое\z}{ый}xms     # пятое → пятый
        or $norm =~ s{ее\z}{ий}xms     # третье → третий
        or $norm =~ s{ей\z}{ий}xms;    # третьей → третий

    # Handle -ой endings that should stay as -ой (второй, шестой, седьмой, восьмой)
    # They already match as-is in the hash.

    # Compound ordinal: only last word is ordinal
    my @words = split /\s+/, $norm;
    my $last  = pop @words;

    if (exists $irregular{$last}) {
        push @words, $irregular{$last};
        return join ' ', @words;
    }

    return;  # not a recognized ordinal
}

# }}}

1;

__END__