our
$VERSION
=
'0.04'
;
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
=>
"два"
},
);
sub
num2rus_cardinal {
my
(
$number
,
$gender
) =
@_
;
if
(
$number
> 999_999_999_999_999 ) {
return
''
;
}
$gender
||=
'MASCULINE'
;
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
;
my
(
$result
,
$negative
);
if
(
$number
< 0 ) {
$number
=
abs
(
$number
);
$negative
= 1;
}
$result
=
""
;
my
$int_number
= floor(
$number
);
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
;
$result
= _get_string(
$number_part
,
$i
,
$gender
) .
" "
.
$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 ) {
$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;
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;