Revision 5c0b8569
Von Sven Schöling vor mehr als 3 Jahren hinzugefügt
| 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 |
|
Auch abrufbar als: Unified diff
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