File Coverage

blib/lib/Lingua/HRV/Num2Word.pm
Criterion Covered Total %
statement 27 112 24.1
branch 2 76 2.6
condition 3 42 7.1
subroutine 8 10 80.0
pod 3 3 100.0
total 43 243 17.7


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; mode:folding; coding:utf-8; -*-
2              
3             package Lingua::HRV::Num2Word;
4             # ABSTRACT: Number to word conversion in Croatian
5              
6 1     1   126250 use 5.16.0;
  1         3  
7 1     1   5 use utf8;
  1         1  
  1         9  
8 1     1   19 use warnings;
  1         1  
  1         82  
9              
10             # {{{ use block
11              
12 1     1   9 use Carp;
  1         5  
  1         69  
13 1     1   1696 use Export::Attrs;
  1         9420  
  1         5  
14              
15             # }}}
16             # {{{ var block
17             our $VERSION = '0.2603300';
18             my %token1 = qw( 0 nula 1 jedan 2 dva
19             3 tri 4 četiri 5 pet
20             6 šest 7 sedam 8 osam
21             9 devet 10 deset 11 jedanaest
22             12 dvanaest 13 trinaest 14 četrnaest
23             15 petnaest 16 šesnaest 17 sedamnaest
24             18 osamnaest 19 devetnaest
25             );
26             my %token2 = qw( 20 dvadeset 30 trideset 40 četrdeset
27             50 pedeset 60 šezdeset 70 sedamdeset
28             80 osamdeset 90 devedeset
29             );
30             my %token3 = ( 100, 'sto', 200, 'dvjesto', 300, 'tristo',
31             400, 'četiristo', 500, 'petsto', 600, 'šeststo',
32             700, 'sedamsto', 800, 'osamsto', 900, 'devetsto'
33             );
34              
35             # }}}
36              
37             # {{{ num2hrv_cardinal number to string conversion
38              
39             sub num2hrv_cardinal :Export {
40 2     2 1 222892 my $result = '';
41 2         4 my $number = shift;
42              
43 2 50 33     23 croak 'You should specify a number from interval [0, 999_999_999]'
      33        
      33        
44             if !defined $number
45             || $number !~ m{\A\d+\z}xms
46             || $number < 0
47             || $number > 999_999_999;
48              
49 2         2 my $reminder = 0;
50              
51 2 50       5 if ($number < 20) {
    0          
    0          
    0          
    0          
52 2         6 $result = $token1{$number};
53             }
54             elsif ($number < 100) {
55 0         0 $reminder = $number % 10;
56 0 0       0 if ($reminder == 0) {
57 0         0 $result = $token2{$number};
58             }
59             else {
60 0         0 $result = $token2{$number - $reminder}.' '.num2hrv_cardinal($reminder);
61             }
62             }
63             elsif ($number < 1_000) {
64 0         0 $reminder = $number % 100;
65 0 0       0 if ($reminder != 0) {
66 0         0 $result = $token3{$number - $reminder}.' '.num2hrv_cardinal($reminder);
67             }
68             else {
69 0         0 $result = $token3{$number};
70             }
71             }
72             elsif ($number < 1_000_000) {
73 0         0 $reminder = $number % 1_000;
74 0 0       0 my $tmp1 = ($reminder != 0) ? ' '.num2hrv_cardinal($reminder) : '';
75 0         0 my $tmp2 = substr($number, 0, length($number)-3);
76 0         0 my $tmp3 = $tmp2 % 100;
77 0         0 my $tmp4 = $tmp2 % 10;
78              
79 0 0 0     0 if ($tmp3 < 9 || $tmp3 > 20) {
80 0 0 0     0 if ($tmp4 == 1 && $tmp2 == 1) {
    0 0        
    0          
81 0         0 $tmp2 = 'tisuća';
82             }
83             elsif ($tmp4 == 1) {
84 0         0 $tmp2 = num2hrv_cardinal($tmp2 - $tmp4).' jedna tisuća';
85             }
86             elsif($tmp4 > 1 && $tmp4 < 5) {
87             # 2-4: feminine "dvije" for 2, genitive plural "tisuće"
88 0 0 0     0 if ($tmp2 == 2) {
    0          
89 0         0 $tmp2 = 'dvije tisuće';
90             }
91             elsif ($tmp2 == 3 || $tmp2 == 4) {
92 0         0 $tmp2 = num2hrv_cardinal($tmp2).' tisuće';
93             }
94             else {
95             # e.g. 22, 23, 24, 32, 33, 34...
96 0 0       0 if ($tmp4 == 2) {
97 0         0 $tmp2 = num2hrv_cardinal($tmp2 - $tmp4).' dvije tisuće';
98             }
99             else {
100 0         0 $tmp2 = num2hrv_cardinal($tmp2).' tisuće';
101             }
102             }
103             }
104             else {
105 0         0 $tmp2 = num2hrv_cardinal($tmp2).' tisuća';
106             }
107             }
108             else {
109 0         0 $tmp2 = num2hrv_cardinal($tmp2).' tisuća';
110             }
111 0         0 $result = $tmp2.$tmp1;
112             }
113             elsif ($number < 1_000_000_000) {
114 0         0 $reminder = $number % 1_000_000;
115 0 0       0 my $tmp1 = ($reminder != 0) ? ' '.num2hrv_cardinal($reminder) : '';
116 0         0 my $tmp2 = substr($number, 0, length($number)-6);
117 0         0 my $tmp3 = $tmp2 % 100;
118 0         0 my $tmp4 = $tmp2 % 10;
119              
120 0 0 0     0 if ($tmp3 < 9 || $tmp3 > 20) {
121 0 0 0     0 if ($tmp4 == 1 && $tmp2 == 1) {
    0 0        
    0          
122 0         0 $tmp2 = 'jedan milijun';
123             }
124             elsif ($tmp4 == 1) {
125 0         0 $tmp2 = num2hrv_cardinal($tmp2 - $tmp4).' jedan milijun';
126             }
127             elsif($tmp4 > 1 && $tmp4 < 5) {
128 0         0 $tmp2 = num2hrv_cardinal($tmp2).' milijuna';
129             }
130             else {
131 0         0 $tmp2 = num2hrv_cardinal($tmp2).' milijuna';
132             }
133             }
134             else {
135 0         0 $tmp2 = num2hrv_cardinal($tmp2).' milijuna';
136             }
137              
138 0         0 $result = $tmp2.$tmp1;
139             }
140              
141 2         4 return $result;
142 1     1   555 }
  1         4  
  1         5  
