File Coverage

blib/lib/Math/BigInt/Named/Norwegian.pm
Criterion Covered Total %
statement 76 76 100.0
branch 34 36 94.4
condition 13 15 86.6
subroutine 6 6 100.0
pod 1 1 100.0
total 130 134 97.0


line stmt bran cond sub pod time code
1             # -*- mode: perl; -*-
2              
3             package Math::BigInt::Named::Norwegian;
4              
5 2     2   13 use strict;
  2         24  
  2         62  
6 2     2   10 use warnings;
  2         4  
  2         80  
7              
8 2     2   13 use Math::BigInt::Named;
  2         11  
  2         20  
9             our @ISA = qw< Math::BigInt::Named >;
10              
11             our $VERSION = '0.08';
12              
13             my $SMALL = [ qw/
14             null
15             en
16             to
17             tre
18             fire
19             fem
20             seks
21             syv
22             åtte
23             ni
24             ti
25             elleve
26             tolv
27             tretten
28             fjorten
29             femten
30             seksten
31             sytten
32             atten
33             nitten
34             / ];
35              
36             my $TENS = [ qw /
37             ti
38             tjue
39             tretti
40             førti
41             femti
42             seksti
43             sytti
44             åtti
45             nitti
46             / ];
47              
48             my $HUNDREDS = [ qw /
49             en
50             to
51             tre
52             fire
53             fem
54             seks
55             sju
56             åtte
57             ni
58             / ];
59              
60             my $TRIPLE = [ qw /
61             mi
62             bi
63             tri
64             kvadri
65             kvinti
66             seksti
67             septi
68             okti
69             noni
70             desi
71             undesi
72             duodesi
73             tredesi
74             kvattordesi
75             kvindesi
76             seksdesi
77             septendesi
78             oktodesi
79             novemdesi
80             viginti
81             / ];
82              
83             sub name {
84 55     55 1 295 my $x = shift;
85 55 50       938 $x = Math::BigInt -> new($x) unless ref($x);
86              
87 55         91 my $class = ref($x);
88              
89 55 50       160 return '' if $x -> is_nan();
90              
91 55         320 my $ret = '';
92 55         236 my $y = $x -> copy();
93 55         1210 my $rem;
94              
95 55 100       152 if ($y -> sign() eq '-') {
96 1         7 $ret = 'minus ';
97 1         7 $y -> babs();
98             }
99              
100 55 100       580 if ($y < 1000) {
101 42         5639 return $ret . $class -> _triple($y, 1, 0);
102             }
103              
104             # Split the number into numerical triplets.
105              
106 13         1304 my @num = ();
107 13         44 while (!$y -> is_zero()) {
108 32         408 ($y, $rem) = $y -> bdiv(1000);
109 32         6484 unshift @num, $rem;
110             }
111              
112             # Convert each numerical triplet into a string.
113              
114 13         141 my @str = ();
115 13         40 for my $i (0 .. $#num) {
116 32         47 my $num = $num[$i];
117 32         43 my $str;
118 32         60 my $index = $#num - $i;
119              
120 32         42 my $count;
121 32 100 100     80 if ($num == 1 && $index == 1) {
122 8         849 $count = "ett"; # "ett tusen", not "en tusen"
123             } else {
124 24         2264 $count = $class -> _triple($num, 0, $i);
125             }
126 32         1165 $str .= $count;
127              
128             # "tusen", "million"/"millioner", "milliard/milliarder", ...
129              
130 32 100       68 if ($index > 0) {
131 19         56 my $triple_name = $class -> _triple_name($#num - $i, $num);
132 19         114 $str .= ' ' . $triple_name;
133             }
134              
135 32         77 $str[$i] = $str;
136             }
137              
138             # 1100 -> "ett tusen ett hundre" (not "ett tusen og ett hundre")
139             # 1099 -> "ett tusen og nittini" (not "ett tusen nittini")
140             # 1098 -> "ett tusen og nittiåtte" (not "ett tusen nittiåtte")
141             # ...
142             # 1001 -> "ett tusen og en" (not "ett tusen en")
143             # 1000 -> "ett tusen" (not "ett tusen og null"
144              
145 13 100 66     60 if (@num > 1 && 0 < $num[-1] && $num[-1] < 100) {
      100        
146 5         1099 splice @str, -1, 0, "og";
147             }
148              
149 13         1554 $ret . join(" ", grep /\S/, @str);
150             }
151              
152             sub _triple_name {
153 19     19   46 my ($self, $index, $number) = @_;
154             # index => 0 hundreds, tens and ones
155             # index => 1 thousands
156             # index => 2 millions
157              
158 19 100 66     65 return '' if $index == 0 || $number -> is_zero();
159 14 100       178 return 'tusen' if $index == 1;
160              
161 6         11 my $postfix = 'llion';
162 6         8 my $plural = 'er';
163 6 100       19 if (($index & 1) == 1) {
164 1         2 $postfix = 'lliard';
165             }
166 6 100       20 $postfix .= $plural unless $number -> is_one();
167 6         89 $index -= 2;
168 6         19 $TRIPLE -> [$index >> 1] . $postfix;
169             }
170              
171             sub _triple {
172             # return name of a triple
173             # input: number >= 0, < 1000
174             # only true if triple is the only triple
175 66     66   214 my ($self, $number, $only) = @_;
176              
177             # 0 => null, but only if there is just one triple
178 66 100 100     169 return '' if $number -> is_zero() && !$only;
179              
180             # we have the full name for these
181 58 100       961 return $SMALL -> [$number] if $number <= $#$SMALL;
182              
183             # New code:
184              
185 29         2987 my @num = ();
186 29         111 $num[1] = $number % 100; # tens and ones
187 29         4681 $num[0] = ($number - $num[1]) / 100; # hundreds
188              
189 29         8437 my @str = ();
190              
191             # Do the hundreds, if any.
192              
193 29 100       93 if ($num[0]) {
194 17         535 my $str;
195 17 100       43 $str = $num[0] == 1 ? "ett" # "ett hundre", not "en hundre"
196             : $HUNDREDS -> [$num[0] - 1];
197 17         3542 $str .= " hundre";
198 17         71 push @str, $str;
199             }
200              
201             # Do the tens and ones, if any.
202              
203 29 100       309 if ($num[1]) {
204 18         441 my $str;
205 18         44 my $ones = $num[1] % 10;
206 18         2585 my $tens = ($num[1] - $ones) / 10;
207 18 100       5013 if ($num[1] <= $#$SMALL) {
208 4         348 $str = $SMALL -> [ $num[1] ];
209             } else {
210 14         1408 $str = $TENS -> [ $tens - 1];
211 14 100       2525 if ($ones > 0) {
212 13         2142 $str .= "";
213 13         34 $str .= $SMALL -> [ $ones ];
214             }
215             }
216 18         579 push @str, $str;
217             }
218              
219 29         439 return join " og ", @str;
220             }
221              
222             1;
223              
224             __END__