line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Lingua::FR::Numbers; |
2
|
6
|
|
|
6
|
|
21428
|
use strict; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
134
|
|
3
|
|
|
|
|
|
|
|
4
|
6
|
|
|
6
|
|
2728
|
use utf8; # some accents here and there |
|
6
|
|
|
|
|
45
|
|
|
6
|
|
|
|
|
21
|
|
5
|
6
|
|
|
6
|
|
147
|
use Carp qw(carp); |
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
204
|
|
6
|
6
|
|
|
6
|
|
20
|
use Exporter; |
|
6
|
|
|
|
|
5
|
|
|
6
|
|
|
|
|
154
|
|
7
|
6
|
|
|
6
|
|
18
|
use vars qw( $VERSION @ISA @EXPORT_OK ); |
|
6
|
|
|
|
|
5
|
|
|
6
|
|
|
|
|
249
|
|
8
|
6
|
|
|
|
|
6418
|
use vars qw( |
9
|
|
|
|
|
|
|
$MODE |
10
|
|
|
|
|
|
|
%NUMBER_NAMES |
11
|
|
|
|
|
|
|
%ORDINALS |
12
|
|
|
|
|
|
|
$OUTPUT_DECIMAL_DELIMITER |
13
|
|
|
|
|
|
|
$SIGN_NAMES |
14
|
6
|
|
|
6
|
|
17
|
); |
|
6
|
|
|
|
|
6
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
$VERSION = '1.161910'; |
17
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
18
|
|
|
|
|
|
|
@EXPORT_OK = qw( &number_to_fr &ordinate_to_fr ); |
19
|
|
|
|
|
|
|
$SIGN_NAMES = ('moins'); |
20
|
|
|
|
|
|
|
$OUTPUT_DECIMAL_DELIMITER = ('virgule'); |
21
|
|
|
|
|
|
|
%NUMBER_NAMES = ( |
22
|
|
|
|
|
|
|
0 => 'zéro', |
23
|
|
|
|
|
|
|
1 => 'un', |
24
|
|
|
|
|
|
|
2 => 'deux', |
25
|
|
|
|
|
|
|
3 => 'trois', |
26
|
|
|
|
|
|
|
4 => 'quatre', |
27
|
|
|
|
|
|
|
5 => 'cinq', |
28
|
|
|
|
|
|
|
6 => 'six', |
29
|
|
|
|
|
|
|
7 => 'sept', |
30
|
|
|
|
|
|
|
8 => 'huit', |
31
|
|
|
|
|
|
|
9 => 'neuf', |
32
|
|
|
|
|
|
|
10 => 'dix', |
33
|
|
|
|
|
|
|
11 => 'onze', |
34
|
|
|
|
|
|
|
12 => 'douze', |
35
|
|
|
|
|
|
|
13 => 'treize', |
36
|
|
|
|
|
|
|
14 => 'quatorze', |
37
|
|
|
|
|
|
|
15 => 'quinze', |
38
|
|
|
|
|
|
|
16 => 'seize', |
39
|
|
|
|
|
|
|
17 => 'dix-sept', |
40
|
|
|
|
|
|
|
18 => 'dix-huit', |
41
|
|
|
|
|
|
|
19 => 'dix-neuf', |
42
|
|
|
|
|
|
|
20 => 'vingt', |
43
|
|
|
|
|
|
|
30 => 'trente', |
44
|
|
|
|
|
|
|
40 => 'quarante', |
45
|
|
|
|
|
|
|
50 => 'cinquante', |
46
|
|
|
|
|
|
|
60 => 'soixante', |
47
|
|
|
|
|
|
|
70 => 'soixante', |
48
|
|
|
|
|
|
|
80 => 'quatre-vingt', |
49
|
|
|
|
|
|
|
90 => 'quatre-vingt', |
50
|
|
|
|
|
|
|
100 => 'cent', |
51
|
|
|
|
|
|
|
1e3 => 'mille', |
52
|
|
|
|
|
|
|
1e6 => 'million', |
53
|
|
|
|
|
|
|
1e9 => 'milliard', |
54
|
|
|
|
|
|
|
1e12 => 'billion', # un million de millions |
55
|
|
|
|
|
|
|
1e18 => 'trillion', # un million de billions |
56
|
|
|
|
|
|
|
1e24 => 'quatrillion', # un million de trillions |
57
|
|
|
|
|
|
|
1e30 => 'quintillion', # un million de quatrillions |
58
|
|
|
|
|
|
|
1e36 => 'sextillion', # un million de quintillions, |
59
|
|
|
|
|
|
|
# the sextillion is the biggest legal unit |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
%ORDINALS = ( |
62
|
|
|
|
|
|
|
1 => 'premier', |
63
|
|
|
|
|
|
|
5 => 'cinqu', |
64
|
|
|
|
|
|
|
9 => 'neuv', |
65
|
|
|
|
|
|
|
); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub number_to_fr { |
68
|
209
|
|
|
209
|
1
|
4378
|
my $number = shift; |
69
|
209
|
|
|
|
|
228
|
my @fr_string = (); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Test if $number is really a number, or return undef, from perldoc |
72
|
|
|
|
|
|
|
# -q numbers |
73
|
209
|
100
|
|
|
|
1056
|
if ( $number !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ ) { |
74
|
2
|
|
|
|
|
228
|
carp("Invalid number format: '$number'"); |
75
|
2
|
|
|
|
|
11
|
return; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
207
|
100
|
|
|
|
1577
|
if ( $number > ( 1e75 - 1 ) ) { |
79
|
1
|
|
|
|
|
91
|
carp("Number '$number' too big to be represented as string"); |
80
|
1
|
|
|
|
|
5
|
return; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
206
|
100
|
|
|
|
271
|
return $NUMBER_NAMES{0} if $number == 0; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# Add the 'minus' string if the number is negative. |
86
|
204
|
100
|
|
|
|
268
|
push @fr_string, $SIGN_NAMES if abs $number != $number; |
87
|
204
|
|
|
|
|
146
|
$number = abs $number; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# We deal with decimal numbers by calling number2fr twice, once for |
90
|
|
|
|
|
|
|
# the integer part, and once for the decimal part. |
91
|
204
|
100
|
|
|
|
249
|
if ( $number != int $number ) { |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# XXX Ugly Hack. |
94
|
9
|
|
|
|
|
36
|
( my $decimal ) = $number =~ /\.(\d+)/; |
95
|
|
|
|
|
|
|
|
96
|
9
|
|
|
|
|
21
|
push @fr_string, number_to_fr( int $number ), $OUTPUT_DECIMAL_DELIMITER; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# Decimal numbers are correctly interpreted |
99
|
|
|
|
|
|
|
# https://github.com/sebthebert/Lingua-FR-Numbers/commit/89b717da8950d183488c6d93c7d5e638628ef13f |
100
|
9
|
100
|
|
|
|
33
|
if ( $decimal =~ s/^(0+([1-9][0-9]*))$/$2/ ) { |
101
|
5
|
|
|
|
|
6
|
my $decimal_power = 10**length $1; |
102
|
5
|
50
|
|
|
|
8
|
last unless $decimal_power; |
103
|
5
|
|
|
|
|
4
|
my $fr_decimal; |
104
|
5
|
|
|
|
|
5
|
$fr_decimal = number_to_fr($decimal) . ' '; |
105
|
5
|
|
|
|
|
8
|
$fr_decimal .= ordinate_to_fr($decimal_power); |
106
|
5
|
100
|
|
|
|
10
|
$fr_decimal .= 's' if $decimal > 1; |
107
|
5
|
|
|
|
|
7
|
push @fr_string, $fr_decimal; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
else { |
110
|
4
|
|
|
|
|
5
|
push @fr_string, number_to_fr($decimal); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
9
|
|
|
|
|
26
|
return join ( ' ', @fr_string ); |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# First, we split the number by 1000 blocks |
117
|
|
|
|
|
|
|
# i.e: |
118
|
|
|
|
|
|
|
# $block[0] => 0 .. 999 => centaines |
119
|
|
|
|
|
|
|
# $block[1] => 1000 .. 999_999 => milliers |
120
|
|
|
|
|
|
|
# $block[2] => 1e6 .. 999_999_999 => millions |
121
|
|
|
|
|
|
|
# $block[3] => 1e9 .. 1e12-1 => milliards |
122
|
195
|
|
|
|
|
121
|
my @blocks; |
123
|
195
|
|
|
|
|
247
|
while ($number) { |
124
|
440
|
|
|
|
|
352
|
push @blocks, $number % 1000; |
125
|
440
|
|
|
|
|
627
|
$number = int $number / 1000; |
126
|
|
|
|
|
|
|
} |
127
|
195
|
|
|
|
|
122
|
@blocks = reverse @blocks; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# We then go through each block, starting from the greatest |
130
|
|
|
|
|
|
|
# (..., billions, millions, thousands) |
131
|
195
|
|
|
|
|
318
|
foreach ( 0 .. $#blocks ) { |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# No need to spell numbers like 'zero million' |
134
|
440
|
100
|
|
|
|
638
|
next if $blocks[$_] == 0; |
135
|
|
|
|
|
|
|
|
136
|
256
|
|
|
|
|
166
|
my $number = $blocks[$_]; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# Determine the 'size' of the block |
139
|
256
|
|
|
|
|
292
|
my $power = 10**( ( $#blocks - $_ ) * 3 ); |
140
|
256
|
|
|
|
|
245
|
my $hundred = int( $blocks[$_] / 100 ); |
141
|
256
|
|
|
|
|
199
|
my $teens = int( $blocks[$_] % 100 / 10 ); |
142
|
256
|
|
|
|
|
190
|
my $units = $blocks[$_] % 10; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# Process hundred numbers 'inside' the block |
145
|
|
|
|
|
|
|
# (ie. 235 in 235000 when dealing with thousands.) |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# Hundreds |
148
|
256
|
100
|
|
|
|
301
|
if ($hundred) { |
149
|
86
|
|
|
|
|
57
|
my $fr_hundred; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# We don't say 'un cent' |
152
|
86
|
100
|
|
|
|
137
|
$fr_hundred = $NUMBER_NAMES{$hundred} . ' ' |
153
|
|
|
|
|
|
|
unless $hundred == 1; |
154
|
|
|
|
|
|
|
|
155
|
86
|
|
|
|
|
72
|
$fr_hundred .= $NUMBER_NAMES{100}; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
# Cent prend un 's' quand il est multiplié par un autre |
158
|
|
|
|
|
|
|
# nombre et qu'il termine l'adjectif numéral. |
159
|
86
|
100
|
100
|
|
|
247
|
$fr_hundred .= 's' |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
160
|
|
|
|
|
|
|
if ( $hundred > 1 && !$teens && !$units && $_ == $#blocks ); |
161
|
|
|
|
|
|
|
|
162
|
86
|
|
|
|
|
95
|
push @fr_string, $fr_hundred; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Process number below 100 |
166
|
256
|
|
|
|
|
160
|
my $fr_decimal; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# No tens |
169
|
256
|
100
|
100
|
|
|
911
|
$fr_decimal = $NUMBER_NAMES{$units} |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
170
|
|
|
|
|
|
|
if ( $units && !$teens ) |
171
|
|
|
|
|
|
|
&& # On ne dit pas 'un mille' (A bit awkward to put here) |
172
|
|
|
|
|
|
|
!( $number == 1 && ( $power == 1000 ) ); |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# Cas spécial pour les 80 |
175
|
|
|
|
|
|
|
# On dit 'quatre-vingts' mais 'quatre-vingt-deux' |
176
|
256
|
100
|
100
|
|
|
811
|
if ( $teens == 8 ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
177
|
|
|
|
|
|
|
$fr_decimal = $units |
178
|
|
|
|
|
|
|
? $NUMBER_NAMES{ $teens * 10 } . '-' . $NUMBER_NAMES{$units} |
179
|
18
|
100
|
|
|
|
49
|
: $NUMBER_NAMES{ $teens * 10 } . 's'; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# Cas spécial pour les nombres en 70 et 90 |
183
|
|
|
|
|
|
|
elsif ( $teens == 7 || $teens == 9 ) { |
184
|
50
|
|
|
|
|
32
|
$units += 10; |
185
|
50
|
100
|
100
|
|
|
101
|
if ( $teens == 7 && $units == 11 ) { |
186
|
|
|
|
|
|
|
$fr_decimal = |
187
|
4
|
|
|
|
|
10
|
$NUMBER_NAMES{ $teens * 10 } . ' et ' . $NUMBER_NAMES{$units}; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
else { |
190
|
|
|
|
|
|
|
$fr_decimal = |
191
|
46
|
|
|
|
|
91
|
$NUMBER_NAMES{ $teens * 10 } . '-' . $NUMBER_NAMES{$units}; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# Un nombre s'écrit avec un trait d'union sauf s'il est associé |
197
|
|
|
|
|
|
|
# à 'cent' ou à 'mille'; ou s'il est relié par 'et'. |
198
|
|
|
|
|
|
|
# Nombres écrits avec des 'et': 21, 31, 51, 61, 71 |
199
|
|
|
|
|
|
|
elsif ($teens) { |
200
|
79
|
100
|
66
|
|
|
166
|
if ( $teens == 1 ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
201
|
44
|
|
|
|
|
75
|
$fr_decimal = $NUMBER_NAMES{ $teens * 10 + $units }; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
elsif ( $units == 1 || $units == 11 ) { |
204
|
|
|
|
|
|
|
$fr_decimal = |
205
|
5
|
|
|
|
|
13
|
$NUMBER_NAMES{ $teens * 10 } . ' et ' . $NUMBER_NAMES{$units}; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
elsif ( $units == 0 ) { |
208
|
3
|
|
|
|
|
7
|
$fr_decimal = $NUMBER_NAMES{ $teens * 10 }; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
else { |
211
|
|
|
|
|
|
|
$fr_decimal = |
212
|
27
|
|
|
|
|
74
|
$NUMBER_NAMES{ $teens * 10 } . '-' . $NUMBER_NAMES{$units}; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
256
|
100
|
|
|
|
354
|
push @fr_string, $fr_decimal if $fr_decimal; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Processing thousands, millions, billions, ... |
219
|
256
|
100
|
|
|
|
319
|
if ( $power >= 1e3 ) { |
220
|
122
|
|
|
|
|
74
|
my $fr_power; |
221
|
|
|
|
|
|
|
|
222
|
122
|
100
|
|
|
|
189
|
if ( exists $NUMBER_NAMES{$power} ) { |
223
|
108
|
|
|
|
|
100
|
$fr_power = $NUMBER_NAMES{$power}; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# Billion, milliard, etc. prennent un 's' au pluriel |
226
|
108
|
100
|
100
|
|
|
276
|
$fr_power .= 's' if $number > 1 && $power >= 1e6; |
227
|
|
|
|
|
|
|
|
228
|
108
|
|
|
|
|
114
|
push @fr_string, $fr_power; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# If the power we're looking dealing with doesn't exists |
232
|
|
|
|
|
|
|
# (ie. 1e15, 1e21) we multiply by the lowest power we have, |
233
|
|
|
|
|
|
|
# starting at 1e6. |
234
|
|
|
|
|
|
|
else { |
235
|
14
|
|
|
|
|
10
|
my $sub_power; |
236
|
14
|
|
|
|
|
13
|
my $pow_diff = 1; |
237
|
|
|
|
|
|
|
do { |
238
|
22
|
|
|
|
|
16
|
$pow_diff *= 1_000_000; |
239
|
22
|
|
|
|
|
66
|
$sub_power = $power / $pow_diff; |
240
|
14
|
|
|
|
|
10
|
} until exists $NUMBER_NAMES{$sub_power}; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
# If the power_diff doesn't exists (for really big |
243
|
|
|
|
|
|
|
# numbers), we do the same dance. |
244
|
14
|
50
|
|
|
|
24
|
unless ( exists $NUMBER_NAMES{$pow_diff} ) { |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
} |
247
|
14
|
|
|
|
|
10
|
$fr_power = $NUMBER_NAMES{$pow_diff}; |
248
|
14
|
100
|
|
|
|
24
|
$fr_power .= 's' if $number > 1; |
249
|
14
|
|
|
|
|
36
|
$fr_power .= " de $NUMBER_NAMES{$sub_power}s"; |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
# XXX Ugly hack - some architecture output "million de billion" instead of "trillion" |
252
|
14
|
|
|
|
|
16
|
$fr_power =~ s/million(s)? de billions?/trillion$1/g; |
253
|
|
|
|
|
|
|
|
254
|
14
|
|
|
|
|
16
|
push @fr_string, $fr_power; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
256
|
|
|
|
|
316
|
next; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
195
|
|
|
|
|
612
|
return join ( ' ', @fr_string ); |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub ordinate_to_fr { |
265
|
25
|
|
|
25
|
1
|
977
|
my $number = shift; |
266
|
|
|
|
|
|
|
|
267
|
25
|
100
|
|
|
|
44
|
unless ( $number > 0 ) { |
268
|
3
|
|
|
|
|
312
|
carp('Ordinates must be strictly positive'); |
269
|
3
|
|
|
|
|
14
|
return; |
270
|
|
|
|
|
|
|
} |
271
|
22
|
100
|
|
|
|
28
|
return $ORDINALS{1} if $number == 1; |
272
|
|
|
|
|
|
|
|
273
|
21
|
|
|
|
|
22
|
my $ordinal = number_to_fr($number); |
274
|
21
|
|
|
|
|
18
|
my $last_digit = $number % 10; |
275
|
|
|
|
|
|
|
|
276
|
21
|
100
|
66
|
|
|
60
|
if ( $last_digit != 1 && exists $ORDINALS{$last_digit} ) { |
277
|
5
|
|
|
|
|
6
|
my $replace = number_to_fr($last_digit); |
278
|
5
|
|
|
|
|
58
|
$ordinal =~ s/$replace$/$ORDINALS{$last_digit}/; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
21
|
|
|
|
|
62
|
$ordinal =~ s/e?$/ième/; |
282
|
21
|
|
|
|
|
25
|
$ordinal =~ s/vingtsième/vingtième/; # Bug #1772 |
283
|
21
|
|
|
|
|
43
|
$ordinal; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# |
287
|
|
|
|
|
|
|
# OO Methods |
288
|
|
|
|
|
|
|
# |
289
|
|
|
|
|
|
|
sub new { |
290
|
76
|
|
|
76
|
1
|
10425
|
my $class = shift; |
291
|
76
|
|
|
|
|
72
|
my $number = shift; |
292
|
76
|
|
|
|
|
142
|
bless \$number, $class; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub parse { |
296
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
297
|
0
|
0
|
|
|
|
0
|
if ( $_[0] ) { $$self = shift } |
|
0
|
|
|
|
|
0
|
|
298
|
0
|
|
|
|
|
0
|
$self; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub get_string { |
302
|
76
|
|
|
76
|
1
|
9387
|
my $self = shift; |
303
|
76
|
|
|
|
|
129
|
number_to_fr($$self); |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
sub get_ordinate { |
307
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
308
|
0
|
|
|
|
|
|
ordinate_to_fr($$self); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
1; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
__END__ |