File Coverage

blib/lib/Lingua/RU/Num2Word.pm

Criterion	Covered	Total	%
statement	67	70	95.7
branch	23	30	76.6
condition	18	26	69.2
subroutine	8	8	100.0
pod	1	1	100.0
total	117	135	86.6

package Lingua::RU::Num2Word;

use strict;
use warnings;
use utf8;
use POSIX qw/floor/;
use Carp qw/croak/;

# ABSTRACT: Numbers to words in russian (without currency, but with specified gender)
our $VERSION = '0.04'; # VERSION
# AUTHORITY

use Exporter qw/import/;
our @EXPORT_OK = qw(&num2rus_cardinal);

my %diw = (
    0 => {
        0  => { 0 => "ноль",                 1 => 1 },
        1  => { 0 => "",                         1 => 2 },
        2  => { 0 => "",                         1 => 3 },
        3  => { 0 => "три",                   1 => 0 },
        4  => { 0 => "четыре",             1 => 0 },
        5  => { 0 => "пять",                 1 => 1 },
        6  => { 0 => "шесть",               1 => 1 },
        7  => { 0 => "семь",                 1 => 1 },
        8  => { 0 => "восемь",             1 => 1 },
        9  => { 0 => "девять",             1 => 1 },
        10 => { 0 => "десять",             1 => 1 },
        11 => { 0 => "одинадцать",     1 => 1 },
        12 => { 0 => "двенадцать",     1 => 1 },
        13 => { 0 => "тринадцать",     1 => 1 },
        14 => { 0 => "четырнадцать", 1 => 1 },
        15 => { 0 => "пятнадцать",     1 => 1 },
        16 => { 0 => "шестнадцать",   1 => 1 },
        17 => { 0 => "семнадцать",     1 => 1 },
        18 => { 0 => "восемнадцать", 1 => 1 },
        19 => { 0 => "девятнадцать", 1 => 1 },
    },

    1 => {
        2 => { 0 => "двадцать",       1 => 1 },
        3 => { 0 => "тридцать",       1 => 1 },
        4 => { 0 => "сорок",             1 => 1 },
        5 => { 0 => "пятьдесят",     1 => 1 },
        6 => { 0 => "шестьдесят",   1 => 1 },
        7 => { 0 => "семьдесят",     1 => 1 },
        8 => { 0 => "восемьдесят", 1 => 1 },
        9 => { 0 => "девяносто",     1 => 1 },
    },
    2 => {
        1 => { 0 => "сто",             1 => 1 },
        2 => { 0 => "двести",       1 => 1 },
        3 => { 0 => "триста",       1 => 1 },
        4 => { 0 => "четыреста", 1 => 1 },
        5 => { 0 => "пятьсот",     1 => 1 },
        6 => { 0 => "шестьсот",   1 => 1 },
        7 => { 0 => "семьсот",     1 => 1 },
        8 => { 0 => "восемьсот", 1 => 1 },
        9 => { 0 => "девятьсот", 1 => 1 }
      }

);

my %nom = (
    0 => { 0 => "",             1 => "",           2 => "одна",              3 => "две" },
    1 => { 0 => "",             1 => "",           2 => "один",              3 => "два" },
    2 => { 0 => "тысячи", 1 => "тысяч", 2 => "одна тысяча", 3 => "две тысячи" },
    3 => {
        0 => "миллиона",
        1 => "миллионов",
        2 => "один миллион",
        3 => "два миллиона"
    },
    4 => {
        0 => "миллиарда",
        1 => "миллиардов",
        2 => "один миллиард",
        3 => "два миллиарда"
    },
    5 => {
        0 => "триллиона",
        1 => "триллионов",
        2 => "один триллион",
        3 => "два триллиона"
    }
);

my %genders = (
    'FEMININE' => { 0 => "", 1 => "", 2 => "одна", 3 => "две" },
    'MASCULINE' => { 0 => "", 1 => "", 2 => "один", 3 => "два" },
    'NEUTER' => { 0 => "", 1 => "", 2 => "одно", 3 => "два" },
);

# Stolen from Lingua::RU::Number


sub num2rus_cardinal {
    my ( $number, $gender ) = @_;

    # The biggest number we know about
    if ($number > 999_999_999_999_999 ) {
        return '';
    }

    $gender ||= 'MASCULINE';    # masculine by default
    croak "Wrong gender: $gender, should be MASCULINE|FEMININE|NEUTER" unless $gender =~ /masculine|feminine|neuter/i;
    $gender = uc $gender;

    return _get_string( 0, 0, 0 ) unless $number;    # no extra calculations for zero

    my ( $result, $negative );

    # Negative number, just add another word
    if ( $number < 0 ) {
        $number   = abs( $number );
        $negative = 1;
    }

    $result = "";
    my $int_number = floor( $number );              # no doubles

    for ( my $i = 1 ; $i < 6 && $int_number >= 1 ; $i++ ) {
        my $tmp_number = $int_number / 1000;
        my $number_part = sprintf( "%0.3f", $tmp_number - sprintf( "%d", $tmp_number ) ) * 1000;

        $int_number = floor $tmp_number;
        # no doubles again
        $result = _get_string( $number_part, $i, $gender ) . " " . $result;
    }

    # Clean the result
    $result =~ s/\s+/ /g;
    $result =~ s/\s+$//;

    if ( $negative ) {
        $result = "минус $result";
    }

    return $result;
}

sub _get_string {
    my $sum     = shift;
    return unless defined $sum;

    my $nominal = shift;
    my $gender  = shift;
    my ( $result, $nom ) = ( '', -1 );

    if ( ( !$nominal && $sum < 100 ) || ( $nominal > 0 && $nominal < 6 && $sum < 1000 ) ) {
        my $s2 = sprintf( "%d", $sum / 100 );

        if ( $s2 > 0 ) {    # hundreds
            $result .= ' ' . $diw{2}{$s2}{0};
            $nom = $diw{2}{$s2}{1};
        }

        my $sx = $sum - $s2 * 100;

        if ( ( $sx < 20 && $sx > 0 ) || ( $sx == 0 && !$nominal ) ) {
            $result .= " " . $diw{0}{$sx}{0};
            $nom = $diw{0}{$sx}{1};
        }
        else {
            my $s1 = floor $sx / 10;    # tens

            my $s0 = sprintf( "%d", $sum - $s2 * 100 - $s1 * 10 + 0.5 );

            if ( $s1 > 0 ) {
                $result .= ' ' . $diw{1}{$s1}{0};
                $nom = $diw{1}{$s1}{1};
            }
            if ( $s0 > 0 ) {
                $result .= ' ' . $diw{0}{$s0}{0};
                $nom = $diw{0}{$s0}{1};
            }
        }
    }

    if ( $nom >= 0 ) {

        if ( $nominal == 1 ) {
            $result .= defined $nominal ? ' ' . $genders{$gender}{$nom} : '';
        }
        else {
            $result .= defined $nominal ? ' ' . $nom{$nominal}{$nom} : '';
        }
    }
    $result =~ s/^\s*//g;
    $result =~ s/\s*$//g;

    return $result;
}

1;

__END__