File Coverage

blib/lib/Number/Format/Metric.pm
Criterion Covered Total %
statement 34 50 68.0
branch 22 58 37.9
condition 16 38 42.1
subroutine 6 6 100.0
pod 1 1 100.0
total 79 153 51.6


line stmt bran cond sub pod time code
1             package Number::Format::Metric;
2              
3             our $DATE = '2014-12-05'; # DATE
4             our $VERSION = '0.60'; # VERSION
5              
6 1     1   494 use 5.010001;
  1         2  
  1         33  
7 1     1   439 use locale;
  1         202  
  1         5  
8 1     1   40 use strict;
  1         1  
  1         42  
9 1     1   528 use utf8;
  1         8  
  1         4  
10 1     1   30 use warnings;
  1         2  
  1         351  
11              
12             require Exporter;
13             our @ISA = qw(Exporter);
14             our @EXPORT_OK = qw(
15             format_metric
16             );
17              
18             sub format_metric {
19 7     7 1 629 my ($num, $opts) = @_;
20 7   50     18 $opts //= {};
21 7   100     20 $opts->{base} //= 2;
22              
23 7   100     26 my $im = $opts->{i_mark} // 1;
24 7         8 my $base0 = $opts->{base};
25 7 100       14 my $base = $base0 == 2 ? 1024 : 1000;
26              
27 7         9 my $rank;
28             my $prefix;
29 7 50       15 if ($num == 0) {
30 0         0 $rank = 0;
31 0         0 $prefix = "";
32             } else {
33 7         29 $rank = int(log(abs($num))/log($base));
34 7 100 100     56 if ($rank == 0 && abs($num) >= 1) { $prefix = "" }
  2 100       3  
    50          
    100          
    50          
    50          
    50          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
35 2 100 66     10 elsif ($rank == 1) { $prefix = $im && $base0==10 ? "ki" : "k" } # kilo
36 0 0 0     0 elsif ($rank == 2) { $prefix = $im && $base0==10 ? "Mi" : "M" } # mega
37 1 50 33     7 elsif ($rank == 3) { $prefix = $im && $base0==10 ? "Gi" : "G" } # giga
38 0 0 0     0 elsif ($rank == 4) { $prefix = $im && $base0==10 ? "Ti" : "T" } # tera
39 0 0 0     0 elsif ($rank == 5) { $prefix = $im && $base0==10 ? "Pi" : "P" } # peta
40 0 0 0     0 elsif ($rank >= 8) { $prefix = $im && $base0==10 ? "Yi" : "Y" } # yotta
41 0 0 0     0 elsif ($rank == 7) { $prefix = $im && $base0==10 ? "Zi" : "Z" } # zetta
42 0 0 0     0 elsif ($rank == 6) { $prefix = $im && $base0==10 ? "Ei" : "E" } # exa
43 2         6 elsif ($rank == 0) { $prefix = "m" } # milli
44 0         0 elsif ($rank == -1) { $prefix = "μ" } # micro
45 0         0 elsif ($rank == -2) { $prefix = "n" } # nano
46 0         0 elsif ($rank == -3) { $prefix = "p" } # pico
47 0         0 elsif ($rank == -4) { $prefix = "f" } # femto
48 0         0 elsif ($rank == -5) { $prefix = "a" } # atto
49 0         0 elsif ($rank == -6) { $prefix = "z" } # zepto
50 0         0 elsif ($rank <= -7) { $prefix = "y" } # yocto
51             }
52              
53 7   100     23 my $prec = $opts->{precision} // 1;
54 7 100 100     31 $num = $num / $base**($rank <= 0 && abs($num) < 1 ? $rank-1 : $rank);
55 7 50       14 if ($opts->{return_array}) {
56 0         0 return [$num, $prefix];
57             } else {
58 7         70 my $snum = sprintf("%.${prec}f", $num);
59 7         41 return $snum . $prefix;
60             }
61             }
62              
63             1;
64             # ABSTRACT: Format number with metric prefix
65              
66             __END__