Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 5c0b8569

Von Sven Schöling vor etwa 4 Jahren hinzugefügt

  • ID 5c0b85694a2586940933285a6547910eb17db02f
  • Vorgänger 8c44628b
  • Nachfolger 9e06938c

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

Unterschiede anzeigen:

SL/Form.pm
700 700 
}
701 701 
#
702 702 

  		




  703
  
  
    
sub format_amount { shift; goto &SL::Helper::Number::_number; }


  		




  
  703
  
    
sub format_amount {


  		




  
  704
  
    
  my ($self, $myconfig, $amount, $places, $dash) = @_;


  		




  
  705
  
    
  SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash);


  		




  
  706
  
    
}


  		




  704
  707
  
    

  		




  705
  708
  
    
sub format_amount_units {


  		




  706
  709
  
    
  $main::lxdebug->enter_sub();


  		




  ......




  787
  790
  
    

  		




  788
  791
  
    
#


  		




  789
  792
  
    

  		




  790
  
  
    
sub parse_amount { shift; goto &SL::Helper::Number::_parse_number; }


  		




  
  793
  
    
sub parse_amount {


  		




  
  794
  
    
  my ($self, $myconfig, $amount) = @_;


  		




  
  795
  
    
  SL::Helper::Number::_parse_number($amount, %$myconfig);


  		




  
  796
  
    
}


  		




  791
  797
  
    

  		




  792
  798
  
    
sub round_amount { shift; goto &SL::Helper::Number::_round_number; }


  		




  793
  799
  
    

  		












  

    
      SL/Helper/Number.pm
    
  





  6
  6
  
    
use Config;


  		




  7
  7
  
    

  		




  8
  8
  
    
our @EXPORT_OK = qw(


  		




  9
  
  
    
  _total       _round_total


  		




  10
  
  
    
  _number      _round_number


  		




  
  9
  
    
  _format_number _round_number


  		




  
  10
  
    
  _format_total  _round_total


  		




  11
  11
  
    
  _parse_number


  		




  12
  12
  
    
);


  		




  13
  
  
    
our %EXPORT_TAGS = (all => \@EXPORT_OK);


  		




  14
  
  
    

  		




  15
  
  
    
sub _number {


  		




  16
  
  
    
  my ($myconfig, $amount, $places, $dash) = @_;


  		




  17
  
  
    
  $amount ||= 0;


  		




  18
  
  
    
  $dash   ||= '';


  		




  19
  
  
    
  my $neg = $amount < 0;


  		




  
  13
  
    
our %EXPORT_TAGS = (ALL => \@EXPORT_OK);


  		




  
  14
  
    

  		




  
  15
  
    
sub _format_number {


  		




  
  16
  
    
  my ($amount, $places, %params) = @_;


  		




  
  17
  
    
  $amount        ||= 0;


  		




  
  18
  
    
  my $dash         = $params{dash} // '';


  		




  
  19
  
    
  my $numberformat = $params{numberformat} // $::myconfig{numberformat};


  		




  
  20
  
    
  my $neg          = $amount < 0;


  		




  20
  21
  
    
  my $force_places = defined $places && $places >= 0;


  		




  21
  22
  
    

  		




  22
  23
  
    
  $amount = _round_number($amount, abs $places) if $force_places;


  		




  ......




  29
  30
  
    

  		




  30
  31
  
    
  $amount =~ s/0*$// unless defined $places && $places == 0;             # cull trailing 0s


  		




  31
  32
  
    

  		




  32
  
  
    
  my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars


  		




  
  33
  
    
  my @d = reverse $numberformat =~ /(\D)/g;                              # get delim chars


  		




  33
  34
  
    
  my @p = split(/\./, $amount);                                          # split amount at decimal point


  		




  34
  35
  
    

  		




  35
  36
  
    
  $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1];                             # add 1,000 delimiters


  		




  ......




  57
  58
  
    
  $places //= 0;


  		




  58
  59
  
    

  		




  59
  60
  
    
  if ($adjust) {


  		




  
  61
  
    
    no warnings 'once';


  		




  60
  62
  
    
    my $precision = $::instance_conf->get_precision || 0.01;


  		




  61
  63
  
    
    return _round_number( _round_number($amount / $precision, 0) * $precision, $places);


  		




  62
  64
  
    
  }


  		




  ......




  95
  97
  
    
}


  		




  96
  98
  
    

  		




  97
  99
  
    
sub _parse_number {


  		




  98
  
  
    
  my ($myconfig, $amount) = @_;


  		




  
  100
  
    
  my ($amount, %params) = @_;


  		




  99
  101
  
    

  		




  100
  102
  
    
  return 0 if !defined $amount || $amount eq '';


  		




  101
  103
  
    

  		




  102
  
  
    
  if (   ($myconfig->{numberformat} eq '1.000,00')


  		




  103
  
  
    
      || ($myconfig->{numberformat} eq '1000,00')) {


  		




  
  104
  
    
  my $numberformat = $params{numberformat} // $::myconfig{numberformat};


  		




  
  105
  
    

  		




  
  106
  
    
  if (   ($numberformat eq '1.000,00')


  		




  
  107
  
    
      || ($numberformat eq '1000,00')) {


  		




  104
  108
  
    
    $amount =~ s/\.//g;


  		




  105
  109
  
    
    $amount =~ s/,/\./g;


  		




  106
  110
  
    
  }


  		




  107
  111
  
    

  		




  108
  
  
    
  if ($myconfig->{numberformat} eq "1'000.00") {


  		




  
  112
  
    
  if ($numberformat eq "1'000.00") {


  		




  109
  113
  
    
    $amount =~ s/\'//g;


  		




  110
  114
  
    
  }


  		




  111
  115
  
    

  		




  ......




  120
  124
  
    
  return scalar(eval($amount)) * 1 ;


  		




  121
  125
  
    
}


  		




  122
  126
  
    

  		




  123
  
  
    
sub _total    { _number(\%::myconfig, $_[0], 2)  }


  		




  124
  
  
    

  		




  125
  
  
    
sub _round_total    { _round_number($_[0], 2) }


  		




  
  127
  
    
sub _format_total    { _format_number($_[0], 2, @_[1..$#_])  }


  		




  
  128
  
    
sub _round_total    { _round_number($_[0], 2, @_[1..$#_]) }


  		




  126
  129
  
    

  		




  127
  130
  
    
1;


  		




  128
  131
  
    

  		




  ......




  138
  141
  
    

  		




  139
  142
  
    
  use SL::Helper::Number qw(all);


  		




  140
  143
  
    

  		




  141
  
  
    
  my $str       = _number(\%::myconfig, $val, 2);


  		




  142
  
  
    
  my $total     = _total($val);     # rounded to 2


  		




  
  144
  
    
  my $str       = _format_number($val, 2); # round to 2


  		




  
  145
  
    
  my $str       = _format_number($val, 2, %::myconfig);                # also works, is implied


  		




  
  146
  
    
  my $str       = _format_number($val, 2, numberformat => '1.000,00'); # with custom numberformat


  		




  
  147
  
    
  my $total     = _format_total($val);     # round to 2


  		




  
  148
  
    
  my $total     = _format_total($val, numberformat => '1.000,00');


  		




  143
  149
  
    

  		




  144
  
  
    
  my $val       = _parse_number(\%::myconfig, $str);


  		




  
  150
  
    
  my $val       = _parse_number($str);                             # parse with the current numberformat


  		




  
  151
  
    
  my $val       = _parse_number($str, numberformat => '1.000,00'); # parse with the current numberformat


  		




  145
  152
  
    

  		




  146
  
  
    
  my $str       = _round_number(\%::myconfig, $val, 2);


  		




  
  153
  
    
  my $str       = _round_number($val, 2);


  		




  147
  154
  
    
  my $total     = _round_total($val);     # rounded to 2


  		




  148
  155
  
    

  		




  149
  156
  
    
=head1 DESCRIPTION


  		




  150
  157
  
    

  		




  151
  
  
    
This package contains all the number parsing/formating functions that were previously in SL::Form.


  		




  
  158
  
    
This package contains all the number parsing/formating functions that were


  		




  
  159
  
    
previously in SL::Form.


  		




  152
  160
  
    

  		




  153
  161
  
    
Instead of invoking them as methods on C<$::form> these are pure functions.


  		




  154
  162
  
    

  		




  ......




  156
  164
  
    

  		




  157
  165
  
    
=over 4


  		




  158
  166
  
    

  		




  159
  
  
    
=item * C<_number MYCONFIG VALUE PLACES DASH>


  		




  
  167
  
    
=item * C<_format_number VALUE PLACES PARAMS>


  		




  160
  168
  
    

  		




  161
  
  
    
The old C<SL::Form::format_amount>. C<MYCONFIG> is expected to be a hashref


  		




  162
  
  
    
with a C<numberformat> entry. Usually C<\%::myconfig> will be passed.


  		




  
  169
  
    
The old C<SL::Form::format_amount> with a different signature.


  		




  163
  170
  
    

  		




  164
  171
  
    
The value is expected to be a numeric value, but undef and empty string will be


  		




  165
  172
  
    
vivified to 0 for convinience. Bigints are supported.


  		




  166
  173
  
    

  		




  167
  174
  
    
For the semantics of places, see L</PLACES>.


  		




  168
  175
  
    

  		




  169
  
  
    
The dash parameter allows to change the formatting of positive and negative


  		




  170
  
  
    
numbers to alternative ones. If C<-> is given for dash, negative numbers will


  		




  
  176
  
    
If C<params> contains a dash parameter, it will change the formatting of


  		




  
  177
  
    
positive/negative numbers. If C<-> is given for dash, negative numbers will


  		




  171
  178
  
    
instead be formatted with prentheses. If C<DRCR> is given, the numbers will be


  		




  172
  179
  
    
formatted absolute, but suffixed with the localized versions of C<DR> and


  		




  173
  180
  
    
C<CR>.


  		




  174
  181
  
    

  		




  175
  
  
    
=item * _total


  		




  
  182
  
    
=item * _format_total


  		




  176
  183
  
    

  		




  177
  184
  
    
A curried version used for formatting ledger entries. C<myconfig> is set from the


  		




  178
  185
  
    
current user, C<places> is set to 2. C<dash> is left empty.


  		




  179
  186
  
    

  		




  180
  
  
    
=item * _parse_number MYCONFIG VALUE


  		




  
  187
  
    
=item * _parse_number VALUE PARAMS


  		




  181
  188
  
    

  		




  182
  
  
    
Parses expressions into numbers. C<MYCONFIG> is expected to be a hashref


  		




  183
  
  
    
with a C<numberformat> entry.


  		




  
  189
  
    
Parses expressions into numbers. C<PARAMS> may contain C<numberformat> just


  		




  
  190
  
    
like with C<L/_format_amount>.


  		




  184
  191
  
    

  		




  185
  
  
    
Also implements basic arithmetic interprtation, so that C<2 * 1400> is


  		




  
  192
  
    
Also implements basic arithmetic interpretation, so that C<2 * 1400> is


  		




  186
  193
  
    
interpreted as 2800.


  		




  187
  194
  
    

  		




  188
  195
  
    
=item * _round_number VALUE PLACES


  		




  ......




  210
  217
  
    

  		




  211
  218
  
    
In that case a representation is chosen that looks sufficiently human. For


  		




  212
  219
  
    
example C<1/10> equals C<.1000000000000000555> but will be displayed as the


  		




  213
  
  
    
localzed version of 0.1.


  		




  
  220
  
    
localized version of 0.1.


  		




  214
  221
  
    

  		




  215
  222
  
    
=item * 0


  		




  216
  223
  
    

  		












  

    
      t/helper/number.t
    
  





  
  1
  
    
use Test::More tests => 173;


  		




  
  2
  
    

  		




  
  3
  
    
use lib 't';


  		




  
  4
  
    

  		




  
  5
  
    
use SL::Helper::Number qw(:ALL);


  		




  
  6
  
    

  		




  
  7
  
    
use_ok 'Support::TestSetup';


  		




  
  8
  
    

  		




  
  9
  
    
Support::TestSetup::login();


  		




  
  10
  
    

  		




  
  11
  
    
# format


  		




  
  12
  
    

  		




  
  13
  
    
sub test_format {


  		




  
  14
  
    
  my ($expected, $amount, $places, $numberformat, $dash, $comment) = @_;


  		




  
  15
  
    

  		




  
  16
  
    
  my $other_numberformat = $numberformat eq '1.000,00' ? '1,000.00' : '1.000,00';


  		




  
  17
  
    

  		




  
  18
  
    
  is (_format_number($amount, $places, numberformat => $numberformat, dash => $dash), $expected, "$comment - explicit");


  		




  
  19
  
    

  		




  
  20
  
    
  {


  		




  
  21
  
    
    local $::myconfig{numberformat} = $other_numberformat;


  		




  
  22
  
    
    is (_format_number($amount, $places, numberformat => $numberformat, dash => $dash), $expected, "$comment - explicit with different numberformat");


  		




  
  23
  
    
  }


  		




  
  24
  
    
  {


  		




  
  25
  
    
    local $::myconfig{numberformat} = $numberformat;


  		




  
  26
  
    
    is (_format_number($amount, $places, dash => $dash), $expected, "$comment - implicit numberformat");


  		




  
  27
  
    
  }


  		




  
  28
  
    

  		




  
  29
  
    
  # test _format_total


  		




  
  30
  
    
  if ($places == 2) {


  		




  
  31
  
    
    is (_format_total($amount, numberformat => $numberformat, dash => $dash), $expected, "$comment - explicit");


  		




  
  32
  
    

  		




  
  33
  
    
    {


  		




  
  34
  
    
      local $::myconfig{numberformat} = $other_numberformat;


  		




  
  35
  
    
      is (_format_total($amount, numberformat => $numberformat, dash => $dash), $expected, "$comment - explicit with different numberformat");


  		




  
  36
  
    
    }


  		




  
  37
  
    
    {


  		




  
  38
  
    
      local $::myconfig{numberformat} = $numberformat;


  		




  
  39
  
    
      is (_format_total($amount, dash => $dash), $expected, "$comment - implicit numberformat");


  		




  
  40
  
    
    }


  		




  
  41
  
    
  }


  		




  
  42
  
    
}


  		




  
  43
  
    

  		




  
  44
  
    

  		




  
  45
  
    
test_format('10,00', '1e1', 2, '1.000,00', undef, 'format 1e1 (numberformat: 1.000,00)');


  		




  
  46
  
    
test_format('1.000,00', 1000, 2, '1.000,00', undef, 'format 1000 (numberformat: 1.000,00)');


  		




  
  47
  
    
test_format('1.000,12', 1000.1234, 2, '1.000,00', undef,  'format 1000.1234 (numberformat: 1.000,00)');


  		




  
  48
  
    
test_format('1.000.000.000,12', 1000000000.1234, 2, '1.000,00', undef, 'format 1000000000.1234 (numberformat: 1.000,00)');


  		




  
  49
  
    
test_format('-1.000.000.000,12', -1000000000.1234, 2, '1.000,00', undef, 'format -1000000000.1234 (numberformat: 1.000,00)');


  		




  
  50
  
    

  		




  
  51
  
    
test_format('10.00', '1e1', 2, '1,000.00', undef, 'format 1e1 (numberformat: 1,000.00)');


  		




  
  52
  
    
test_format('1,000.00', 1000, 2, '1,000.00', undef, 'format 1000 (numberformat: 1,000.00)');


  		




  
  53
  
    
test_format('1,000.12', 1000.1234, 2, '1,000.00', undef, 'format 1000.1234 (numberformat: 1,000.00)');


  		




  
  54
  
    
test_format('1,000,000,000.12', 1000000000.1234, 2, '1,000.00', undef, 'format 1000000000.1234 (numberformat: 1,000.00)');


  		




  
  55
  
    
test_format('-1,000,000,000.12', -1000000000.1234, 2, '1,000.00', undef, 'format -1000000000.1234 (numberformat: 1,000.00)');


  		




  
  56
  
    

  		




  
  57
  
    
# negative places


  		




  
  58
  
    

  		




  
  59
  
    
test_format('1.00045', 1.00045, -2, '1,000.00', undef, 'negative places');


  		




  
  60
  
    
test_format('1.00045', 1.00045, -5, '1,000.00', undef, 'negative places 2');


  		




  
  61
  
    
test_format('1.00', 1, -2, '1,000.00', undef, 'negative places 3');


  		




  
  62
  
    

  		




  
  63
  
    
# bugs amd edge cases


  		




  
  64
  
    
$config->{numberformat} = '1.000,00';


  		




  
  65
  
    

  		




  
  66
  
    
test_format('0,00005', 0.00005, undef, '1.000,00', undef, 'messing with small numbers and no precision');


  		




  
  67
  
    
test_format('0', undef, undef, '1.000,00', undef, 'undef');


  		




  
  68
  
    
test_format('0', '', undef, '1.000,00', undef, 'empty string');


  		




  
  69
  
    
test_format('0,00', undef, 2, '1.000,00', undef, 'undef with precision');


  		




  
  70
  
    
test_format('0,00', '', 2, '1.000,00', undef, 'empty string with prcesion');


  		




  
  71
  
    

  		




  
  72
  
    
test_format('1', 0.545, 0, '1.000,00', undef, 'rounding up with precision 0');


  		




  
  73
  
    
test_format('-1', -0.545, 0, '1.000,00', undef, 'neg rounding up with precision 0');


  		




  
  74
  
    

  		




  
  75
  
    
test_format('1', 1.00, undef, '1.000,00', undef, 'autotrim to 0 places');


  		




  
  76
  
    

  		




  
  77
  
    
test_format('10', 10, undef, '1.000,00', undef, 'autotrim does not harm integers');


  		




  
  78
  
    
test_format('10,00', 10, 2, '1.000,00', undef, 'autotrim does not harm integers 2');


  		




  
  79
  
    
test_format('10,00', 10, -2, '1.000,00', undef, 'autotrim does not harm integers 3');


  		




  
  80
  
    
test_format('10', 10, 0, '1.000,00', undef, 'autotrim does not harm integers 4');


  		




  
  81
  
    

  		




  
  82
  
    
test_format('0', 0, 0, '1.000,00', undef, 'trivial zero');


  		




  
  83
  
    
test_format('0,00', -0.002, 2, '1.000,00', undef, 'negative zero');


  		




  
  84
  
    
test_format('-0,002', -0.002, 3, '1.000,00', undef, 'negative zero');


  		




  
  85
  
    

  		




  
  86
  
    
# dash


  		




  
  87
  
    

  		




  
  88
  
    
test_format('(350,00)', -350, 2, '1.000,00', '-', 'dash -');


  		




  
  89
  
    

  		




  
  90
  
    
# parse


  		




  
  91
  
    

  		




  
  92
  
    
sub test_parse {


  		




  
  93
  
    
  my ($expected, $amount, $numberformat, $comment) = @_;


  		




  
  94
  
    

  		




  
  95
  
    
  my $other_numberformat = $numberformat eq '1.000,00' ? '1,000.00' : '1.000,00';


  		




  
  96
  
    

  		




  
  97
  
    
  is (_parse_number($amount, numberformat => $numberformat), $expected, "$comment - explicit");


  		




  
  98
  
    

  		




  
  99
  
    
  {


  		




  
  100
  
    
    local $::myconfig{numberformat} = $other_numberformat;


  		




  
  101
  
    
    is (_parse_number($amount, numberformat => $numberformat), $expected, "$comment - explicit with different numberformat");


  		




  
  102
  
    
  }


  		




  
  103
  
    
  {


  		




  
  104
  
    
    local $::myconfig{numberformat} = $numberformat;


  		




  
  105
  
    
    is (_parse_number($amount), $expected, "$comment - implicit numberformat");


  		




  
  106
  
    
  }


  		




  
  107
  
    
}


  		




  
  108
  
    

  		




  
  109
  
    

  		




  
  110
  
    
test_parse(12345,     '12345',        '1.000,00', '12345 (numberformat: 1.000,00)');


  		




  
  111
  
    
test_parse(1234.5,    '1.234,5',      '1.000,00', '1.234,5 (numberformat: 1.000,00)');


  		




  
  112
  
    
test_parse(9871234.5, '9.871.234,5',  '1.000,00', '9.871.234,5 (numberformat: 1.000,00)');


  		




  
  113
  
    
test_parse(1234.5,    '1234,5',       '1.000,00', '1234,5 (numberformat: 1.000,00)');


  		




  
  114
  
    
test_parse(12345,     '012345',       '1.000,00', '012345 (numberformat: 1.000,00)');


  		




  
  115
  
    
test_parse(1234.5,    '01.234,5',     '1.000,00', '01.234,5 (numberformat: 1.000,00)');


  		




  
  116
  
    
test_parse(1234.5,    '01234,5',      '1.000,00', '01234,5 (numberformat: 1.000,00)');


  		




  
  117
  
    
test_parse(9871234.5, '09.871.234,5', '1.000,00', '09.871.234,5 (numberformat: 1.000,00)');


  		




  
  118
  
    

  		




  
  119
  
    
# round


  		




  
  120
  
    

  		




  
  121
  
    
is(_round_number('3.231',2),'3.23');


  		




  
  122
  
    
is(_round_number('3.234',2),'3.23');


  		




  
  123
  
    
is(_round_number('3.235',2),'3.24');


  		




  
  124
  
    
is(_round_number('5.786',2),'5.79');


  		




  
  125
  
    
is(_round_number('2.342',2),'2.34');


  		




  
  126
  
    
is(_round_number('1.2345',2),'1.23');


  		




  
  127
  
    
is(_round_number('8.2345',2),'8.23');


  		




  
  128
  
    
is(_round_number('8.2350',2),'8.24');


  		




  
  129
  
    

  		




  
  130
  
    

  		




  
  131
  
    
is(_round_total('3.231'),'3.23');


  		




  
  132
  
    
is(_round_total('3.234'),'3.23');


  		




  
  133
  
    
is(_round_total('3.235'),'3.24');


  		




  
  134
  
    
is(_round_total('5.786'),'5.79');


  		




  
  135
  
    
is(_round_total('2.342'),'2.34');


  		




  
  136
  
    
is(_round_total('1.2345'),'1.23');


  		




  
  137
  
    
is(_round_total('8.2345'),'8.23');


  		




  
  138
  
    
is(_round_total('8.2350'),'8.24');


  		












  

    
      t/helper/round.t
    
  





  1
  
  
    
use Test::More tests => 9;


  		




  2
  
  
    

  		




  3
  
  
    
use lib 't';


  		




  4
  
  
    

  		




  5
  
  
    
use SL::Helper::Number qw(:all);


  		




  6
  
  
    

  		




  7
  
  
    
use_ok 'Support::TestSetup';


  		




  8
  
  
    

  		




  9
  
  
    
Support::TestSetup::login();


  		




  10
  
  
    

  		




  11
  
  
    
is(_round_number('3.231',2),'3.23');


  		




  12
  
  
    
is(_round_number('3.234',2),'3.23');


  		




  13
  
  
    
is(_round_number('3.235',2),'3.24');


  		




  14
  
  
    
is(_round_number('5.786',2),'5.79');


  		




  15
  
  
    
is(_round_number('2.342',2),'2.34');


  		




  16
  
  
    
is(_round_number('1.2345',2),'1.23');


  		




  17
  
  
    
is(_round_number('8.2345',2),'8.23');


  		




  18
  
  
    
is(_round_number('8.2350',2),'8.24');


  		












Auch abrufbar als:  Unified diff