File Coverage

blib/lib/Locale/CLDR/NumberFormatter.pm
Criterion Covered Total %
statement 256 358 71.5
branch 105 182 57.6
condition 44 71 61.9
subroutine 26 26 100.0
pod 0 6 0.0
total 431 643 67.0


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