File Coverage

blib/lib/Data/Unixish/num.pm
Criterion Covered Total %
statement 69 71 97.1
branch 18 24 75.0
condition 14 15 93.3
subroutine 14 14 100.0
pod 1 1 100.0
total 116 125 92.8


line stmt bran cond sub pod time code
1             package Data::Unixish::num;
2              
3             our $DATE = '2019-01-06'; # DATE
4             our $VERSION = '1.570'; # VERSION
5              
6 1     1   518 use 5.010;
  1         7  
7 1     1   405 use locale;
  1         619  
  1         6  
8 1     1   38 use strict;
  1         2  
  1         22  
9 1     1   407 use syntax 'each_on_array'; # to support perl < 5.12
  1         24356  
  1         4  
10 1     1   3550 use warnings;
  1         3  
  1         29  
11             #use Log::Any '$log';
12              
13 1     1   466 use Data::Unixish::Util qw(%common_args);
  1         3  
  1         123  
14 1     1   547 use Number::Format;
  1         5141  
  1         51  
15 1     1   444 use Number::Format::Metric qw(format_metric);
  1         682  
  1         64  
16 1     1   8 use POSIX qw(locale_h);
  1         2  
  1         5  
17 1     1   199 use Scalar::Util 'looks_like_number';
  1         2  
  1         833  
18              
19             our %SPEC;
20              
21             my %styles = (
22             general => 'General formatting, e.g. 1, 2.345',
23             fixed => 'Fixed number of decimal digits, e.g. 1.00, default decimal digits=2',
24             scientific => 'Scientific notation, e.g. 1.23e+21',
25             kilo => 'Use K/M/G/etc suffix with base-2, e.g. 1.2M',
26             kibi => 'Use Ki/Mi/GiB/etc suffix with base-10 [1000], e.g. 1.2Mi',
27             percent => 'Percentage, e.g. 10.00%',
28             # XXX fraction
29             # XXX currency?
30             );
31              
32             # XXX negative number -X or (X)
33             # XXX colorize negative number?
34             # XXX leading zeros/spaces
35              
36             $SPEC{num} = {
37             v => 1.1,
38             summary => 'Format number',
39             description => <<'_',
40              
41             Observe locale environment variable settings.
42              
43             Undef and non-numbers are ignored.
44              
45             _
46             args => {
47             %common_args,
48             style => {
49             schema=>['str*', in=>[keys %styles], default=>'general'],
50             cmdline_aliases => { s=>{} },
51             pos => 0,
52             description => "Available styles:\n\n".
53             join("", map {" * $_ ($styles{$_})\n"} sort keys %styles),
54             },
55             decimal_digits => {
56             schema => ['int*'],
57             summary => 'Number of digits to the right of decimal point',
58             },
59             thousands_sep => {
60             summary => 'Use a custom thousand separator character',
61             description => <<'_',
62              
63             Default is from locale (e.g. dot "." for en_US, etc).
64              
65             Use empty string "" if you want to disable printing thousands separator.
66              
67             _
68             schema => ['str*'],
69             },
70             prefix => {
71             summary => 'Add some string at the beginning (e.g. for currency)',
72             schema => ['str*'],
73             },
74             suffix => {
75             summary => 'Add some string at the end (e.g. for unit)',
76             schema => ['str*'],
77             },
78             },
79             tags => [qw/formatting itemfunc datatype:num/],
80             };
81             sub num {
82 7     7 1 28 my %args = @_;
83 7         18 my ($in, $out) = ($args{in}, $args{out});
84              
85 7         15 my $orig_locale = _num_begin(\%args);
86 7         35 while (my ($index, $item) = each @$in) {
87 41         107 push @$out, _num_item($item, \%args);
88             }
89 7         19 _num_end(\%args, $orig_locale);
90              
91 7         58 [200, "OK"];
92             }
93              
94             sub _num_begin {
95 13     13   23 my $args = shift;
96              
97 13   100     45 $args->{style} //= 'general';
98 13 50       37 $args->{style} = 'general' if !$styles{$args->{style}};
99              
100 13   100     68 $args->{prefix} //= "";
101 13   100     46 $args->{suffix} //= "";
102             $args->{decimal_digits} //=
103 13 100 100     94 ($args->{style} eq 'kilo' || $args->{style} eq 'kibi' ? 1 : 2);
      66        
104              
105 13         56 my $orig_locale = setlocale(LC_ALL);
106 13 50       37 if ($ENV{LC_NUMERIC}) {
    0          
    0          
107 13         79 setlocale(LC_NUMERIC, $ENV{LC_NUMERIC});
108             } elsif ($ENV{LC_ALL}) {
109 0         0 setlocale(LC_ALL, $ENV{LC_ALL});
110             } elsif ($ENV{LANG}) {
111 0         0 setlocale(LC_ALL, $ENV{LANG});
112             }
113              
114             # args abused to store object/state
115 13         24 my %nfargs;
116 13 100       36 if (defined $args->{thousands_sep}) {
117 2         3 $nfargs{THOUSANDS_SEP} = $args->{thousands_sep};
118             }
119 13         48 $args->{_nf} = Number::Format->new(%nfargs);
120              
121 13         4174 return $orig_locale;
122             }
123              
124             sub _num_item {
125 75     75   126 my ($item, $args) = @_;
126              
127             {
128 75 100 100     94 last if !defined($item) || !looks_like_number($item);
  75         296  
129 31         59 my $nf = $args->{_nf};
130 31         39 my $style = $args->{style};
131 31         46 my $decdigs = $args->{decimal_digits};
132              
133 31 100       104 if ($style eq 'fixed') {
    100          
    100          
    100          
    100          
134 6         14 $item = $nf->format_number($item, $decdigs, $decdigs);
135             } elsif ($style eq 'scientific') {
136 3         18 $item = sprintf("%.${decdigs}e", $item);
137             } elsif ($style eq 'kilo') {
138 6         33 my $res = format_metric($item, {base=>2, return_array=>1});
139 6         167 $item = $nf->format_number($res->[0], $decdigs, $decdigs) .
140             $res->[1];
141             } elsif ($style eq 'kibi') {
142 6         23 my $res = format_metric(
143             $item, {base=>10, return_array=>1});
144 6         187 $item = $nf->format_number($res->[0], $decdigs, $decdigs) .
145             $res->[1];
146             } elsif ($style eq 'percent') {
147 6         39 $item = sprintf("%.${decdigs}f%%", $item*100);
148             } else {
149             # general
150 4         14 $item = $nf->format_number($item);
151             }
152 31         2397 $item = "$args->{prefix}$item$args->{suffix}";
153             }
154 75         284 return $item;
155             }
156              
157             sub _num_end {
158 13     13   30 my ($args, $orig_locale) = @_;
159 13         136 setlocale(LC_ALL, $orig_locale);
160             }
161              
162             1;
163             # ABSTRACT: Format number
164              
165             __END__