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             #!perl
2              
3             package Math::BigInt::Named::Norwegian;
4              
5 1     1   6 use strict;
  1         2  
  1         32  
6 1     1   12 use warnings;
  1         2  
  1         27  
7              
8 1     1   6 use Math::BigInt::Named;
  1         1  
  1         9  
9             our @ISA = qw< Math::BigInt::Named >;
10              
11             our $VERSION = '0.06';
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 54     54 1 103 my $x = shift;
85 54 50       120 $x = Math::BigInt -> new($x) unless ref($x);
86              
87 54         103 my $class = ref($x);
88              
89 54 50       115 return '' if $x -> is_nan();
90              
91 54         324 my $ret = '';
92 54         117 my $y = $x -> copy();
93 54         1061 my $rem;
94              
95 54 100       124 if ($y -> sign() eq '-') {
96 1         6 $ret = 'minus ';
97 1         7 $y -> babs();
98             }
99              
100 54 100       391 if ($y < 1000) {
101 41         4595 return $ret . $class -> _triple($y, 1, 0);
102             }
103              
104             # Split the number into numerical triplets.
105              
106 13         1442 my @num = ();
107 13         41 while (!$y -> is_zero()) {
108 32         429 ($y, $rem) = $y -> bdiv(1000);
109 32         7203 unshift @num, $rem;
110             }
111              
112             # Convert each numerical triplet into a string.
113              
114 13         170 my @str = ();
115 13         40 for my $i (0 .. $#num) {
116 32         74 my $num = $num[$i];
117 32         44 my $str;
118 32         60 my $index = $#num - $i;
119              
120 32         41 my $count;
121 32 100 100     83 if ($num == 1 && $index == 1) {
122 8         886 $count = "ett"; # "ett tusen", not "en tusen"
123             } else {
124 24         2510 $count = $class -> _triple($num, 0, $i);
125             }
126 32         1318 $str .= $count;
127              
128             # "tusen", "million"/"millioner", "milliard/milliarder", ...
129              
130 32 100       69 if ($index > 0) {
131 19         50 my $triple_name = $class -> _triple_name($#num - $i, $num);
132 19         101 $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     55 if (@num > 1 && 0 < $num[-1] && $num[-1] < 100) {
      100        
146 5         1274 splice @str, -1, 0, "og";
147             }
148              
149 13         1804 $ret . join(" ", grep /\S/, @str);
150             }
151              
152             sub _triple_name {
153 19     19   42 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       197 return 'tusen' if $index == 1;
160              
161 6         14 my $postfix = 'llion';
162 6         7 my $plural = 'er';
163 6 100       20 if (($index & 1) == 1) {
164 1         2 $postfix = 'lliard';
165             }
166 6 100       22 $postfix .= $plural unless $number -> is_one();
167 6         129 $index -= 2;
168 6         23 $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 65     65   149 my ($self, $number, $only) = @_;
176              
177             # 0 => null, but only if there is just one triple
178 65 100 100     144 return '' if $number -> is_zero() && !$only;
179              
180             # we have the full name for these
181 57 100       820 return $SMALL -> [$number] if $number <= $#$SMALL;
182              
183             # New code:
184              
185 28         2970 my @num = ();
186 28         87 $num[1] = $number % 100; # tens and ones
187 28         5088 $num[0] = ($number - $num[1]) / 100; # hundreds
188              
189 28         8940 my @str = ();
190              
191             # Do the hundreds, if any.
192              
193 28 100       84 if ($num[0]) {
194 16         380 my $str;
195 16 100       40 $str = $num[0] == 1 ? "ett" # "ett hundre", not "en hundre"
196             : $HUNDREDS -> [$num[0] - 1];
197 16         3508 $str .= " hundre";
198 16         38 push @str, $str;
199             }
200              
201             # Do the tens and ones, if any.
202              
203 28 100       357 if ($num[1]) {
204 17         370 my $str;
205 17         39 my $ones = $num[1] % 10;
206 17         2927 my $tens = ($num[1] - $ones) / 10;
207 17 100       5316 if ($num[1] <= $#$SMALL) {
208 4         411 $str = $SMALL -> [ $num[1] ];
209             } else {
210 13         1349 $str = $TENS -> [ $tens - 1];
211 13 100       2699 if ($ones > 0) {
212 12         1942 $str .= "";
213 12         32 $str .= $SMALL -> [ $ones ];
214             }
215             }
216 17         645 push @str, $str;
217             }
218              
219 28         447 return join " og ", @str;
220             }
221              
222             1;
223              
224             __END__