File Coverage

blib/lib/Localizer/BuiltinFunctions.pm
Criterion Covered Total %
statement 27 29 93.1
branch 7 14 50.0
condition 3 9 33.3
subroutine 8 8 100.0
pod 0 4 0.0
total 45 64 70.3


line stmt bran cond sub pod time code
1             package Localizer::BuiltinFunctions;
2 5     5   31 use strict;
  5         10  
  5         138  
3 5     5   24 use warnings;
  5         18  
  5         155  
4 5     5   36 use utf8;
  5         24  
  5         40  
5 5     5   183 use 5.010_001;
  5         18  
6              
7 1     1 0 26 sub sprintf { sprintf(shift, @_) }
8              
9             # imported by Locale::Maketext
10             sub numf {
11 6     6 0 19 my($num) = @_[0,1];
12 6 50 33     50 if($num < 10_000_000_000 and $num > -10_000_000_000 and $num == int($num)) {
      33        
13 6         13 $num += 0; # Just use normal integer stringification.
14             # Specifically, don't let %G turn ten million into 1E+007
15             }
16             else {
17 0         0 $num = CORE::sprintf('%G', $num);
18             # "CORE::" is there to avoid confusion with the above sub sprintf.
19             }
20 6         40 while( $num =~ s/^([-+]?\d+)(\d{3})/$1,$2/s ) {1} # right from perlfaq5
  4         32  
21             # The initial \d+ gobbles as many digits as it can, and then we
22             # backtrack so it un-eats the rightmost three, and then we
23             # insert the comma there.
24              
25 6         33 return $num;
26             }
27              
28             # imported by Locale::Maketext
29             sub numerate {
30             # return this lexical item in a form appropriate to this number
31 4     4 0 12 my($num, @forms) = @_;
32 4         21 my $s = ($num == 1);
33              
34 4 50       9 return '' unless @forms;
35 4 50       13 if(@forms == 1) { # only the headword form specified
36 0 0       0 return $s ? $forms[0] : ($forms[0] . 's'); # very cheap hack.
37             }
38             else { # sing and plural were specified
39 4 100       41 return $s ? $forms[0] : $forms[1];
40             }
41             }
42              
43             # imported by Locale::Maketext
44             sub quant {
45 4     4 0 26 my($num, @forms) = @_;
46              
47 4 50       14 return $num if @forms == 0; # what should this mean?
48 4 50 33     13 return $forms[2] if @forms > 2 and $num == 0; # special zeroth case
49              
50             # Normal case:
51             # Note that the formatting of $num is preserved.
52 4         15 return( numf($num) . ' ' . numerate($num, @forms) );
53             # Most human languages put the number phrase before the qualified phrase.
54             }
55              
56             1;
57              
58             =head1 LICENSE
59              
60             Copyright (C) Tokuhiro Matsuno.
61              
62             This library is free software; you can redistribute it and/or modify
63             it under the same terms as Perl itself.
64