File Coverage

blib/lib/Locale/CLDR/NumberFormatter.pm
Criterion Covered Total %
statement 267 368 72.5
branch 110 182 60.4
condition 47 71 66.2
subroutine 27 27 100.0
pod 0 7 0.0
total 451 655 68.8


line stmt bran cond sub pod time code
1             package Locale::CLDR::NumberFormatter;
2              
3 21     21   13007 use version;
  21         62  
  21         132  
4              
5             our $VERSION = version->declare('v0.34.2');
6              
7              
8 21     21   2246 use v5.10.1;
  21         94  
9 21     21   122 use mro 'c3';
  21         52  
  21         138  
10 21     21   844 use utf8;
  21         66  
  21         160  
11 21     21   871 use if $^V ge v5.12.0, feature => 'unicode_strings';
  21         49  
  21         313  
12              
13 21     21   2290 use Moo::Role;
  21         54  
  21         188  
14              
15             sub format_number {
16 775     775 0 3194 my ($self, $number, $format, $currency, $for_cash) = @_;
17            
18             # Check if the locales numbering system is algorithmic. If so ignore the format
19 775         2229 my $numbering_system = $self->default_numbering_system();
20 775 50       3071 if ($self->numbering_system->{$numbering_system}{type} eq 'algorithmic') {
21 0         0 $format = $self->numbering_system->{$numbering_system}{data};
22 0         0 return $self->_algorithmic_number_format($number, $format);
23             }
24            
25 775   100     3434 $format //= '0';
26            
27 775         2405 return $self->_format_number($number, $format, $currency, $for_cash);
28             }
29              
30             sub format_currency {
31 16     16 0 54 my ($self, $number, $for_cash) = @_;
32            
33 16         59 my $format = $self->currency_format;
34 16         65 return $self->format_number($number, $format, undef(), $for_cash);
35             }
36              
37             sub _format_number {
38 777     777   1516 my ($self, $number, $format, $currency, $for_cash) = @_;
39            
40             # First check to see if this is an algorithmic format
41 777         1966 my @valid_formats = $self->_get_valid_algorithmic_formats();
42            
43 777 100       1832 if (grep {$_ eq $format} @valid_formats) {
  15540         24979  
44 5         29 return $self->_algorithmic_number_format($number, $format);
45             }
46            
47             # Some of these algorithmic formats are in locale/type/name format
48 772 50       2608 if (my ($locale_id, $type, $format) = $format =~ m(^(.*?)/(.*?)/(.*?)$)) {
49 0         0 my $locale = Locale::CLDR->new($locale_id);
50 0         0 return $locale->format_number($number, $format);
51             }
52            
53 772         1244 my $currency_data;
54            
55             # Check if we need a currency and have not been given one.
56             # In that case we look up the default currency for the locale
57 772 100       3109 if ($format =~ tr/¤/¤/) {
58            
59 17   100     79 $for_cash //=0;
60            
61 17 50       98 $currency = $self->default_currency()
62             if ! defined $currency;
63            
64 17         56 $currency_data = $self->_get_currency_data($currency);
65            
66 17         58 $currency = $self->currency_symbol($currency);
67             }
68            
69 772         2304 $format = $self->parse_number_format($format, $currency, $currency_data, $for_cash);
70            
71 772         2019 $number = $self->get_formatted_number($number, $format, $currency_data, $for_cash);
72            
73 772         3863 return $number;
74             }
75              
76             sub add_currency_symbol {
77 17     17 0 41 my ($self, $format, $symbol) = @_;
78            
79            
80 17         153 $format =~ s/¤/'$symbol'/g;
81            
82 17         59 return $format;
83             }
84              
85             sub _get_currency_data {
86 17     17   40 my ($self, $currency) = @_;
87            
88 17         75 my $currency_data = $self->currency_fractions($currency);
89            
90 17         27 return $currency_data;
91             }
92              
93             sub _get_currency_rounding {
94              
95 34     34   77 my ($self, $currency_data, $for_cash) = @_;
96            
97 34 100       70 my $rounder = $for_cash ? 'cashrounding' : 'rounding' ;
98            
99 34         82 return $currency_data->{$rounder};
100             }
101              
102             sub _get_currency_digits {
103 17     17   46 my ($self, $currency_data, $for_cash) = @_;
104            
105 17 100       48 my $digits = $for_cash ? 'cashdigits' : 'digits' ;
106            
107 17         64 return $currency_data->{$digits};
108             }
109              
110             sub parse_number_format {
111 774     774 0 1774 my ($self, $format, $currency, $currency_data, $for_cash) = @_;
112              
113 21     21   28660 use feature 'state';
  21         69  
  21         12129  
114            
115 774         1200 state %cache;
116            
117 774 100       2620 return $cache{$format} if exists $cache{$format};
118            
119 27 100       115 $format = $self->add_currency_symbol($format, $currency)
120             if defined $currency;
121            
122 27         251 my ($positive, $negative) = $format =~ /^( (?: (?: ' [^']* ' )*+ | [^';]+ )+ ) (?: ; (.+) )? $/x;
123            
124 27   66     164 $negative //= "-$positive";
125            
126 27         60 my $type = 'positive';
127 27         76 foreach my $to_parse ( $positive, $negative ) {
128 54         97 my ($prefix, $suffix);
129 54 100       331 if (($prefix) = $to_parse =~ /^ ( (?: [^0-9@#.,E'*] | (?: ' [^']* ' )++ )+ ) /x) {
130 43         243 $to_parse =~ s/^ ( (?: [^0-9@#.,E'*] | (?: ' [^']* ' )++ )+ ) //x;
131             }
132 54 100       408 if( ($suffix) = $to_parse =~ / ( (?: [^0-9@#.,E'] | (?: ' [^']* ' )++ )+ ) $ /x) {
133 15         111 $to_parse =~ s/( (?:[^0-9@#.,E'] | (?: ' [^']* ' )++ )+ ) $//x;
134             }
135            
136             # Fix escaped ', - and +
137 54         126 foreach my $str ($prefix, $suffix) {
138 108   100     334 $str //= '';
139 108         367 $str =~ s/(?: ' (?: (?: '' )++ | [^']+ ) ' )*? \K ( [-+\\] ) /\\$1/gx;
140 108         334 $str =~ s/ ' ( (?: '' )++ | [^']++ ) ' /$1/gx;
141 108         284 $str =~ s/''/'/g;
142             }
143            
144             # Look for padding
145 54         91 my ($pad_character, $pad_location);
146 54 50       354 if (($pad_character) = $prefix =~ /^\*(\p{Any})/ ) {
    50          
    50          
    100          
147 0         0 $prefix =~ s/^\*(\p{Any})//;
148 0         0 $pad_location = 'before prefix';
149             }
150             elsif ( ($pad_character) = $prefix =~ /\*(\p{Any})$/ ) {
151 0         0 $prefix =~ s/\*(\p{Any})$//;
152 0         0 $pad_location = 'after prefix';
153             }
154             elsif (($pad_character) = $suffix =~ /^\*(\p{Any})/ ) {
155 0         0 $suffix =~ s/^\*(\p{Any})//;
156 0         0 $pad_location = 'before suffix';
157             }
158             elsif (($pad_character) = $suffix =~ /\*(\p{Any})$/ ) {
159 1         6 $suffix =~ s/\*(\p{Any})$//;
160 1         3 $pad_location = 'after suffix';
161             }
162            
163 54 100       151 my $pad_length = defined $pad_character
164             ? length($prefix) + length($to_parse) + length($suffix) + 2
165             : 0;
166            
167             # Check for a multiplier
168 54         87 my $multiplier = 1;
169 54 100 66     301 $multiplier = 100 if $prefix =~ tr/%/%/ || $suffix =~ tr/%/%/;
170 54 100 66     338 $multiplier = 1000 if $prefix =~ tr/‰/‰/ || $suffix =~ tr/‰/‰/;
171            
172 54         146 my $rounding = $to_parse =~ / ( [1-9] [0-9]* (?: \. [0-9]+ )? ) /x;
173 54   50     212 $rounding ||= 0;
174            
175 54 100       157 $rounding = $self->_get_currency_rounding($currency_data, $for_cash)
176             if defined $currency;
177            
178 54         208 my ($integer, $decimal) = split /\./, $to_parse;
179            
180 54         120 my ($minimum_significant_digits, $maximum_significant_digits, $minimum_digits);
181 54 50       154 if (my ($digits) = $to_parse =~ /(\@+)/) {
182 0         0 $minimum_significant_digits = length $digits;
183 0         0 ($digits ) = $to_parse =~ /\@(#+)/;
184 0   0     0 $maximum_significant_digits = $minimum_significant_digits + length ($digits // '');
185             }
186             else {
187 54         119 $minimum_digits = $integer =~ tr/0-9/0-9/;
188             }
189            
190             # Check for exponent
191 54         97 my $exponent_digits = 0;
192 54         97 my $need_plus = 0;
193 54         146 my $exponent;
194             my $major_group;
195 54         0 my $minor_group;
196 54 50       125 if ($to_parse =~ tr/E/E/) {
197 0         0 ($need_plus, $exponent) = $to_parse =~ m/ E ( \+? ) ( [0-9]+ ) /x;
198 0         0 $exponent_digits = length $exponent;
199             }
200             else {
201             # Check for grouping
202 54         156 my ($grouping) = split /\./, $to_parse;
203 54         194 my @groups = split /,/, $grouping;
204 54         97 shift @groups;
205 54         115 ($major_group, $minor_group) = map {length} @groups;
  48         168  
206 54   100     213 $minor_group //= $major_group;
207             }
208            
209 54   50     856 $cache{$format}{$type} = {
      50        
      100        
      50        
210             prefix => $prefix // '',
211             suffix => $suffix // '',
212             pad_character => $pad_character,
213             pad_location => $pad_location // 'none',
214             pad_length => $pad_length,
215             multiplier => $multiplier,
216             rounding => $rounding,
217             minimum_significant_digits => $minimum_significant_digits,
218             maximum_significant_digits => $maximum_significant_digits,
219             minimum_digits => $minimum_digits // 0,
220             exponent_digits => $exponent_digits,
221             exponent_needs_plus => $need_plus,
222             major_group => $major_group,
223             minor_group => $minor_group,
224             };
225            
226 54         181 $type = 'negative';
227             }
228            
229 27         114 return $cache{$format};
230             }
231              
232             # Rounding function
233             sub round {
234 17     17 0 44 my ($self, $number, $increment, $decimal_digits) = @_;
235              
236 17 50       38 if ($increment ) {
237 0         0 $increment /= 10 ** $decimal_digits;
238 0         0 $number /= $increment;
239 0         0 $number = int ($number + .5 );
240 0         0 $number *= $increment;
241             }
242            
243 17 50       36 if ( $decimal_digits ) {
244 17         36 $number *= 10 ** $decimal_digits;
245 17         32 $number = int $number;
246 17         38 $number /= 10 ** $decimal_digits;
247            
248 17         134 my ($decimal) = $number =~ /(\..*)/;
249 17   100     85 $decimal //= '.'; # No fraction so add a decimal point
250            
251 17         72 $number = int ($number) . $decimal . ('0' x ( $decimal_digits - length( $decimal ) +1 ));
252             }
253             else {
254             # No decimal digits wanted
255 0         0 $number = int $number;
256             }
257            
258 17         44 return $number;
259             }
260              
261             sub get_formatted_number {
262 772     772 0 1551 my ($self, $number, $format, $currency_data, $for_cash) = @_;
263            
264 772         1588 my @digits = $self->get_digits;
265 772         2417 my @number_symbols_bundles = reverse $self->_find_bundle('number_symbols');
266 772         5624 my %symbols;
267 772         1640 foreach my $bundle (@number_symbols_bundles) {
268 1544         3902 my $current_symbols = $bundle->number_symbols;
269 1544         7139 foreach my $type (keys %$current_symbols) {
270 36284         46657 foreach my $symbol (keys %{$current_symbols->{$type}}) {
  36284         68971  
271 69480         147190 $symbols{$type}{$symbol} = $current_symbols->{$type}{$symbol};
272             }
273             }
274             }
275            
276 772         2648 my $symbols_type = $self->default_numbering_system;
277            
278 772 50       2453 $symbols_type = $symbols{$symbols_type}{alias} if exists $symbols{$symbols_type}{alias};
279            
280 772 100       2618 my $type = $number=~ s/^-// ? 'negative' : 'positive';
281            
282 772         1786 $number *= $format->{$type}{multiplier};
283            
284 772 100 66     3152 if ($format->{rounding} || defined $for_cash) {
285 17         36 my $decimal_digits = 0;
286            
287 17 50       57 if (defined $for_cash) {
288 17         66 $decimal_digits = $self->_get_currency_digits($currency_data, $for_cash)
289             }
290            
291 17         71 $number = $self->round($number, $format->{$type}{rounding}, $decimal_digits);
292             }
293            
294 772         1914 my $pad_zero = $format->{$type}{minimum_digits} - length "$number";
295 772 100       1852 if ($pad_zero > 0) {
296 4         11 $number = ('0' x $pad_zero) . $number;
297             }
298            
299             # Handle grouping
300 772         2735 my ($integer, $decimal) = split /\./, $number;
301              
302 772         2716 my $minimum_grouping_digits = $self->_find_bundle('minimum_grouping_digits');
303 772 50       6542 $minimum_grouping_digits = $minimum_grouping_digits
304             ? $minimum_grouping_digits->minimum_grouping_digits()
305             : 0;
306            
307 772         2162 my ($separator, $decimal_point) = ($symbols{$symbols_type}{group}, $symbols{$symbols_type}{decimal});
308 772 50 33     3644 if (($minimum_grouping_digits && length $integer >= $minimum_grouping_digits) || ! $minimum_grouping_digits) {
      33        
309 772         1901 my ($minor_group, $major_group) = ($format->{$type}{minor_group}, $format->{$type}{major_group});
310            
311 772 100 66     2040 if (defined $minor_group && $separator) {
312             # Fast commify using unpack
313 27         91 my $pattern = "(A$minor_group)(A$major_group)*";
314 27         160 $number = reverse join $separator, grep {length} unpack $pattern, reverse $integer;
  61         173  
315             }
316             else {
317 745         1434 $number = $integer;
318             }
319             }
320             else {
321 0         0 $number = $integer;
322             }
323            
324 772 100       1649 $number.= "$decimal_point$decimal" if defined $decimal;
325            
326             # Fix digits
327 772         3747 $number =~ s/([0-9])/$digits[$1]/eg;
  958         3503  
328            
329 772         2362 my ($prefix, $suffix) = ( $format->{$type}{prefix}, $format->{$type}{suffix});
330            
331             # This needs fixing for escaped symbols
332 772         1549 foreach my $string ($prefix, $suffix) {
333 1544         2569 $string =~ s/%/$symbols{$symbols_type}{percentSign}/;
334 1544         2161 $string =~ s/‰/$symbols{$symbols_type}{perMille}/;
335 1544 100       2802 if ($type eq 'negative') {
336 24         97 $string =~ s/(?: \\ \\ )*+ \K \\ - /$symbols{$symbols_type}{minusSign}/x;
337 24         57 $string =~ s/(?: \\ \\)*+ \K \\ + /$symbols{$symbols_type}{minusSign}/x;
338             }
339             else {
340 1520         2140 $string =~ s/(?: \\ \\ )*+ \K \\ - //x;
341 1520         2225 $string =~ s/(?: \\ \\ )*+ \K \\ + /$symbols{$symbols_type}{plusSign}/x;
342             }
343 1544         2538 $string =~ s/ \\ \\ /\\/gx;
344             }
345            
346 772         1789 $number = $prefix . $number . $suffix;
347            
348 772         13010 return $number;
349             }
350              
351             # Get the digits for the locale. Assumes a numeric numbering system
352             sub get_digits {
353 773     773 0 2678 my $self = shift;
354            
355 773         2212 my $numbering_system = $self->default_numbering_system();
356            
357 773 50       2789 $numbering_system = 'latn' unless $self->numbering_system->{$numbering_system}{type} eq 'numeric'; # Fall back to latn if the numbering system is not numeric
358            
359 773         1645 my $digits = $self->numbering_system->{$numbering_system}{data};
360            
361 773         2389 return @$digits;
362             }
363              
364             # RBNF
365             # Note that there are a couple of assumptions with the way
366             # I handle Rule Base Number Formats.
367             # 1) The number is treated as a string for as long as possible
368             # This allows things like -0.0 to be correctly formatted
369             # 2) There is no fall back. All the rule sets are self contained
370             # in a bundle. Fall back is used to find a bundle but once a
371             # bundle is found no further processing of the bundle chain
372             # is done. This was found by trial and error when attempting
373             # to process -0.0 correctly into English.
374             sub _get_valid_algorithmic_formats {
375 777     777   1441 my $self = shift;
376            
377 777         2202 my @formats = map { @{$_->valid_algorithmic_formats()} } $self->_find_bundle('valid_algorithmic_formats');
  1554         6466  
  1554         7598  
378            
379 777         1674 my %seen;
380 777         1463 return sort grep { ! $seen{$_}++ } @formats;
  19425         45983  
381             }
382              
383             # Main entry point to RBNF
384             sub _algorithmic_number_format {
385 8     8   37 my ($self, $number, $format_name, $type) = @_;
386            
387 8         30 my $format_data = $self->_get_algorithmic_number_format_data_by_name($format_name, $type);
388            
389 8 50       23 return $number unless $format_data;
390            
391 8         38 return $self->_process_algorithmic_number_data($number, $format_data);
392             }
393              
394             sub _get_algorithmic_number_format_data_by_name {
395 8     8   21 my ($self, $format_name, $type) = @_;
396            
397             # Some of these algorithmic formats are in locale/type/name format
398 8 50       31 if (my ($locale_id, undef, $format) = $format_name =~ m(^(.*?)/(.*?)/(.*?)$)) {
399 0         0 my $locale = Locale::CLDR->new($locale_id);
400 0 0       0 return $locale->_get_algorithmic_number_format_data_by_name($format, $type)
401             if $locale;
402              
403 0         0 return undef;
404             }
405            
406 8   100     51 $type //= 'public';
407            
408 8         16 my %data = ();
409            
410 8         29 my @data_bundles = $self->_find_bundle('algorithmic_number_format_data');
411 8         67 foreach my $data_bundle (@data_bundles) {
412 10         31 my $data = $data_bundle->algorithmic_number_format_data();
413 10 100       31 next unless $data->{$format_name};
414 8 50       28 next unless $data->{$format_name}{$type};
415            
416 8         26 foreach my $rule (keys %{$data->{$format_name}{$type}}) {
  8         81  
417 196         397 $data{$rule} = $data->{$format_name}{$type}{$rule};
418             }
419            
420 8         23 last;
421             }
422            
423 8 50       36 return keys %data ? \%data : undef;
424             }
425              
426             sub _get_plural_form {
427 1     1   5 my ($self, $plural, $from) = @_;
428            
429 1         31 my ($result) = $from =~ /$plural\{(.+?)\}/;
430 1 50       5 ($result) = $from =~ /other\{(.+?)\}/ unless defined $result;
431            
432 1         6 return $result;
433             }
434              
435             sub _process_algorithmic_number_data {
436 14     14   46 my ($self, $number, $format_data, $plural, $in_fraction_rule_set) = @_;
437            
438 14   100     62 $in_fraction_rule_set //= 0;
439            
440 14         40 my $format = $self->_get_algorithmic_number_format($number, $format_data);
441            
442 14         2018 my $format_rule = $format->{rule};
443 14 100 66     102 if (! $plural && $format_rule =~ /(cardinal|ordinal)/) {
444 3         11 my $type = $1;
445 3         18 $plural = $self->plural($number, $type);
446 3         13 $plural = [$type, $plural];
447             }
448            
449             # Sort out plural forms
450 14 100       34 if ($plural) {
451 3         70 $format_rule =~ s/\$\($plural->[0],(.+)\)\$/$self->_get_plural_form($plural->[1],$1)/eg;
  1         8  
452             }
453            
454 14         37 my $divisor = $format->{divisor};
455 14   100     58 my $base_value = $format->{base_value} // '';
456            
457             # Negative numbers
458 14 100       57 if ($number =~ /^-/) {
    100          
459 1         4 my $positive_number = $number;
460 1         12 $positive_number =~ s/^-//;
461            
462 1 50       27 if ($format_rule =~ /→→/) {
    0          
    0          
    0          
    0          
463 1         6 $format_rule =~ s/→→/$self->_process_algorithmic_number_data($positive_number, $format_data, $plural)/e;
  1         5  
464             }
465             elsif((my $rule_name) = $format_rule =~ /→(.+)→/) {
466 0         0 my $type = 'public';
467 0 0       0 if ($rule_name =~ s/^%%/%/) {
468 0         0 $type = 'private';
469             }
470 0         0 my $format_data = $self->_get_algorithmic_number_format_data_by_name($rule_name, $type);
471 0 0       0 if($format_data) {
472             # was a valid name
473 0         0 $format_rule =~ s/→(.+)→/$self->_process_algorithmic_number_data($positive_number, $format_data, $plural)/e;
  0         0  
474             }
475             else {
476             # Assume a format
477 0         0 $format_rule =~ s/→(.+)→/$self->_format_number($positive_number, $1)/e;
  0         0  
478             }
479             }
480             elsif($format_rule =~ /=%%.*=/) {
481 0         0 $format_rule =~ s/=%%(.*?)=/$self->_algorithmic_number_format($number, $1, 'private')/eg;
  0         0  
482             }
483             elsif($format_rule =~ /=%.*=/) {
484 0         0 $format_rule =~ s/=%(.*?)=/$self->_algorithmic_number_format($number, $1, 'public')/eg;
  0         0  
485             }
486             elsif($format_rule =~ /=.*=/) {
487 0         0 $format_rule =~ s/=(.*?)=/$self->_format_number($number, $1)/eg;
  0         0  
488             }
489             }
490             # Fractions
491             elsif( $number =~ /\./ ) {
492 2         5 my $in_fraction_rule_set = 1;
493 2         17 my ($integer, $fraction) = $number =~ /^([^.]*)\.(.*)$/;
494            
495 2 50 33     28 if ($number >= 0 && $number < 1) {
496 2         10 $format_rule =~ s/\[.*\]//;
497             }
498             else {
499 0         0 $format_rule =~ s/[\[\]]//g;
500             }
501            
502 2 100       12 if ($format_rule =~ /→→/) {
    50          
503 1         5 $format_rule =~ s/→→/$self->_process_algorithmic_number_data_fractions($fraction, $format_data, $plural)/e;
  1         56  
504             }
505             elsif((my $rule_name) = $format_rule =~ /→(.*)→/) {
506 0         0 my $type = 'public';
507 0 0       0 if ($rule_name =~ s/^%%/%/) {
508 0         0 $type = 'private';
509             }
510 0         0 my $format_data = $self->_get_algorithmic_number_format_data_by_name($rule_name, $type);
511 0 0       0 if ($format_data) {
512 0         0 $format_rule =~ s/→(.*)→/$self->_process_algorithmic_number_data_fractions($fraction, $format_data, $plural)/e;
  0         0  
513             }
514             else {
515 0         0 $format_rule =~ s/→(.*)→/$self->_format_number($fraction, $1)/e;
  0         0  
516             }
517             }
518            
519 2 100       12 if ($format_rule =~ /←←/) {
    50          
520 1         6 $format_rule =~ s/←←/$self->_process_algorithmic_number_data($integer, $format_data, $plural, $in_fraction_rule_set)/e;
  1         5  
521             }
522             elsif((my $rule_name) = $format_rule =~ /←(.+)←/) {
523 0         0 my $type = 'public';
524 0 0       0 if ($rule_name =~ s/^%%/%/) {
525 0         0 $type = 'private';
526             }
527 0         0 my $format_data = $self->_get_algorithmic_number_format_data_by_name($rule_name, $type);
528 0 0       0 if ($format_data) {
529 0         0 $format_rule =~ s/←(.*)←/$self->_process_algorithmic_number_data($integer, $format_data, $plural, $in_fraction_rule_set)/e;
  0         0  
530             }
531             else {
532 0         0 $format_rule =~ s/←(.*)←/$self->_format_number($integer, $1)/e;
  0         0  
533             }
534             }
535            
536 2 100       19 if($format_rule =~ /=.*=/) {
537 1 50       29 if($format_rule =~ /=%%.*=/) {
    50          
538 0         0 $format_rule =~ s/=%%(.*?)=/$self->_algorithmic_number_format($number, $1, 'private')/eg;
  0         0  
539             }
540             elsif($format_rule =~ /=%.*=/) {
541 1         11 $format_rule =~ s/=%(.*?)=/$self->_algorithmic_number_format($number, $1, 'public')/eg;
  1         6  
542             }
543             else {
544 0         0 $format_rule =~ s/=(.*?)=/$self->_format_number($integer, $1)/eg;
  0         0  
545             }
546             }
547             }
548            
549             # Everything else
550             else {
551             # At this stage we have a non negative integer
552 11 100       55 if ($format_rule =~ /\[.*\]/) {
553 3 50 33     24 if ($in_fraction_rule_set && $number * $base_value == 1) {
    50 33        
554 0         0 $format_rule =~ s/\[.*\]//;
555             }
556             # Not fractional rule set Number is a multiple of $divisor and the multiple is even
557             elsif (! $in_fraction_rule_set && ! ($number % $divisor) ) {
558 0         0 $format_rule =~ s/\[.*\]//;
559             }
560             else {
561 3         20 $format_rule =~ s/[\[\]]//g;
562             }
563             }
564            
565 11 100       26 if ($in_fraction_rule_set) {
566 2 50       36 if (my ($rule_name) = $format_rule =~ /←(.*)←/) {
    50          
567 0 0       0 if (length $rule_name) {
568 0         0 my $type = 'public';
569 0 0       0 if ($rule_name =~ s/^%%/%/) {
570 0         0 $type = 'private';
571             }
572 0         0 my $format_data = $self->_get_algorithmic_number_format_data_by_name($rule_name, $type);
573 0 0       0 if ($format_data) {
574 0         0 $format_rule =~ s/←(.*)←/$self->_process_algorithmic_number_data($number * $base_value, $format_data, $plural, $in_fraction_rule_set)/e;
  0         0  
575             }
576             else {
577 0         0 $format_rule =~ s/←(.*)←/$self->_format_number($number * $base_value, $1)/e;
  0         0  
578             }
579             }
580             else {
581 0         0 $format_rule =~ s/←←/$self->_process_algorithmic_number_data($number * $base_value, $format_data, $plural, $in_fraction_rule_set)/e;
  0         0  
582             }
583             }
584             elsif($format_rule =~ /=.*=/) {
585 0         0 $format_rule =~ s/=(.*?)=/$self->_format_number($number, $1)/eg;
  0         0  
586             }
587             }
588             else {
589 9 100       43 if (my ($rule_name) = $format_rule =~ /→(.*)→/) {
590 3 50       12 if (length $rule_name) {
591 0         0 my $type = 'public';
592 0 0       0 if ($rule_name =~ s/^%%/%/) {
593 0         0 $type = 'private';
594             }
595 0         0 my $format_data = $self->_get_algorithmic_number_format_data_by_name($rule_name, $type);
596 0 0       0 if ($format_data) {
597 0         0 $format_rule =~ s/→(.+)→/$self->_process_algorithmic_number_data($number % $divisor, $format_data, $plural)/e;
  0         0  
598             }
599             else {
600 0         0 $format_rule =~ s/→(.*)→/$self->_format_number($number % $divisor, $1)/e;
  0         0  
601             }
602             }
603             else {
604 3         13 $format_rule =~ s/→→/$self->_process_algorithmic_number_data($number % $divisor, $format_data, $plural)/e;
  3         14  
605             }
606             }
607            
608 9 50       35 if (my ($rule_name) = $format_rule =~ /←(.*)←/) {
609 0 0       0 if (length $rule_name) {
610 0         0 my $type = 'public';
611 0 0       0 if ($rule_name =~ s/^%%/%/) {
612 0         0 $type = 'private';
613             }
614 0         0 my $format_data = $self->_get_algorithmic_number_format_data_by_name($rule_name, $type);
615 0 0       0 if ($format_data) {
616 0         0 $format_rule =~ s|←(.*)←|$self->_process_algorithmic_number_data(int ($number / $divisor), $format_data, $plural)|e;
  0         0  
617             }
618             else {
619 0         0 $format_rule =~ s|←(.*)←|$self->_format_number(int($number / $divisor), $1)|e;
  0         0  
620             }
621             }
622             else {
623 0         0 $format_rule =~ s|←←|$self->_process_algorithmic_number_data(int($number / $divisor), $format_data, $plural)|e;
  0         0  
624             }
625             }
626            
627 9 100       36 if($format_rule =~ /=.*=/) {
628 4 50       38 if($format_rule =~ /=%%.*=/) {
    100          
629 0         0 $format_rule =~ s/=%%(.*?)=/$self->_algorithmic_number_format($number, $1, 'private')/eg;
  0         0  
630             }
631             elsif($format_rule =~ /=%.*=/) {
632 2         17 $format_rule =~ s/=%(.*?)=/$self->_algorithmic_number_format($number, $1, 'public')/eg;
  2         29  
633             }
634             else {
635 2         11 $format_rule =~ s/=(.*?)=/$self->_format_number($number, $1)/eg;
  2         15  
636             }
637             }
638             }
639             }
640            
641 14         116 return $format_rule;
642             }
643              
644             sub _process_algorithmic_number_data_fractions {
645 1     1   16 my ($self, $fraction, $format_data, $plural) = @_;
646            
647 1         3 my $result = '';
648 1         6 foreach my $digit (split //, $fraction) {
649 1         16 $result .= $self->_process_algorithmic_number_data($digit, $format_data, $plural, 1);
650             }
651            
652 1         5 return $result;
653             }
654              
655             sub _get_algorithmic_number_format {
656 14     14   29 my ($self, $number, $format_data) = @_;
657            
658 21     21   157137 use bigfloat;
  21         65489  
  21         124  
659 14 50 66     52 return $format_data->{'-x'} if $number =~ /^-/ && exists $format_data->{'-x'};
660 13 100 100     54 return $format_data->{'x.x'} if $number =~ /\./ && exists $format_data->{'x.x'};
661 12 100 66     145 return $format_data->{0} if $number == 0 || $number =~ /^-/;
662 6 100       1176 return $format_data->{max} if $number >= $format_data->{max}{base_value};
663            
664 4         13 my $previous = 0;
665 4         109 foreach my $key (sort { $a <=> $b } grep /^[0-9]+$/, keys %$format_data) {
  524         719  
666 71 100       1046 next if $key == 0;
667 67 100       14147 return $format_data->{$key} if $number == $key;
668 66 100       147 return $format_data->{$previous} if $number < $key;
669 63         112 $previous = $key;
670             }
671             }
672              
673 21     21   2161573 no Moo::Role;
  21         68  
  21         266  
674              
675             1;
676              
677             # vim: tabstop=4