143              
144             # }}}
145              
146             # {{{ num2hrv_ordinal number to ordinal string conversion
147              
148             sub num2hrv_ordinal :Export {
149 0     0 1   my $number = shift;
150              
151 0 0 0       croak 'You should specify a number from interval [0, 999_999_999]'
      0        
      0        
152             if !defined $number
153             || $number !~ m{\A\d+\z}xms
154             || $number < 0
155             || $number > 999_999_999;
156              
157             # Irregular ordinals 0-10
158 0           my %irregular = (
159             0 => 'nulti',
160             1 => 'prvi',
161             2 => 'drugi',
162             3 => 'treći',
163             4 => 'četvrti',
164             5 => 'peti',
165             6 => 'šesti',
166             7 => 'sedmi',
167             8 => 'osmi',
168             9 => 'deveti',
169             10 => 'deseti',
170             );
171              
172 0 0         return $irregular{$number} if exists $irregular{$number};
173              
174             # Irregular teens 11-19
175 0           my %teens = (
176             11 => 'jedanaesti',
177             12 => 'dvanaesti',
178             13 => 'trinaesti',
179             14 => 'četrnaesti',
180             15 => 'petnaesti',
181             16 => 'šesnaesti',
182             17 => 'sedamnaesti',
183             18 => 'osamnaesti',
184             19 => 'devetnaesti',
185             );
186              
187 0 0         return $teens{$number} if exists $teens{$number};
188              
189             # Tens ordinals
190 0           my %tens_ord = (
191             20 => 'dvadeseti',
192             30 => 'trideseti',
193             40 => 'četrdeseti',
194             50 => 'pedeseti',
195             60 => 'šezdeseti',
196             70 => 'sedamdeseti',
197             80 => 'osamdeseti',
198             90 => 'devedeseti',
199             );
200              
201             # Hundreds ordinals
202 0           my %hundreds_ord = (
203             100 => 'stoti',
204             200 => 'dvjestoti',
205             300 => 'tristoti',
206             400 => 'četiristoti',
207             500 => 'petstoti',
208             600 => 'šeststoti',
209             700 => 'sedamstoti',
210             800 => 'osamstoti',
211             900 => 'devetstoti',
212             );
213              
214             # For numbers >= 1_000_000
215 0 0         if ($number >= 1_000_000) {
216 0           my $millions = int($number / 1_000_000);
217 0           my $remainder = $number % 1_000_000;
218 0 0         if ($remainder == 0) {
219 0 0         if ($millions == 1) {
220 0           return 'milijunti';
221             }
222 0           return num2hrv_cardinal($millions) . ' milijunti';
223             }
224 0           my $prefix = num2hrv_cardinal($millions);
225 0 0         my $mil_word = ($millions == 1) ? 'jedan milijun' : 'milijuna';
226 0           return $prefix . ' ' . $mil_word . ' ' . num2hrv_ordinal($remainder);
227             }
228              
229 0 0         if ($number >= 1_000) {
230 0           my $thousands = int($number / 1_000);
231 0           my $remainder = $number % 1_000;
232 0 0         if ($remainder == 0) {
233 0 0         if ($thousands == 1) {
234 0           return 'tisućiti';
235             }
236 0           return num2hrv_cardinal($thousands) . ' tisućiti';
237             }
238 0           my $thou_cardinal;
239 0 0 0       if ($thousands == 1) {
    0          
    0          
240 0           $thou_cardinal = 'tisuća';
241             }
242             elsif ($thousands == 2) {
243 0           $thou_cardinal = 'dvije tisuće';
244             }
245             elsif ($thousands >= 3 && $thousands <= 4) {
246 0           $thou_cardinal = num2hrv_cardinal($thousands) . ' tisuće';
247             }
248             else {
249 0           $thou_cardinal = num2hrv_cardinal($thousands) . ' tisuća';
250             }
251 0           return $thou_cardinal . ' ' . num2hrv_ordinal($remainder);
252             }
253              
254 0 0         if ($number >= 100) {
255 0           my $h = int($number / 100) * 100;
256 0           my $remainder = $number % 100;
257 0 0         if ($remainder == 0) {
258 0           return $hundreds_ord{$h};
259             }
260 0           return $token3{$h} . ' ' . num2hrv_ordinal($remainder);
261             }
262              
263             # 20-99 compound
264 0 0         if ($number >= 20) {
265 0           my $t = int($number / 10) * 10;
266 0           my $remainder = $number % 10;
267 0 0         if ($remainder == 0) {
268 0           return $tens_ord{$t};
269             }
270 0           return $tens_ord{$t} . ' ' . $irregular{$remainder};
271             }
272              
273             # Should not reach here
274 0           return;
275 1     1   651 }
  1         2  
  1         3  
276              
277             # }}}
278              
279             # {{{ capabilities declare supported features
280              
281             sub capabilities {
282             return {
283 0     0 1   cardinal => 1,
284             ordinal => 1,
285             };
286             }
287              
288             # }}}
289             1;
290              
291             __END__