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