File Coverage

blib/lib/Lingua/ISL/Num2Word.pm
Criterion Covered Total %
statement 30 85 35.2
branch 2 48 4.1
condition 4 45 8.8
subroutine 9 12 75.0
pod 4 4 100.0
total 49 194 25.2


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; eval: (folding-mode 1); coding:utf-8 -*-
2              
3             package Lingua::ISL::Num2Word;
4             # ABSTRACT: Number to word conversion in Icelandic
5              
6 1     1   152743 use 5.16.0;
  1         5  
7 1     1   6 use utf8;
  1         2  
  1         16  
8 1     1   42 use warnings;
  1         1  
  1         105  
9              
10             # {{{ use block
11              
12 1     1   8 use Carp;
  1         2  
  1         110  
13 1     1   778 use Export::Attrs;
  1         14354  
  1         9  
14 1     1   991 use Readonly;
  1         6193  
  1         770  
15              
16             # }}}
17             # {{{ variable declarations
18              
19             my Readonly::Scalar $COPY = 'Copyright (c) PetaMem, s.r.o. 2002-present';
20             our $VERSION = '0.2603300';
21              
22             # }}}
23              
24             # {{{ num2isl_cardinal convert number to text
25              
26             sub num2isl_cardinal :Export {
27 2     2 1 229927 my $positive = shift;
28              
29 2 50 33     27 croak 'You should specify a number from interval [0, 999_999_999]'
      33        
      33        
30             if !defined $positive
31             || $positive !~ m{\A\d+\z}xms
32             || $positive < 0
33             || $positive > 999_999_999;
34              
35             # 0 .. 19: unique words
36 2         10 my @tokens1 = qw(núll einn tveir þrír fjórir fimm sex sjö átta níu
37             tíu ellefu tólf);
38 2         6 my @teens = qw(þrettán fjórtán fimmtán sextán sautján átján nítján);
39              
40             # tens
41 2         7 my @tokens2 = qw(tuttugu þrjátíu fjörutíu fimmtíu sextíu sjötíu áttatíu níutíu);
42              
43             # neuter forms for use with hundrað/þúsund (both neuter nouns)
44 2         7 my @neuter = qw(núll eitt tvö þrjú fjögur fimm sex sjö átta níu);
45              
46 2 50 33     13 return $tokens1[$positive] if ($positive >= 0 && $positive < 13); # 0 .. 12
47 0 0 0       return $teens[$positive - 13] if ($positive > 12 && $positive < 20); # 13 .. 19
48              
49 0           my $out; # string for return value construction
50             my $one_idx; # index for tokens arrays
51 0           my $remain; # remainder
52              
53 0 0 0       if ($positive > 19 && $positive < 100) { # 20 .. 99
    0 0        
    0 0        
    0 0        
54 0           $one_idx = int ($positive / 10);
55 0           $remain = $positive % 10;
56              
57 0           $out = $tokens2[$one_idx - 2];
58 0 0         $out .= " og $tokens1[$remain]" if ($remain);
59             }
60             elsif ($positive > 99 && $positive < 1000) { # 100 .. 999
61 0           $one_idx = int ($positive / 100);
62 0           $remain = $positive % 100;
63              
64             # hundrað is neuter: eitt hundrað, tvö hundruð, ...
65 0 0         if ($one_idx == 1) {
66 0           $out = 'hundrað';
67             }
68             else {
69 0           $out = "$neuter[$one_idx] hundruð";
70             }
71 0 0         $out .= $remain ? ' og ' . num2isl_cardinal($remain) : '';
72             }
73             elsif ($positive > 999 && $positive < 1_000_000) { # 1000 .. 999_999
74 0           $one_idx = int ($positive / 1000);
75 0           $remain = $positive % 1000;
76              
77             # þúsund is neuter and invariable
78 0 0         if ($one_idx == 1) {
    0          
79 0           $out = 'þúsund';
80             }
81             elsif ($one_idx < 5) {
82 0           $out = num2isl_neuter($one_idx) . ' þúsund';
83             }
84             else {
85 0           $out = num2isl_cardinal($one_idx) . ' þúsund';
86             }
87 0 0         $out .= $remain ? ' og ' . num2isl_cardinal($remain) : '';
88             }
89             elsif ( $positive > 999_999
90             && $positive < 1_000_000_000) { # 1_000_000 .. 999_999_999
91 0           $one_idx = int ($positive / 1000000);
92 0           $remain = $positive % 1000000;
93              
94 0 0         if ($one_idx == 1) {
95 0           $out = 'ein milljón';
96             }
97             else {
98 0           $out = num2isl_cardinal($one_idx) . ' milljónir';
99             }
100 0 0         $out .= $remain ? ' og ' . num2isl_cardinal($remain) : '';
101             }
102              
103 0           return $out;
104 1     1   11 }
  1         2  
  1         10  
