File Coverage

blib/lib/Lingua/LAV/Num2Word.pm
Criterion Covered Total %
statement 25 121 20.6
branch 2 66 3.0
condition 3 51 5.8
subroutine 8 12 66.6
pod 3 3 100.0
total 41 253 16.2


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; mode:folding; coding:utf-8; -*-
2              
3             package Lingua::LAV::Num2Word;
4             # ABSTRACT: Number to word conversion in Latvian
5              
6 1     1   87343 use 5.16.0;
  1         3  
7 1     1   4 use utf8;
  1         6  
  1         11  
8 1     1   21 use warnings;
  1         2  
  1         52  
9              
10             # {{{ use block
11              
12 1     1   5 use Carp;
  1         2  
  1         98  
13 1     1   567 use Export::Attrs;
  1         8351  
  1         5  
14              
15             # }}}
16             # {{{ var block
17             our $VERSION = '0.2603300';
18             my %token1 = qw( 0 nulle 1 viens 2 divi
19             3 trīs 4 četri 5 pieci
20             6 seši 7 septiņi 8 astoņi
21             9 deviņi 10 desmit 11 vienpadsmit
22             12 divpadsmit 13 trīspadsmit 14 četrpadsmit
23             15 piecpadsmit 16 sešpadsmit 17 septiņpadsmit
24             18 astoņpadsmit 19 deviņpadsmit
25             );
26             my %token2 = qw( 20 divdesmit 30 trīsdesmit
27             40 četrdesmit 50 piecdesmit
28             60 sešdesmit 70 septiņdesmit
29             80 astoņdesmit 90 deviņdesmit
30             );
31              
32             # }}}
33              
34             # {{{ _decline choose singular/plural form
35              
36             sub _decline {
37 0     0   0 my ($count, $singular, $plural) = @_;
38              
39 0         0 my $last_two = $count % 100;
40 0         0 my $last_one = $count % 10;
41              
42             # teens (11-19) always take plural
43 0 0 0     0 if ($last_two >= 11 && $last_two <= 19) {
44 0         0 return $plural;
45             }
46              
47             # last digit 1 => singular
48 0 0       0 if ($last_one == 1) {
49 0         0 return $singular;
50             }
51              
52             # everything else => plural
53 0         0 return $plural;
54             }
55              
56             # }}}
57             # {{{ _hundreds convert hundreds part
58              
59             sub _hundreds {
60 0     0   0 my ($number) = @_;
61              
62 0         0 my $h = int($number / 100);
63              
64 0 0       0 if ($h == 1) {
65 0         0 return 'simts';
66             }
67              
68 0         0 return $token1{$h} . ' ' . _decline($h, 'simts', 'simti');
69             }
70              
71             # }}}
72             # {{{ num2lav_cardinal number to string conversion
73              
74             sub num2lav_cardinal :Export {
75 2     2 1 139970 my $result = '';
76 2         6 my $number = shift;
77              
78 2 50 33     36 croak 'You should specify a number from interval [0, 999_999_999]'
      33        
      33        
79             if !defined $number
80             || $number !~ m{\A\d+\z}xms
81             || $number < 0
82             || $number > 999_999_999;
83              
84             # 0-19
85 2 50       7 if ($number < 20) {
86 2         12 return $token1{$number};
87             }
88              
89             # 20-99
90 0 0         if ($number < 100) {
91 0           my $remainder = $number % 10;
92 0           $result = $token2{$number - $remainder};
93 0 0         if ($remainder != 0) {
94 0           $result .= ' ' . $token1{$remainder};
95             }
96 0           return $result;
97             }
98              
99             # 100-999
100 0 0         if ($number < 1_000) {
101 0           my $remainder = $number % 100;
102 0           $result = _hundreds($number);
103 0 0         if ($remainder != 0) {
104 0           $result .= ' ' . num2lav_cardinal($remainder);
105             }
106 0           return $result;
107             }
108              
109             # 1_000-999_999
110 0 0         if ($number < 1_000_000) {
111 0           my $remainder = $number % 1_000;
112 0           my $thousands = int($number / 1_000);
113 0           my $suffix = _decline($thousands, 'tūkstotis', 'tūkstoši');
114              
115 0 0         if ($thousands == 1) {
    0          
116 0           $result = 'viens tūkstotis';
117             }
118             elsif ($thousands < 20) {
119 0           $result = $token1{$thousands} . ' ' . $suffix;
120             }
121             else {
122 0           $result = num2lav_cardinal($thousands) . ' ' . $suffix;
123             }
124              
125 0 0         if ($remainder != 0) {
126 0           $result .= ' ' . num2lav_cardinal($remainder);
127             }
128 0           return $result;
129             }
130              
131             # 1_000_000-999_999_999
132 0 0         if ($number < 1_000_000_000) {
133 0           my $remainder = $number % 1_000_000;
134 0           my $millions = int($number / 1_000_000);
135 0           my $suffix = _decline($millions, 'miljons', 'miljoni');
136              
137 0 0         if ($millions == 1) {
    0          
138 0           $result = 'viens miljons';
139             }
140             elsif ($millions < 20) {
141 0           $result = $token1{$millions} . ' ' . $suffix;
142             }
143             else {
144 0           $result = num2lav_cardinal($millions) . ' ' . $suffix;
145             }
146              
147 0 0         if ($remainder != 0) {
148 0           $result .= ' ' . num2lav_cardinal($remainder);
149             }
150 0           return $result;
151             }
152              
153 0           return $result;
154 1     1   597 }
  1         3  
  1         4  
