1 package SL::Helper::Number;
4 use Exporter qw(import);
5 use List::Util qw(max min);
9 _format_number _round_number
10 _format_total _round_total
14 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
17 my ($amount, $places, %params) = @_;
19 my $dash = $params{dash} // '';
20 my $numberformat = $params{numberformat} // $::myconfig{numberformat};
21 my $neg = $amount < 0;
22 my $force_places = defined $places && $places >= 0;
24 $amount = _round_number($amount, abs $places) if $force_places;
25 $neg = 0 if $amount == 0; # don't show negative zero
26 $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa
28 # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl
29 # this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on
30 # $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs.
32 $amount =~ s/0*$// unless defined $places && $places == 0; # cull trailing 0s
34 my @d = reverse $numberformat =~ /(\D)/g; # get delim chars
35 my @p = split(/\./, $amount); # split amount at decimal point
37 $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
39 if ($places || $p[1]) {
42 . (0 x max(abs($places || 0) - length ($p[1]||''), 0)); # pad the fraction
46 ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) :
47 ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) :
48 ($neg ? "-$amount" : "$amount" ) ;
54 sub _format_number_units {
55 my ($amount, $places, $unit_from, $unit_to, %params) = @_;
57 my $all_units = $params{all_units} //= SL::DB::Manager::Unit->get_all;
59 if (!$unit_from || !$unit_to) {
60 return _format_number($amount, $places, %params);
63 $amount *= $unit_from->convert_to(1, $unit_to);
65 my $conv_units = $unit_from->convertible_units($all_units);
67 if (!scalar @{ $conv_units }) {
68 return _format_number($amount, $places, %params) . " " . $unit_to->name;
74 for my $unit (@$conv_units) {
75 my $last = $unit->name eq $unit_to->name;
77 $num = int($amount / $unit->factor);
78 $amount -= $num * $unit->factor;
81 if ($last ? $amount : $num) {
84 amount => $last ? $amount / $unit->factor : $num,
85 places => $last ? $places : 0
93 push @values, { "unit" => $unit_to->name,
98 return join " ", map {
99 _format_number($_->{amount}, $_->{places}, %params), $_->{unit}
104 my ($amount, $places, $adjust) = @_;
106 return 0 if !defined $amount;
112 my $precision = $::instance_conf->get_precision || 0.01;
113 return _round_number( _round_number($amount / $precision, 0) * $precision, $places);
116 # We use Perl's knowledge of string representation for
117 # rounding. First, convert the floating point number to a string
118 # with a high number of places. Then split the string on the decimal
119 # sign and use integer calculation for rounding the decimal places
120 # part. If an overflow occurs then apply that overflow to the part
121 # before the decimal sign as well using integer arithmetic again.
123 my $int_amount = int(abs $amount);
124 my $str_places = max(min(10, 16 - length("$int_amount") - $places), $places);
125 my $amount_str = sprintf '%.*f', $places + $str_places, abs($amount);
127 return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$};
129 my ($pre, $post) = ($1, $2);
130 my $decimals = '1' . substr($post, 0, $places);
132 my $propagation_limit = $Config{i32size} == 4 ? 7 : 18;
133 my $add_for_rounding = substr($post, $places, 1) >= 5 ? 1 : 0;
135 if ($places > $propagation_limit) {
136 $decimals = Math::BigInt->new($decimals)->badd($add_for_rounding);
137 $pre = Math::BigInt->new($decimals)->badd(1) if substr($decimals, 0, 1) eq '2';
140 $decimals += $add_for_rounding;
141 $pre += 1 if substr($decimals, 0, 1) eq '2';
144 $amount = ("${pre}." . substr($decimals, 1)) * ($amount <=> 0);
150 my ($amount, %params) = @_;
152 return 0 if !defined $amount || $amount eq '';
154 my $numberformat = $params{numberformat} // $::myconfig{numberformat};
156 if ( ($numberformat eq '1.000,00')
157 || ($numberformat eq '1000,00')) {
162 if ($numberformat eq "1'000.00") {
168 # Make sure no code wich is not a math expression ends up in eval().
169 return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x;
171 # Prevent numbers from being parsed as octals;
172 $amount =~ s{ (?<! [\d.] ) 0+ (?= [1-9] ) }{}gx;
174 return scalar(eval($amount)) * 1 ;
177 sub _format_total { _format_number($_[0], 2, @_[1..$#_]) }
178 sub _round_total { _round_number($_[0], 2, @_[1..$#_]) }
188 SL::Helper::Number - number formating functions formerly sitting in SL::Form
192 use SL::Helper::Number qw(all);
194 my $str = _format_number($val, 2); # round to 2
195 my $str = _format_number($val, 2, %::myconfig); # also works, is implied
196 my $str = _format_number($val, 2, numberformat => '1.000,00'); # with custom numberformat
197 my $total = _format_total($val); # round to 2
198 my $total = _format_total($val, numberformat => '1.000,00');
200 my $val = _parse_number($str); # parse with the current numberformat
201 my $val = _parse_number($str, numberformat => '1.000,00'); # parse with the current numberformat
203 my $str = _round_number($val, 2);
204 my $total = _round_total($val); # rounded to 2
208 This package contains all the number parsing/formating functions that were
209 previously in SL::Form.
211 Instead of invoking them as methods on C<$::form> these are pure functions.
217 =item * C<_format_number VALUE PLACES PARAMS>
219 The old C<SL::Form::format_amount> with a different signature.
221 The value is expected to be a numeric value, but undef and empty string will be
222 vivified to 0 for convinience. Bigints are supported.
224 For the semantics of places, see L</PLACES>.
226 If C<params> contains a dash parameter, it will change the formatting of
227 positive/negative numbers. If C<-> is given for dash, negative numbers will
228 instead be formatted with prentheses. If C<DRCR> is given, the numbers will be
229 formatted absolute, but suffixed with the localized versions of C<DR> and
232 =item * _format_total
234 A curried version used for formatting ledger entries. C<myconfig> is set from the
235 current user, C<places> is set to 2. C<dash> is left empty.
237 =item * _parse_number VALUE PARAMS
239 Parses expressions into numbers. C<PARAMS> may contain C<numberformat> just
240 like with C<L/_format_amount>.
242 Also implements basic arithmetic interpretation, so that C<2 * 1400> is
245 =item * _round_number VALUE PLACES
247 Rounds a number. Due to the way Perl handles floating point we take a lot of
248 precautions that rounding ends up being close to where we want. Usually the
249 internal floats have more than enough precision to not have any floating point
250 issues, but the cumulative error can interfere with proper formatting later.
252 For places, see L</PLACES>
256 A curried version used for rounding ledger entries. C<places> is set to 2.
268 In that case a representation is chosen that looks sufficiently human. For
269 example C<1/10> equals C<.1000000000000000555> but will be displayed as the
270 localized version of 0.1.
274 The number will be rounded to the nearest integer (towards 0).
276 =item * a positive integer
278 The number will be rounded to this many places. Formatting functions will then
279 make sure to pad the output to this many places.
281 =item * a negative inteher
283 The number will not be rounded, but padded to at least this many places.
287 =head1 ERROR REPORTING
289 All of these do not thow exceptions and will simply return undef should
290 something unforeseen happen.
292 =head1 BUGS AND CAVEATS
294 Beware that the old C<amount> is now called plain C<number>. C<amount> is
295 deliberately unused in the new version for that reason.
299 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>