105              
106             # }}}
107             # {{{ num2isl_neuter neuter form for small numbers
108              
109             sub num2isl_neuter {
110 0     0 1   my $n = shift;
111 0           my @neuter = qw(núll eitt tvö þrjú fjögur);
112 0 0 0       return $neuter[$n] if ($n >= 0 && $n <= 4);
113 0           return num2isl_cardinal($n);
114             }
115              
116             # }}}
117              
118              
119             # {{{ num2isl_ordinal convert number to ordinal text
120              
121             sub num2isl_ordinal :Export {
122 0     0 1   my $number = shift;
123              
124 0 0 0       croak 'You should specify a number from interval [1, 999_999_999]'
      0        
      0        
125             if !defined $number
126             || $number !~ m{\A\d+\z}xms
127             || $number < 1
128             || $number > 999_999_999;
129              
130             # Fully irregular forms (masculine nominative)
131 0           my %irregular = (
132             1 => 'fyrsti',
133             2 => 'annar',
134             3 => 'þriðji',
135             4 => 'fjórði',
136             5 => 'fimmti',
137             6 => 'sjötti',
138             7 => 'sjöundi',
139             8 => 'áttundi',
140             9 => 'níundi',
141             10 => 'tíundi',
142             11 => 'ellefti',
143             12 => 'tólfti',
144             );
145              
146 0 0         return $irregular{$number} if exists $irregular{$number};
147              
148             # 13-19: cardinal stem + "di"
149 0 0 0       if ($number >= 13 && $number <= 19) {
150 0           my %teens = (
151             13 => 'þrettándi',
152             14 => 'fjórtándi',
153             15 => 'fimmtándi',
154             16 => 'sextándi',
155             17 => 'sautjándi',
156             18 => 'átjándi',
157             19 => 'nítjándi',
158             );
159 0           return $teens{$number};
160             }
161              
162             # Compound numbers: ordinal applies to last component
163             # For round tens (20,30,...), use specific ordinal tens
164 0           my %ordinal_tens = (
165             20 => 'tuttugasti',
166             30 => 'þrítugasti',
167             40 => 'fertugasti',
168             50 => 'fimmtugasti',
169             60 => 'sextugasti',
170             70 => 'sjötugasti',
171             80 => 'áttugasti',
172             90 => 'nítugasti',
173             );
174              
175 0 0         return $ordinal_tens{$number} if exists $ordinal_tens{$number};
176              
177             # 21-99 (non-round): cardinal tens + "og" + ordinal unit
178 0 0 0       if ($number > 20 && $number < 100) {
179 0           my @tens = qw(tuttugu þrjátíu fjörutíu fimmtíu sextíu sjötíu áttatíu níutíu);
180 0           my $ten_idx = int($number / 10);
181 0           my $remain = $number % 10;
182 0           return $tens[$ten_idx - 2] . ' og ' . num2isl_ordinal($remain);
183             }
184              
185             # 100+: cardinal prefix + ordinal of the last part
186             # Round hundreds/thousands/millions get suffix "asti"
187 0 0         if ($number == 100) { return 'hundraðasti' }
  0            
188 0 0         if ($number == 1000) { return 'þúsundasti' }
  0            
189 0 0         if ($number == 1_000_000) { return 'milljónasti' }
  0            
190              
191             # For compound numbers above 100, build cardinal prefix + ordinal tail
192 0           my $cardinal = num2isl_cardinal($number);
193              
194             # Numbers 20+ get "asti", under 20 get "di" (but those are handled above)
195 0           return $cardinal . 'asti';
196 1     1   944 }
  1         2  
  1         5  
197              
198             # }}}
199              
200             # {{{ capabilities declare supported features
201              
202             sub capabilities {
203             return {
204 0     0 1   cardinal => 1,
205             ordinal => 1,
206             };
207             }
208              
209             # }}}
210             1;
211              
212             __END__