From 5c0b85694a2586940933285a6547910eb17db02f Mon Sep 17 00:00:00 2001 From: =?utf8?q?Sven=20Sch=C3=B6ling?= Date: Fri, 6 Nov 2020 18:06:00 +0100 Subject: [PATCH] SL::Helper::Number: API Verbesserungen MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit - API ist jetzt einheitlich ($amount, [$places], %params) - Benennung ist einheitlich _[format|parse|round]_[number|total] - Tests aus t/helper/round.t nach t/helper/number.t verschoben - Tests für alle neuen Funktionen hinzugefügt - Doku-Update - SL::Form angepasst - EXPORT_ALL tag ":ALL" auf caps umgestellt --- SL/Form.pm | 10 +++- SL/Helper/Number.pm | 73 ++++++++++++----------- t/helper/number.t | 138 ++++++++++++++++++++++++++++++++++++++++++++ t/helper/round.t | 18 ------ 4 files changed, 186 insertions(+), 53 deletions(-) create mode 100644 t/helper/number.t delete mode 100644 t/helper/round.t diff --git a/SL/Form.pm b/SL/Form.pm index 9270c5555..92d32e76f 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -700,7 +700,10 @@ sub sort_columns { } # -sub format_amount { shift; goto &SL::Helper::Number::_number; } +sub format_amount { + my ($self, $myconfig, $amount, $places, $dash) = @_; + SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash); +} sub format_amount_units { $main::lxdebug->enter_sub(); @@ -787,7 +790,10 @@ sub format_string { # -sub parse_amount { shift; goto &SL::Helper::Number::_parse_number; } +sub parse_amount { + my ($self, $myconfig, $amount) = @_; + SL::Helper::Number::_parse_number($amount, %$myconfig); +} sub round_amount { shift; goto &SL::Helper::Number::_round_number; } diff --git a/SL/Helper/Number.pm b/SL/Helper/Number.pm index 40df3c67f..0a0ef15fe 100644 --- a/SL/Helper/Number.pm +++ b/SL/Helper/Number.pm @@ -6,17 +6,18 @@ use List::Util qw(max min); use Config; our @EXPORT_OK = qw( - _total _round_total - _number _round_number + _format_number _round_number + _format_total _round_total _parse_number ); -our %EXPORT_TAGS = (all => \@EXPORT_OK); - -sub _number { - my ($myconfig, $amount, $places, $dash) = @_; - $amount ||= 0; - $dash ||= ''; - my $neg = $amount < 0; +our %EXPORT_TAGS = (ALL => \@EXPORT_OK); + +sub _format_number { + my ($amount, $places, %params) = @_; + $amount ||= 0; + my $dash = $params{dash} // ''; + my $numberformat = $params{numberformat} // $::myconfig{numberformat}; + my $neg = $amount < 0; my $force_places = defined $places && $places >= 0; $amount = _round_number($amount, abs $places) if $force_places; @@ -29,7 +30,7 @@ sub _number { $amount =~ s/0*$// unless defined $places && $places == 0; # cull trailing 0s - my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars + my @d = reverse $numberformat =~ /(\D)/g; # get delim chars my @p = split(/\./, $amount); # split amount at decimal point $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters @@ -57,6 +58,7 @@ sub _round_number { $places //= 0; if ($adjust) { + no warnings 'once'; my $precision = $::instance_conf->get_precision || 0.01; return _round_number( _round_number($amount / $precision, 0) * $precision, $places); } @@ -95,17 +97,19 @@ sub _round_number { } sub _parse_number { - my ($myconfig, $amount) = @_; + my ($amount, %params) = @_; return 0 if !defined $amount || $amount eq ''; - if ( ($myconfig->{numberformat} eq '1.000,00') - || ($myconfig->{numberformat} eq '1000,00')) { + my $numberformat = $params{numberformat} // $::myconfig{numberformat}; + + if ( ($numberformat eq '1.000,00') + || ($numberformat eq '1000,00')) { $amount =~ s/\.//g; $amount =~ s/,/\./g; } - if ($myconfig->{numberformat} eq "1'000.00") { + if ($numberformat eq "1'000.00") { $amount =~ s/\'//g; } @@ -120,9 +124,8 @@ sub _parse_number { return scalar(eval($amount)) * 1 ; } -sub _total { _number(\%::myconfig, $_[0], 2) } - -sub _round_total { _round_number($_[0], 2) } +sub _format_total { _format_number($_[0], 2, @_[1..$#_]) } +sub _round_total { _round_number($_[0], 2, @_[1..$#_]) } 1; @@ -138,17 +141,22 @@ SL::Helper::Number - number formating functions formerly sitting in SL::Form use SL::Helper::Number qw(all); - my $str = _number(\%::myconfig, $val, 2); - my $total = _total($val); # rounded to 2 + my $str = _format_number($val, 2); # round to 2 + my $str = _format_number($val, 2, %::myconfig); # also works, is implied + my $str = _format_number($val, 2, numberformat => '1.000,00'); # with custom numberformat + my $total = _format_total($val); # round to 2 + my $total = _format_total($val, numberformat => '1.000,00'); - my $val = _parse_number(\%::myconfig, $str); + my $val = _parse_number($str); # parse with the current numberformat + my $val = _parse_number($str, numberformat => '1.000,00'); # parse with the current numberformat - my $str = _round_number(\%::myconfig, $val, 2); + my $str = _round_number($val, 2); my $total = _round_total($val); # rounded to 2 =head1 DESCRIPTION -This package contains all the number parsing/formating functions that were previously in SL::Form. +This package contains all the number parsing/formating functions that were +previously in SL::Form. Instead of invoking them as methods on C<$::form> these are pure functions. @@ -156,33 +164,32 @@ Instead of invoking them as methods on C<$::form> these are pure functions. =over 4 -=item * C<_number MYCONFIG VALUE PLACES DASH> +=item * C<_format_number VALUE PLACES PARAMS> -The old C. C is expected to be a hashref -with a C entry. Usually C<\%::myconfig> will be passed. +The old C with a different signature. The value is expected to be a numeric value, but undef and empty string will be vivified to 0 for convinience. Bigints are supported. For the semantics of places, see L. -The dash parameter allows to change the formatting of positive and negative -numbers to alternative ones. If C<-> is given for dash, negative numbers will +If C contains a dash parameter, it will change the formatting of +positive/negative numbers. If C<-> is given for dash, negative numbers will instead be formatted with prentheses. If C is given, the numbers will be formatted absolute, but suffixed with the localized versions of C and C. -=item * _total +=item * _format_total A curried version used for formatting ledger entries. C is set from the current user, C is set to 2. C is left empty. -=item * _parse_number MYCONFIG VALUE +=item * _parse_number VALUE PARAMS -Parses expressions into numbers. C is expected to be a hashref -with a C entry. +Parses expressions into numbers. C may contain C just +like with C. -Also implements basic arithmetic interprtation, so that C<2 * 1400> is +Also implements basic arithmetic interpretation, so that C<2 * 1400> is interpreted as 2800. =item * _round_number VALUE PLACES @@ -210,7 +217,7 @@ Places can be: In that case a representation is chosen that looks sufficiently human. For example C<1/10> equals C<.1000000000000000555> but will be displayed as the -localzed version of 0.1. +localized version of 0.1. =item * 0 diff --git a/t/helper/number.t b/t/helper/number.t new file mode 100644 index 000000000..f3604f2a3 --- /dev/null +++ b/t/helper/number.t @@ -0,0 +1,138 @@ +use Test::More tests => 173; + +use lib 't'; + +use SL::Helper::Number qw(:ALL); + +use_ok 'Support::TestSetup'; + +Support::TestSetup::login(); + +# format + +sub test_format { + my ($expected, $amount, $places, $numberformat, $dash, $comment) = @_; + + my $other_numberformat = $numberformat eq '1.000,00' ? '1,000.00' : '1.000,00'; + + is (_format_number($amount, $places, numberformat => $numberformat, dash => $dash), $expected, "$comment - explicit"); + + { + local $::myconfig{numberformat} = $other_numberformat; + is (_format_number($amount, $places, numberformat => $numberformat, dash => $dash), $expected, "$comment - explicit with different numberformat"); + } + { + local $::myconfig{numberformat} = $numberformat; + is (_format_number($amount, $places, dash => $dash), $expected, "$comment - implicit numberformat"); + } + + # test _format_total + if ($places == 2) { + is (_format_total($amount, numberformat => $numberformat, dash => $dash), $expected, "$comment - explicit"); + + { + local $::myconfig{numberformat} = $other_numberformat; + is (_format_total($amount, numberformat => $numberformat, dash => $dash), $expected, "$comment - explicit with different numberformat"); + } + { + local $::myconfig{numberformat} = $numberformat; + is (_format_total($amount, dash => $dash), $expected, "$comment - implicit numberformat"); + } + } +} + + +test_format('10,00', '1e1', 2, '1.000,00', undef, 'format 1e1 (numberformat: 1.000,00)'); +test_format('1.000,00', 1000, 2, '1.000,00', undef, 'format 1000 (numberformat: 1.000,00)'); +test_format('1.000,12', 1000.1234, 2, '1.000,00', undef, 'format 1000.1234 (numberformat: 1.000,00)'); +test_format('1.000.000.000,12', 1000000000.1234, 2, '1.000,00', undef, 'format 1000000000.1234 (numberformat: 1.000,00)'); +test_format('-1.000.000.000,12', -1000000000.1234, 2, '1.000,00', undef, 'format -1000000000.1234 (numberformat: 1.000,00)'); + +test_format('10.00', '1e1', 2, '1,000.00', undef, 'format 1e1 (numberformat: 1,000.00)'); +test_format('1,000.00', 1000, 2, '1,000.00', undef, 'format 1000 (numberformat: 1,000.00)'); +test_format('1,000.12', 1000.1234, 2, '1,000.00', undef, 'format 1000.1234 (numberformat: 1,000.00)'); +test_format('1,000,000,000.12', 1000000000.1234, 2, '1,000.00', undef, 'format 1000000000.1234 (numberformat: 1,000.00)'); +test_format('-1,000,000,000.12', -1000000000.1234, 2, '1,000.00', undef, 'format -1000000000.1234 (numberformat: 1,000.00)'); + +# negative places + +test_format('1.00045', 1.00045, -2, '1,000.00', undef, 'negative places'); +test_format('1.00045', 1.00045, -5, '1,000.00', undef, 'negative places 2'); +test_format('1.00', 1, -2, '1,000.00', undef, 'negative places 3'); + +# bugs amd edge cases +$config->{numberformat} = '1.000,00'; + +test_format('0,00005', 0.00005, undef, '1.000,00', undef, 'messing with small numbers and no precision'); +test_format('0', undef, undef, '1.000,00', undef, 'undef'); +test_format('0', '', undef, '1.000,00', undef, 'empty string'); +test_format('0,00', undef, 2, '1.000,00', undef, 'undef with precision'); +test_format('0,00', '', 2, '1.000,00', undef, 'empty string with prcesion'); + +test_format('1', 0.545, 0, '1.000,00', undef, 'rounding up with precision 0'); +test_format('-1', -0.545, 0, '1.000,00', undef, 'neg rounding up with precision 0'); + +test_format('1', 1.00, undef, '1.000,00', undef, 'autotrim to 0 places'); + +test_format('10', 10, undef, '1.000,00', undef, 'autotrim does not harm integers'); +test_format('10,00', 10, 2, '1.000,00', undef, 'autotrim does not harm integers 2'); +test_format('10,00', 10, -2, '1.000,00', undef, 'autotrim does not harm integers 3'); +test_format('10', 10, 0, '1.000,00', undef, 'autotrim does not harm integers 4'); + +test_format('0', 0, 0, '1.000,00', undef, 'trivial zero'); +test_format('0,00', -0.002, 2, '1.000,00', undef, 'negative zero'); +test_format('-0,002', -0.002, 3, '1.000,00', undef, 'negative zero'); + +# dash + +test_format('(350,00)', -350, 2, '1.000,00', '-', 'dash -'); + +# parse + +sub test_parse { + my ($expected, $amount, $numberformat, $comment) = @_; + + my $other_numberformat = $numberformat eq '1.000,00' ? '1,000.00' : '1.000,00'; + + is (_parse_number($amount, numberformat => $numberformat), $expected, "$comment - explicit"); + + { + local $::myconfig{numberformat} = $other_numberformat; + is (_parse_number($amount, numberformat => $numberformat), $expected, "$comment - explicit with different numberformat"); + } + { + local $::myconfig{numberformat} = $numberformat; + is (_parse_number($amount), $expected, "$comment - implicit numberformat"); + } +} + + +test_parse(12345, '12345', '1.000,00', '12345 (numberformat: 1.000,00)'); +test_parse(1234.5, '1.234,5', '1.000,00', '1.234,5 (numberformat: 1.000,00)'); +test_parse(9871234.5, '9.871.234,5', '1.000,00', '9.871.234,5 (numberformat: 1.000,00)'); +test_parse(1234.5, '1234,5', '1.000,00', '1234,5 (numberformat: 1.000,00)'); +test_parse(12345, '012345', '1.000,00', '012345 (numberformat: 1.000,00)'); +test_parse(1234.5, '01.234,5', '1.000,00', '01.234,5 (numberformat: 1.000,00)'); +test_parse(1234.5, '01234,5', '1.000,00', '01234,5 (numberformat: 1.000,00)'); +test_parse(9871234.5, '09.871.234,5', '1.000,00', '09.871.234,5 (numberformat: 1.000,00)'); + +# round + +is(_round_number('3.231',2),'3.23'); +is(_round_number('3.234',2),'3.23'); +is(_round_number('3.235',2),'3.24'); +is(_round_number('5.786',2),'5.79'); +is(_round_number('2.342',2),'2.34'); +is(_round_number('1.2345',2),'1.23'); +is(_round_number('8.2345',2),'8.23'); +is(_round_number('8.2350',2),'8.24'); + + +is(_round_total('3.231'),'3.23'); +is(_round_total('3.234'),'3.23'); +is(_round_total('3.235'),'3.24'); +is(_round_total('5.786'),'5.79'); +is(_round_total('2.342'),'2.34'); +is(_round_total('1.2345'),'1.23'); +is(_round_total('8.2345'),'8.23'); +is(_round_total('8.2350'),'8.24'); diff --git a/t/helper/round.t b/t/helper/round.t deleted file mode 100644 index a4c2b5ead..000000000 --- a/t/helper/round.t +++ /dev/null @@ -1,18 +0,0 @@ -use Test::More tests => 9; - -use lib 't'; - -use SL::Helper::Number qw(:all); - -use_ok 'Support::TestSetup'; - -Support::TestSetup::login(); - -is(_round_number('3.231',2),'3.23'); -is(_round_number('3.234',2),'3.23'); -is(_round_number('3.235',2),'3.24'); -is(_round_number('5.786',2),'5.79'); -is(_round_number('2.342',2),'2.34'); -is(_round_number('1.2345',2),'1.23'); -is(_round_number('8.2345',2),'8.23'); -is(_round_number('8.2350',2),'8.24'); -- 2.20.1