SL::Helper::Number: API Verbesserungen

- 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

diff --git a/SL/Form.pm b/SL/Form.pm
index 9270c55..92d32e7 100644 (file)
--- 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 40df3c6..0a0ef15 100644 (file)
--- 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<SL::Form::format_amount>. C<MYCONFIG> is expected to be a hashref
-with a C<numberformat> entry. Usually C<\%::myconfig> will be passed.
+The old C<SL::Form::format_amount> 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</PLACES>.
 
-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<params> 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<DRCR> is given, the numbers will be
 formatted absolute, but suffixed with the localized versions of C<DR> and
 C<CR>.
 
-=item * _total
+=item * _format_total
 
 A curried version used for formatting ledger entries. C<myconfig> is set from the
 current user, C<places> is set to 2. C<dash> is left empty.
 
-=item * _parse_number MYCONFIG VALUE
+=item * _parse_number VALUE PARAMS
 
-Parses expressions into numbers. C<MYCONFIG> is expected to be a hashref
-with a C<numberformat> entry.
+Parses expressions into numbers. C<PARAMS> may contain C<numberformat> just
+like with C<L/_format_amount>.
 
-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 (file)
index 0000000..f3604f2
--- /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 (file)
index a4c2b5e..0000000
--- 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');