File Coverage

blib/lib/Lingua/RU/Number.pm
Criterion Covered Total %
statement 54 54 100.0
branch 21 26 80.7
condition 13 24 54.1
subroutine 5 5 100.0
pod 0 2 0.0
total 93 111 83.7


line stmt bran cond sub pod time code
1             package Lingua::RU::Number;
2              
3 1     1   775 use strict;
  1         2  
  1         42  
4 1     1   6 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  1         1  
  1         134  
5              
6             require Exporter;
7             require AutoLoader;
8              
9             @ISA = qw(Exporter AutoLoader);
10             # Items to export into callers namespace by default. Note: do not export
11             # names by default without a very good reason. Use EXPORT_OK instead.
12             # Do not simply export all your public functions/methods/constants.
13             @EXPORT = qw();
14             @EXPORT_OK = qw(rur_in_words);
15              
16             $VERSION = '0.05';
17              
18             # Preloaded methods go here.
19 1     1   6 use vars qw(%diw %nom);
  1         6  
  1         1698  
20              
21             %diw = (
22             0 => {
23             0 => { 0 => "ноль", 1 => 1},
24             1 => { 0 => "", 1 => 2},
25             2 => { 0 => "", 1 => 3},
26             3 => { 0 => "три", 1 => 0},
27             4 => { 0 => "четыре", 1 => 0},
28             5 => { 0 => "пять", 1 => 1},
29             6 => { 0 => "шесть", 1 => 1},
30             7 => { 0 => "семь", 1 => 1},
31             8 => { 0 => "восемь", 1 => 1},
32             9 => { 0 => "девять", 1 => 1},
33             10 => { 0 => "десять", 1 => 1},
34             11 => { 0 => "одиннадцать", 1 => 1},
35             12 => { 0 => "двенадцать", 1 => 1},
36             13 => { 0 => "тринадцать", 1 => 1},
37             14 => { 0 => "четырнадцать", 1 => 1},
38             15 => { 0 => "пятнадцать", 1 => 1},
39             16 => { 0 => "шестнадцать", 1 => 1},
40             17 => { 0 => "семнадцать", 1 => 1},
41             18 => { 0 => "восемнадцать", 1 => 1},
42             19 => { 0 => "девятнадцать", 1 => 1},
43             },
44             1 => {
45             2 => { 0 => "двадцать", 1 => 1},
46             3 => { 0 => "тридцать", 1 => 1},
47             4 => { 0 => "сорок", 1 => 1},
48             5 => { 0 => "пятьдесят", 1 => 1},
49             6 => { 0 => "шестьдесят", 1 => 1},
50             7 => { 0 => "семьдесят", 1 => 1},
51             8 => { 0 => "восемьдесят", 1 => 1},
52             9 => { 0 => "девяносто", 1 => 1},
53             },
54             2 => {
55             1 => { 0 => "сто", 1 => 1},
56             2 => { 0 => "двести", 1 => 1},
57             3 => { 0 => "триста", 1 => 1},
58             4 => { 0 => "четыреста", 1 => 1},
59             5 => { 0 => "пятьсот", 1 => 1},
60             6 => { 0 => "шестьсот", 1 => 1},
61             7 => { 0 => "семьсот", 1 => 1},
62             8 => { 0 => "восемьсот", 1 => 1},
63             9 => { 0 => "девятьсот", 1 => 1}
64             }
65             );
66              
67             %nom = (
68             0 => {0 => "копейки", 1 => "копеек", 2 => "одна копейка", 3 => "две копейки"},
69             1 => {0 => "рубля", 1 => "рублей", 2 => "один рубль", 3 => "два рубля"},
70             2 => {0 => "тысячи", 1 => "тысяч", 2 => "одна тысяча", 3 => "две тысячи"},
71             3 => {0 => "миллиона", 1 => "миллионов", 2 => "один миллион", 3 => "два миллиона"},
72             4 => {0 => "миллиарда",1 => "миллиардов",2 => "один миллиард",3 => "два миллиарда"},
73             5 => {0 => "триллиона",1 => "триллионов",2 => "один триллион",3 => "два триллиона"}
74             );
75              
76             my $out_rub;
77              
78             sub rur_in_words
79             {
80 5     5 0 204 my ($sum) = shift;
81 5         8 my ($retval, $i, $sum_rub, $sum_kop);
82              
83 5         8 $retval = "";
84 5 50       15 $out_rub = ($sum >= 1) ? 0 : 1;
85 5         40 $sum_rub = sprintf("%0.0f", $sum);
86 5 100       23 $sum_rub-- if (($sum_rub - $sum) > 0);
87 5         24 $sum_kop = sprintf("%0.2f",($sum - $sum_rub))*100;
88              
89 5         102 my $kop = get_string($sum_kop, 0);
90              
91 5   66     31 for ($i=1; $i<6 && $sum_rub >= 1; $i++) {
92 6         10 my $sum_tmp = $sum_rub/1000;
93 6         33 my $sum_part = sprintf("%0.3f", $sum_tmp - int($sum_tmp))*1000;
94 6         22 $sum_rub = sprintf("%0.0f",$sum_tmp);
95              
96 6 100       20 $sum_rub-- if ($sum_rub - $sum_tmp > 0);
97 6         15 $retval = get_string($sum_part, $i)." ".$retval;
98             }
99 5 50       12 $retval .= " рублей" if ($out_rub == 0);
100 5         9 $retval .= " ".$kop;
101 5         44 $retval =~ s/\s+/ /g;
102 5         15 return $retval;
103             }
104              
105             sub get_string
106             {
107 11     11 0 20 my ($sum, $nominal) = @_;
108 11         15 my ($retval, $nom) = ('', -1);
109              
110 11 50 66     94 if (($nominal == 0 && $sum < 100) || ($nominal > 0 && $nominal < 6 && $sum < 1000)) {
      33        
      33        
      66        
111 11         26 my $s2 = int($sum/100);
112 11 100       23 if ($s2 > 0) {
113 1         15 $retval .= " ".$diw{2}{$s2}{0};
114 1         3 $nom = $diw{2}{$s2}{1};
115             }
116 11         50 my $sx = sprintf("%0.0f", $sum - $s2*100);
117 11 100       33 $sx-- if ($sx - ($sum - $s2*100) > 0);
118              
119 11 100 66     68 if (($sx<20 && $sx>0) || ($sx == 0 && $nominal == 0)) {
      33        
      66        
120 5         18 $retval .= " ".$diw{0}{$sx}{0};
121 5         12 $nom = $diw{0}{$sx}{1};
122             } else {
123 6         22 my $s1 = sprintf("%0.0f",$sx/10);
124 6 100       22 $s1-- if (($s1 - $sx/10) > 0);
125 6         21 my $s0 = int($sum - $s2*100 - $s1*10 + 0.5);
126 6 50       17 if ($s1 > 0) {
127 6         37 $retval .= " ".$diw{1}{$s1}{0};
128 6         15 $nom = $diw{1}{$s1}{1};
129             }
130 6 100       18 if ($s0 > 0) {
131 5         19 $retval .= " ".$diw{0}{$s0}{0};
132 5         12 $nom = $diw{0}{$s0}{1};
133             }
134             }
135             }
136 11 50       27 if ($nom >= 0) {
137 11         29 $retval .= " ".$nom{$nominal}{$nom};
138 11 100       27 $out_rub = 1 if ($nominal == 1);
139             }
140 11         57 $retval =~ s/^\s*//g;
141 11         83 $retval =~ s/\s*$//g;
142              
143 11         55 return $retval;
144             }
145              
146             # Autoload methods go after =cut, and are processed by the autosplit program.
147              
148             1;
149             __END__