155              
156             # }}}
157              
158              
159             # {{{ num2lav_ordinal convert number to ordinal text
160              
161             sub num2lav_ordinal :Export {
162 0     0 1   my $number = shift;
163              
164 0 0 0       croak 'You should specify a number from interval [1, 999_999_999]'
      0        
      0        
165             if !defined $number
166             || $number !~ m{\A\d+\z}xms
167             || $number < 1
168             || $number > 999_999_999;
169              
170             # Unique ordinal forms for 1-19 (masculine nominative)
171 0           my %ordinals = (
172             1 => 'pirmais',
173             2 => 'otrais',
174             3 => 'trešais',
175             4 => 'ceturtais',
176             5 => 'piektais',
177             6 => 'sestais',
178             7 => 'septītais',
179             8 => 'astotais',
180             9 => 'devītais',
181             10 => 'desmitais',
182             11 => 'vienpadsmitais',
183             12 => 'divpadsmitais',
184             13 => 'trīspadsmitais',
185             14 => 'četrpadsmitais',
186             15 => 'piecpadsmitais',
187             16 => 'sešpadsmitais',
188             17 => 'septiņpadsmitais',
189             18 => 'astoņpadsmitais',
190             19 => 'deviņpadsmitais',
191             );
192              
193 0 0         return $ordinals{$number} if exists $ordinals{$number};
194              
195             # Round tens: cardinal + "ais"
196 0           my %ordinal_tens = (
197             20 => 'divdesmitais',
198             30 => 'trīsdesmitais',
199             40 => 'četrdesmitais',
200             50 => 'piecdesmitais',
201             60 => 'sešdesmitais',
202             70 => 'septiņdesmitais',
203             80 => 'astoņdesmitais',
204             90 => 'deviņdesmitais',
205             );
206              
207 0 0         return $ordinal_tens{$number} if exists $ordinal_tens{$number};
208              
209             # Compound 21-99: cardinal tens + ordinal unit
210 0 0 0       if ($number > 20 && $number < 100) {
211 0           my $remain = $number % 10;
212 0           my $tens = $number - $remain;
213 0           return $token2{$tens} . ' ' . num2lav_ordinal($remain);
214             }
215              
216             # Round hundreds
217 0 0 0       if ($number >= 100 && $number < 1000 && $number % 100 == 0) {
      0        
218 0           return _hundreds($number) . 'ais';
219             }
220              
221             # Compound hundreds: cardinal hundreds + ordinal remainder
222 0 0 0       if ($number >= 100 && $number < 1000) {
223 0           my $remain = $number % 100;
224 0           return _hundreds($number) . ' ' . num2lav_ordinal($remain);
225             }
226              
227             # Round thousands
228 0 0 0       if ($number >= 1000 && $number < 1_000_000 && $number % 1000 == 0) {
      0        
229 0           my $thousands = int($number / 1000);
230 0           my $suffix = _decline($thousands, 'tūkstošais', 'tūkstošais');
231              
232 0 0         if ($thousands == 1) {
233 0           return 'tūkstošais';
234             }
235 0           return num2lav_cardinal($thousands) . ' ' . $suffix;
236             }
237              
238             # Compound thousands
239 0 0 0       if ($number >= 1000 && $number < 1_000_000) {
240 0           my $thousands = int($number / 1000);
241 0           my $remain = $number % 1000;
242 0           my $suffix = _decline($thousands, 'tūkstotis', 'tūkstoši');
243              
244 0           my $prefix;
245 0 0         if ($thousands == 1) {
    0          
246 0           $prefix = 'viens tūkstotis';
247             }
248             elsif ($thousands < 20) {
249 0           $prefix = $token1{$thousands} . ' ' . $suffix;
250             }
251             else {
252 0           $prefix = num2lav_cardinal($thousands) . ' ' . $suffix;
253             }
254 0           return $prefix . ' ' . num2lav_ordinal($remain);
255             }
256              
257             # Round millions
258 0 0 0       if ($number >= 1_000_000 && $number < 1_000_000_000 && $number % 1_000_000 == 0) {
      0        
259 0           my $millions = int($number / 1_000_000);
260 0 0         if ($millions == 1) {
261 0           return 'miljontais';
262             }
263 0           return num2lav_cardinal($millions) . ' miljontais';
264             }
265              
266             # Compound millions
267 0 0 0       if ($number >= 1_000_000 && $number < 1_000_000_000) {
268 0           my $millions = int($number / 1_000_000);
269 0           my $remain = $number % 1_000_000;
270 0           my $suffix = _decline($millions, 'miljons', 'miljoni');
271              
272 0           my $prefix;
273 0 0         if ($millions == 1) {
    0          
274 0           $prefix = 'viens miljons';
275             }
276             elsif ($millions < 20) {
277 0           $prefix = $token1{$millions} . ' ' . $suffix;
278             }
279             else {
280 0           $prefix = num2lav_cardinal($millions) . ' ' . $suffix;
281             }
282 0           return $prefix . ' ' . num2lav_ordinal($remain);
283             }
284              
285 0           return;
286 1     1   688 }
  1         1  
  1         11  
287              
288             # }}}
289              
290             # {{{ capabilities declare supported features
291              
292             sub capabilities {
293             return {
294 0     0 1   cardinal => 1,
295             ordinal => 1,
296             };
297             }
298              
299             # }}}
300             1;
301              
302             __END__