Revision 10478553
Von Sven Schöling vor mehr als 12 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
| 866 | 866 |
$main::lxdebug->enter_sub(2); |
| 867 | 867 |
|
| 868 | 868 |
my ($self, $myconfig, $amount, $places, $dash) = @_; |
| 869 |
$dash ||= ''; |
|
| 869 |
$amount ||= 0; |
|
| 870 |
$dash ||= ''; |
|
| 871 |
my $neg = $amount < 0; |
|
| 872 |
my $force_places = defined $places && $places >= 0; |
|
| 870 | 873 |
|
| 871 |
if ($amount eq "") {
|
|
| 872 |
$amount = 0; |
|
| 873 |
} |
|
| 874 |
|
|
| 875 |
$amount *= 1; |
|
| 876 |
|
|
| 877 |
# Hey watch out! The amount can be an exponential term like 1.13686837721616e-13 |
|
| 874 |
$amount = $self->round_amount($amount, abs $places) if $force_places; |
|
| 875 |
$amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa |
|
| 878 | 876 |
|
| 879 |
my $neg = ($amount =~ s/^-//); |
|
| 880 |
my $exp = ($amount =~ m/[e]/) ? 1 : 0; |
|
| 877 |
# before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl |
|
| 878 |
# this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on |
|
| 879 |
# $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs. |
|
| 881 | 880 |
|
| 882 |
if (defined($places) && ($places ne '')) {
|
|
| 883 |
if (not $exp) {
|
|
| 884 |
if ($places < 0) {
|
|
| 885 |
$amount *= 1; |
|
| 886 |
$places *= -1; |
|
| 887 |
|
|
| 888 |
if ($amount =~ /\.(\d+)/) {
|
|
| 889 |
my $actual_places = length $1; |
|
| 890 |
$places = $actual_places if $actual_places > $places; |
|
| 891 |
} |
|
| 892 |
} |
|
| 893 |
} |
|
| 894 |
$amount = $self->round_amount($amount, $places); |
|
| 895 |
} |
|
| 881 |
$amount =~ s/0*$//; # cull trailing 0s |
|
| 896 | 882 |
|
| 897 | 883 |
my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
|
| 898 |
my @p = split(/\./, $amount); # split amount at decimal point |
|
| 899 |
|
|
| 900 |
$p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters |
|
| 884 |
my @p = split(/\./, $amount); # split amount at decimal point |
|
| 901 | 885 |
|
| 886 |
$p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters |
|
| 902 | 887 |
$amount = $p[0]; |
| 903 |
$amount .= $d[0].($p[1]||'').(0 x ($places - length ($p[1]||''))) if ($places || $p[1] ne ''); |
|
| 888 |
if ($places || $p[1]) {
|
|
| 889 |
$amount .= $d[0] |
|
| 890 |
. ( $p[1] || '' ) |
|
| 891 |
. (0 x (abs($places || 0) - length ($p[1]||''))); # pad the fraction |
|
| 892 |
} |
|
| 904 | 893 |
|
| 905 | 894 |
$amount = do {
|
| 906 | 895 |
($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) : |
| ... | ... | |
| 908 | 897 |
($neg ? "-$amount" : "$amount" ) ; |
| 909 | 898 |
}; |
| 910 | 899 |
|
| 911 |
|
|
| 912 | 900 |
$main::lxdebug->leave_sub(2); |
| 913 | 901 |
return $amount; |
| 914 | 902 |
} |
| t/form/format_amount.t | ||
|---|---|---|
| 25 | 25 |
is($::form->format_amount($config, 1000000000.1234, 2), '1,000,000,000.12', 'format 1000000000.1234 (numberformat: 1,000.00)'); |
| 26 | 26 |
is($::form->format_amount($config, -1000000000.1234, 2), '-1,000,000,000.12', 'format -1000000000.1234 (numberformat: 1,000.00)'); |
| 27 | 27 |
|
| 28 |
# negative places |
|
| 29 |
|
|
| 30 |
is($::form->format_amount($config, 1.00045, -2), '1.00045', 'negative places'); |
|
| 31 |
is($::form->format_amount($config, 1.00045, -5), '1.00045', 'negative places 2'); |
|
| 32 |
is($::form->format_amount($config, 1, -2), '1.00', 'negative places 3'); |
|
| 33 |
|
|
| 34 |
# bugs amd edge cases |
|
| 35 |
|
|
| 36 |
is($::form->format_amount({ numberformat => '1.000,00' }, 0.00005), '0,00005', 'messing with small numbers and no precision');
|
|
| 37 |
is($::form->format_amount({ numberformat => '1.000,00' }, undef), '0', 'undef');
|
|
| 38 |
is($::form->format_amount({ numberformat => '1.000,00' }, ''), '0', 'empty string');
|
|
| 39 |
is($::form->format_amount({ numberformat => '1.000,00' }, undef, 2), '0,00', 'undef with precision');
|
|
| 40 |
is($::form->format_amount({ numberformat => '1.000,00' }, '', 2), '0,00', 'empty string with prcesion');
|
|
| 41 |
|
|
| 42 |
is($::form->format_amount($config, 0.545, 0), '1', 'rounding up with precision 0'); |
|
| 43 |
is($::form->format_amount($config, -0.545, 0), '-1', 'neg rounding up with precision 0'); |
|
| 44 |
|
|
| 45 |
is($::form->format_amount($config, 1.00), '1', 'autotrim to 0 places'); |
|
| 46 |
|
|
| 47 |
|
|
| 48 |
# dash stuff |
|
| 49 |
|
|
| 50 |
$config->{numberformat} = '1.000,00';
|
|
| 51 |
|
|
| 52 |
is($::form->format_amount($config, -350, 2, '-'), '(350,00)', 'dash -'); |
|
| 53 |
|
|
| 54 |
|
|
| 28 | 55 |
done_testing; |
| 29 | 56 |
|
| 30 | 57 |
1; |
Auch abrufbar als: Unified diff
Form::format_amount - suabere trennung zwischen String und Numerischen Kontexten
behebt #1982 (unter anderem)