File Coverage

blib/lib/Lingua/SWE/Num2Word.pm
Criterion Covered Total %
statement 35 79 44.3
branch 11 52 21.1
condition 3 14 21.4
subroutine 7 9 77.7
pod 3 3 100.0
total 59 157 37.5


line stmt bran cond sub pod time code
1             # For Emacs: -*- mode:cperl; eval: (folding-mode 1); -*-
2              
3             package Lingua::SWE::Num2Word;
4             # ABSTRACT: Number to word conversion in Swedish
5              
6 1     1   88699 use 5.16.0;
  1         3  
7 1     1   6 use utf8;
  1         2  
  1         12  
8 1     1   24 use warnings;
  1         1  
  1         61  
9              
10             # {{{ use block
11              
12 1     1   532 use Export::Attrs;
  1         9937  
  1         8  
13              
14             # }}}
15             # {{{ variables declaration
16             our $VERSION = '0.2603300';
17              
18             # }}}
19             # {{{ num2sv_cardinal convert number to text
20              
21             sub num2sv_cardinal :Export {
22 8   100 8 1 224539 my $positive = shift // return 'noll';
23              
24 7 50       24 return if ($positive < 0);
25              
26 7         16 my $out;
27 7         41 my @tokens1 = qw(noll ett två tre fyra fem sex sju åtta nio tio elva
28             tolv tretton fjorton femton sexton sjutton arton nitton); # 0-19 Cardinals
29 7         51 my @tokens2 = qw(tjugo trettio fyrtio femtio sextio sjutio åttio nittio); # 20-90 Cardinals (end with zero)
30              
31 7 100       27 return $tokens1[$positive] if($positive < 20); # interval 0 - 19
32              
33 5 50       19 if($positive < 100) { # interval 20 - 99
    100          
    50          
    0          
34 0         0 my @num = split '',$positive;
35              
36 0         0 $out = $tokens2[$num[0]-2];
37 0 0       0 $out .= $tokens1[$num[1]] if ($num[1]);
38             } elsif($positive < 1000) { # interval 100 - 999
39 3         9 my @num = split '',$positive;
40              
41 3         11 $out = $tokens1[$num[0]].'hundra';
42              
43 3 50 33     14 if ((int $num[1].$num[2]) < 20 && (int $num[1].$num[2])>0 ) {
44 0         0 $out .= &num2sv_cardinal(int $num[1].$num[2]);
45             } else {
46 3 50       15 $out .= $tokens2[$num[1]-2] if($num[1]);
47 3 50       14 $out .= $tokens1[$num[2]] if($num[2]);
48             }
49             } elsif($positive < 1000_000) { # interval 1000 - 999_999
50 2         11 my @num = split '',$positive;
51 2         7 my @sub = splice @num,-3;
52              
53 2         17 $out = &num2sv_cardinal(int join '',@num);
54 2         6 $out .= 'tusen';
55 2 50       14 $out .= &num2sv_cardinal(int join '',@sub) if (int(join "",@sub) >0);
56             } elsif($positive < 1_000_000_000) { # interval 1_000_000 - 999_999_999
57 0         0 my @num = split '',$positive;
58 0         0 my @sub = splice @num,-6;
59              
60 0         0 $out = &num2sv_cardinal(int join '',@num);
61 0         0 $out .= ' miljoner ';
62 0 0       0 $out .= &num2sv_cardinal(int join '',@sub) if (int(join "",@sub) >0);
63             }
64              
65 5         29 return $out;
66 1     1   454 }
  1         2  
  1         17  
67              
68             # }}}
69              
70             # {{{ num2sv_ordinal convert number to ordinal text
71              
72             sub num2sv_ordinal :Export {
73 0     0 1   my $number = shift;
74              
75 0 0 0       return if !defined $number
      0        
      0        
76             || $number !~ m{\A\d+\z}xms
77             || $number < 1
78             || $number > 999_999_999;
79              
80             # Fully irregular 1-3
81 0 0         return 'första' if $number == 1;
82 0 0         return 'andra' if $number == 2;
83 0 0         return 'tredje' if $number == 3;
84              
85             # Irregular 4-12
86 0           my %irregular = (
87             4 => 'fjärde',
88             5 => 'femte',
89             6 => 'sjätte',
90             7 => 'sjunde',
91             8 => 'åttonde',
92             9 => 'nionde',
93             10 => 'tionde',
94             11 => 'elfte',
95             12 => 'tolfte',
96             );
97 0 0         return $irregular{$number} if exists $irregular{$number};
98              
99             # 13-19: special ordinal stems
100 0           my %teens = (
101             13 => 'trettonde',
102             14 => 'fjortonde',
103             15 => 'femtonde',
104             16 => 'sextonde',
105             17 => 'sjuttonde',
106             18 => 'artonde',
107             19 => 'nittonde',
108             );
109 0 0         return $teens{$number} if exists $teens{$number};
110              
111             # Tens ordinal stems (exact multiples)
112 0           my %tens_ord = (
113             20 => 'tjugonde',
114             30 => 'trettionde',
115             40 => 'fyrtionde',
116             50 => 'femtionde',
117             60 => 'sextionde',
118             70 => 'sjuttionde',
119             80 => 'åttionde',
120             90 => 'nittionde',
121             );
122              
123             # 20-99
124 0 0         if ($number < 100) {
125 0           my $tens = int($number / 10) * 10;
126 0           my $ones = $number % 10;
127 0 0         return $tens_ord{$tens} if $ones == 0;
128              
129             # Compound: cardinal tens prefix + ordinal of ones
130 0           my @tens_card = qw(tjugo trettio fyrtio femtio sextio sjutio åttio nittio);
131 0           return $tens_card[int($number/10) - 2] . num2sv_ordinal($ones);
132             }
133              
134             # 100-999
135 0 0         if ($number < 1000) {
136 0           my $hundreds = int($number / 100);
137 0           my $remain = $number % 100;
138              
139 0 0         if ($remain == 0) {
140 0           my @tokens1 = qw(noll ett två tre fyra fem sex sju åtta nio);
141 0           return $tokens1[$hundreds] . 'hundrade';
142             }
143 0           return num2sv_cardinal(int($number / 100) * 100) . num2sv_ordinal($remain);
144             }
145              
146             # 1000-999_999
147 0 0         if ($number < 1_000_000) {
148 0           my $remain = $number % 1000;
149 0 0         if ($remain == 0) {
150 0           return num2sv_cardinal(int($number / 1000)) . 'tusende';
151             }
152 0           return num2sv_cardinal(int($number / 1000)) . 'tusen' . num2sv_ordinal($remain);
153             }
154              
155             # 1_000_000 - 999_999_999
156 0 0         if ($number < 1_000_000_000) {
157 0           my $remain = $number % 1_000_000;
158 0 0         if ($remain == 0) {
159 0           return num2sv_cardinal(int($number / 1_000_000)) . ' miljonte';
160             }
161 0           return num2sv_cardinal(int($number / 1_000_000)) . ' miljoner ' . num2sv_ordinal($remain);
162             }
163              
164 0           return;
165 1     1   670 }
  1         3  
  1         5  
166              
167             # }}}
168              
169             # {{{ capabilities declare supported features
170              
171             sub capabilities {
172             return {
173 0     0 1   cardinal => 1,
174             ordinal => 1,
175             };
176             }
177              
178             # }}}
179             1;
180              
181             __END__