Revision 10478553
Von Sven Schöling vor etwa 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)