Ditch floating point numbers, use cents instead; bump version to 3.2
This commit is contained in:
Juerd Waalboer
parent
9b582d5f9b
commit
38a0229899
17 changed files with 545 additions and 168 deletions
85
README.md
85
README.md
|
|
@ -1,77 +1,24 @@
|
|||
# NAME
|
||||
# revbank - Banking for hackerspace visitors
|
||||
|
||||
revbank - Banking for hackerspace visitors
|
||||
## Upgrading
|
||||
|
||||
# ANNOUNCEMENTS
|
||||
When upgrading from a previous version, please refer to the file `UPGRADING.md`
|
||||
because there might be incompatible changes that require your attention.
|
||||
|
||||
The following features were removed:
|
||||
## Installing
|
||||
|
||||
- plugins `nyan` and `game`
|
||||
1. Install the Perl module Term::ReadLine::Gnu
|
||||
|
||||
Please remove these from your `revbank.plugins` configuration file.
|
||||
```
|
||||
Debian: apt install libterm-readline-gnu-perl
|
||||
Generic: cpan Term::ReadLine::Gnu
|
||||
```
|
||||
|
||||
- creating new accounts with `deposit`
|
||||
2. Clone the repository, run revbank :)
|
||||
|
||||
Use `adduser` instead.
|
||||
## Exiting revbank
|
||||
|
||||
- Method `$cart->is_multi_user`
|
||||
- Method `$cart->delete($user, $index)`
|
||||
|
||||
Delete a specific entry, as returned by `$cart->entries`, instead.
|
||||
|
||||
The following will disappear in a future version:
|
||||
|
||||
## Hooks `add` and `added`
|
||||
|
||||
Use `add_entry` and `added_entry` instead, which gets a RevBank::Cart::Entry
|
||||
object, instead.
|
||||
|
||||
Note that the new "entries", unlike old "items", can have a `quantity` other
|
||||
than 1.
|
||||
|
||||
## Method `$cart->add(undef, ...)`
|
||||
|
||||
## Method `$cart->add($user, ...)`
|
||||
|
||||
The `add` method now always creates an entry from the perspective of the
|
||||
current user, and returns a RevBank::Cart::Entry object to which "contras" can
|
||||
be added with `add_contra`. The contras can be used for counteracting a value
|
||||
with an operation on another account.
|
||||
|
||||
To upgrade a plugin that does a single `add` with `undef` as the first
|
||||
argument, simply remove the `undef, `. When multiple items were added that
|
||||
belong together, consider using `add_contra` for the subsequent lines; see the
|
||||
`take` and `give` plugins for examples.
|
||||
|
||||
## Method `$cart->select_items`
|
||||
|
||||
Use `entries` instead, which takes the same kind of argument. Note that
|
||||
entries work slightly differently: they can have a quantity and attached contra
|
||||
entries. Attributes are now accessed through the `has_attribute` and
|
||||
`attribute` methods, instead of directly manipulating the hash.
|
||||
|
||||
# DESCRIPTION
|
||||
|
||||
Maybe I'll write some documentation, but not now.
|
||||
|
||||
Shell-like invocation with `-c` is supported, sort of, but it has to be a
|
||||
complete command. Currently, multiple commands are supported on the command
|
||||
line (space separated), but that's an unintended feature...
|
||||
|
||||
# PLUGINS
|
||||
|
||||
Refer to [RevBank::Plugins](https://metacpan.org/pod/RevBank::Plugins) for documentation about writing plugins.
|
||||
|
||||
Plugins themselves may have some documentation in the respective plugin files.
|
||||
|
||||
Note that plugins that begin with `revspace_` are revspace specific hacks, and
|
||||
were not written with reusability in mind. They will probably not work for your
|
||||
setup.
|
||||
|
||||
# AUTHOR
|
||||
|
||||
Juerd Waalboer <#####@juerd.nl>
|
||||
|
||||
# LICENSE
|
||||
|
||||
Pick your favorite OSI license.
|
||||
Exiting is not supported because it's desigend to run continuously. But if you
|
||||
run it from a shell, you can probably stop it using ctrl+Z and then kill the
|
||||
process (e.g. `kill %1`). RevBank does not keep any files open, so it's safe
|
||||
to kill when idle.
|
||||
|
|
|
|||
77
UPGRADING.md
Normal file
77
UPGRADING.md
Normal file
|
|
@ -0,0 +1,77 @@
|
|||
# (2021-12-02) RevBank 3.2
|
||||
|
||||
## Update your custom plugins!
|
||||
|
||||
Test your custom plugins. If they don't emit warnings about floating point
|
||||
numbers, or if you don't care about warnings, then no changes are required.
|
||||
|
||||
RevBank no longer uses floating point numbers for amounts. Instead, there
|
||||
are now RevBank::Amount objects, which internally store an integer number
|
||||
of cents, but externally stringify to formatted numbers with 2 decimal places.
|
||||
|
||||
To create such an object, use `parse_amount` as per usual.
|
||||
|
||||
Formatting no longer requires `sprintf %.2f`, just use `%s` instead.
|
||||
|
||||
Using an amount as a floating point number will now emit warnings in some
|
||||
cases, to alert you to the fact that this may result in rounding errors.
|
||||
To convert an amount to a floating point number without a warning, use
|
||||
`$amount->float`. To convert a floating point number to an amount without a
|
||||
warning, use `RevBank::Amount->new_from_float($float)`.
|
||||
|
||||
Most hard-coded uses of floats are safe enough and transparently supported
|
||||
through overloaded operators, but if there are more than 2 decimal places, the
|
||||
operation will be disallowed.
|
||||
|
||||
# (2019-11-05) RevBank 3
|
||||
|
||||
The following features were removed:
|
||||
|
||||
- plugins `nyan` and `game`
|
||||
|
||||
Please remove these from your `revbank.plugins` configuration file.
|
||||
|
||||
- creating new accounts with `deposit`
|
||||
|
||||
Use `adduser` instead.
|
||||
|
||||
## Update your custom plugins!
|
||||
|
||||
### Method `$cart->is_multi_user`
|
||||
|
||||
Method has been removed.
|
||||
|
||||
### Method `$cart->delete($user, $index)`
|
||||
|
||||
Method has been removed.
|
||||
|
||||
Delete a specific entry, as returned by `$cart->entries`, instead.
|
||||
|
||||
### Hooks `add` and `added`
|
||||
|
||||
Use `add_entry` and `added_entry` instead, which gets a RevBank::Cart::Entry
|
||||
object, instead.
|
||||
|
||||
Note that the new "entries", unlike old "items", can have a `quantity` other
|
||||
than 1.
|
||||
|
||||
### Method `$cart->add(undef, ...)`
|
||||
|
||||
### Method `$cart->add($user, ...)`
|
||||
|
||||
The `add` method now always creates an entry from the perspective of the
|
||||
current user, and returns a RevBank::Cart::Entry object to which "contras" can
|
||||
be added with `add_contra`. The contras can be used for counteracting a value
|
||||
with an operation on another account.
|
||||
|
||||
To upgrade a plugin that does a single `add` with `undef` as the first
|
||||
argument, simply remove the `undef, `. When multiple items were added that
|
||||
belong together, consider using `add_contra` for the subsequent lines; see the
|
||||
`take` and `give` plugins for examples.
|
||||
|
||||
### Method `$cart->select_items`
|
||||
|
||||
Use `entries` instead, which takes the same kind of argument. Note that
|
||||
entries work slightly differently: they can have a quantity and attached contra
|
||||
entries. Attributes are now accessed through the `has_attribute` and
|
||||
`attribute` methods, instead of directly manipulating the hash.
|
||||
126
lib/RevBank/Amount.pm
Normal file
126
lib/RevBank/Amount.pm
Normal file
|
|
@ -0,0 +1,126 @@
|
|||
package RevBank::Amount;
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use experimental qw(signatures);
|
||||
use Carp qw(carp croak);
|
||||
use Scalar::Util;
|
||||
use POSIX qw(lround);
|
||||
|
||||
our $C = __PACKAGE__;
|
||||
|
||||
sub _coerce {
|
||||
for (@_) {
|
||||
unless (ref and UNIVERSAL::isa($_, $C)) {
|
||||
croak "Unsupported operation on $C with " . ref if ref;
|
||||
croak "Unsupported operation on $C with undef" if not defined;
|
||||
|
||||
my $old = $_;
|
||||
|
||||
$_ = RevBank::Amount->parse_string("$_");
|
||||
croak "Unsupported operation on $C with invalid amount '$old'"
|
||||
if not defined;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
use overload (
|
||||
'""' => sub ($self, @) { $self->string },
|
||||
"bool" => sub ($self, @) { $self->cents },
|
||||
"0+" => sub ($self, @) { $self->_float_warn },
|
||||
"+" => sub ($a, $b, $swap) {
|
||||
$b //= 0;
|
||||
_coerce($a, $b);
|
||||
return $C->new($$a + $$b)
|
||||
},
|
||||
"-" => sub ($a, $b, $swap) {
|
||||
_coerce($a, $b);
|
||||
return $C->new(($swap?-1:1) * ($$a - $$b))
|
||||
},
|
||||
"*" => sub ($a, $b, $swap) {
|
||||
$b = $b->_float_warn if ref $b;
|
||||
$C->new($$a * $b);
|
||||
},
|
||||
"/" => sub ($a, $b, $swap) {
|
||||
carp "Using floating-point arithmetic for $a/$b (use \$amount->float to suppress warning)";
|
||||
$b = $b->float if ref $b;
|
||||
$C->new($$a / $b);
|
||||
},
|
||||
"<=>" => sub ($a, $b, $swap) {
|
||||
_coerce($a, $b);
|
||||
return $swap ? $$b<=>$$a : $$a<=>$$b;
|
||||
},
|
||||
"cmp" => sub ($a, $b, $swap) {
|
||||
_coerce($a, $b);
|
||||
return $swap ? $$b<=>$$a : $$a<=>$$b;
|
||||
},
|
||||
);
|
||||
|
||||
sub new($class, $cents) {
|
||||
my $int = int sprintf "%d", $cents;
|
||||
#carp "$cents rounded to $int cents" if $int != $cents;
|
||||
return bless \$int, $class;
|
||||
}
|
||||
|
||||
sub new_from_float($class, $num) {
|
||||
return $class->new(lround 100 * sprintf "%.02f", $num);
|
||||
|
||||
# First, round the float with sprintf for bankers rounding, then
|
||||
# multiply to get number of cents. However, 4.56 as a float is
|
||||
# 4.55999... which with int would get truncated to 455, so lround is needed
|
||||
# to get 456.
|
||||
# Note: _l_round, because normal round gives the int *AS A FLOAT*; sigh.
|
||||
}
|
||||
|
||||
sub parse_string($class, $str) {
|
||||
$str =~ /\S/ or return undef;
|
||||
|
||||
my ($neg, $int, $cents)
|
||||
= $str =~ /^\s*(?:\+|(-)?)([0-9]+)?(?:[,.]([0-9]{1,2}))?\s*$/
|
||||
or return undef;
|
||||
|
||||
$int //= 0;
|
||||
$cents //= 0;
|
||||
$cents *= 10 if length($cents) == 1; # 4.2 -> 4.20
|
||||
|
||||
return $class->new(
|
||||
($neg ? -1 : 1) * ($int * 100 + $cents)
|
||||
);
|
||||
}
|
||||
|
||||
sub cents($self) {
|
||||
return $$self;
|
||||
}
|
||||
|
||||
sub float($self) {
|
||||
return $$self / 100;
|
||||
}
|
||||
|
||||
sub _float_warn($self) {
|
||||
carp "Using $C $self as floating-point number (use %s in sprintf instead of %.2f, or \$amount->float to suppress warning)";
|
||||
return $self->float;
|
||||
}
|
||||
|
||||
sub string($self, $plus = "") {
|
||||
return sprintf(
|
||||
"%s%d.%02d",
|
||||
$$self < 0 ? "-" : $plus,
|
||||
abs($$self) / 100,
|
||||
abs($$self) % 100,
|
||||
);
|
||||
}
|
||||
|
||||
sub string_flipped($self, $sep = " ") {
|
||||
return sprintf(
|
||||
"%s%s%d.%02d",
|
||||
$$self > 0 ? "+" : "",
|
||||
$sep,
|
||||
abs($$self) / 100,
|
||||
abs($$self) % 100,
|
||||
);
|
||||
}
|
||||
|
||||
sub abs($self) {
|
||||
return $C->new(abs $$self)
|
||||
}
|
||||
|
||||
1;
|
||||
104
lib/RevBank/Amount.pod
Normal file
104
lib/RevBank/Amount.pod
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
=head1 NAME
|
||||
|
||||
RevBank::Amount - Fixed point 2-decimal numeric values that DWYM
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
$amount = RevBank::Amount->new(30); # 0.30
|
||||
$amount = RevBank::Amount->parse_string("0.30"); # 0.30
|
||||
|
||||
$amount->cents # 30
|
||||
$amount->string # "0.30"
|
||||
|
||||
$a2 = $amount + "1.23"
|
||||
|
||||
# Not recommended:
|
||||
$a2 = $amount + $float # may emit warning
|
||||
$a2 = $amount / $anything # emits warning
|
||||
$a2 = $amount * 1.21 # emits warning
|
||||
|
||||
# If you have to use floats, do so explicitly:
|
||||
$amount = RevBank::Amount->new_from_float(.3);
|
||||
$amount = RevBank::Amount->new_from_float(0.30);
|
||||
$amount = RevBank::Amount->new_from_float(0.425); # rounds to .42, no warning
|
||||
$amount->float
|
||||
|
||||
$a2 = $amount->new_from_float($amount->float * 1.21); # no warning
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This class implements numeric values at two decimal digits precision,
|
||||
with transparent rounding to whole cents. Regular numeric operations are
|
||||
supported through operator overloading, and instances stringify as
|
||||
formatted numbers. Non-integer arithmetic is done using floating point
|
||||
operations, after which the result is converted back into a fixed point
|
||||
object.
|
||||
|
||||
Using floating point for financial applications is generally a bad idea,
|
||||
but RevBank was originally built with floats, and now we're stuck having
|
||||
to keep supporting them at least a bit, for backwards compatibility with
|
||||
existing plugins. For new code, it is recommended to use integer
|
||||
arithmetic on the number of cents only.
|
||||
|
||||
When rounding early enough, using floating point numbers isn't much of a
|
||||
problem when working with 2 decimals in amounts of money that are
|
||||
customary in day to day usage by people. Every number is sufficiently
|
||||
accurately representable as an IEEE single, and Perl's own
|
||||
stringification of floating points takes care of the most annoying
|
||||
differences. But if you don't round (and earlier RevBank didn't always
|
||||
do that), strange things can happen. Also, "-0.00" is annoying...
|
||||
|
||||
Note: this class does not play nice with other classes that use operator
|
||||
overloading.
|
||||
|
||||
=head2 Constructors
|
||||
|
||||
=head3 new
|
||||
|
||||
Construct from a number of cents. If the number is not an integer, it
|
||||
will be rounded without warning, is a possibly surprising way.
|
||||
|
||||
=head3 new_from_float
|
||||
|
||||
Construct from a number. The number will be rounded to two decimals
|
||||
without warning, in a possibly surprising way.
|
||||
|
||||
=head3 parse_string
|
||||
|
||||
Construct from a string. Either C<,> or C<.> is accepted as a decimal
|
||||
point; no other separators (like thousands separators) are accepted. The
|
||||
string may optionally be prefixed with a sign, either C<+> or C<->.
|
||||
Numbers with more than two digits after the decimal point are rejected.
|
||||
Whitespace is ignored at either end of the string, but invalid within a
|
||||
number or between the sign and the number.
|
||||
|
||||
Returns undef when the given string is not valid.
|
||||
|
||||
=head2 Instance methods
|
||||
|
||||
=head3 cents
|
||||
|
||||
Returns an integer that accurately represents the amount in cents.
|
||||
|
||||
=head3 float
|
||||
|
||||
Returns the floating point number that is the closest to the actual
|
||||
amount. Note: not all numbers can be accurately represented as a
|
||||
floating point number, which is the reason this class exists...
|
||||
|
||||
=head3 string
|
||||
|
||||
Returns a formatted number. Negative numbers get a sign in front, while
|
||||
zero and positive numbers do not.
|
||||
|
||||
=head2 Overloading
|
||||
|
||||
Overloaded operations may throw an exception when the operand doesn't
|
||||
stringify to something that is accepted by C<parse_string>, e.g. C<<
|
||||
$amount + 1.001 >> won't work because 0.001 has too many digits after
|
||||
the decimal point.
|
||||
|
||||
When working with values that aren't safe, hard-coded literals, always
|
||||
turn them into RevBank::Amount objects first, which takes care of te
|
||||
necessary rounding: C<< $amount + RevBank::Amount->new_from_float(1.001)
|
||||
>>.
|
||||
|
|
@ -87,6 +87,7 @@ sub checkout {
|
|||
for my $entry (@$entries) {
|
||||
$entry->user($user);
|
||||
|
||||
$deltas{$entry->{user}} //= RevBank::Amount->new(0);
|
||||
$deltas{$_->{user}} += $_->{amount} * $entry->quantity
|
||||
for $entry, $entry->contras;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -11,6 +11,8 @@ sub new {
|
|||
@_ >= 3 or croak "Not enough arguments for RevBank::Cart::Entry->new";
|
||||
$attributes //= {};
|
||||
|
||||
$amount = RevBank::Amount->parse_string($amount) if not ref $amount;
|
||||
|
||||
my $self = {
|
||||
quantity => 1,
|
||||
amount => $amount, # negative = pay, positive = add money
|
||||
|
|
@ -27,6 +29,8 @@ sub new {
|
|||
sub add_contra {
|
||||
my ($self, $user, $amount, $description) = @_;
|
||||
|
||||
$amount = RevBank::Amount->parse_string($amount) if not ref $amount;
|
||||
|
||||
$description =~ s/\$you/$self->{user}/g if defined $self->{user};
|
||||
|
||||
push @{ $self->{contras} }, {
|
||||
|
|
@ -92,17 +96,13 @@ sub as_printable {
|
|||
# Normally, the implied sign is "+", and an "-" is only added for negative
|
||||
# numbers. Here, the implied sign is "-", and a "+" is only added for
|
||||
# positive numbers.
|
||||
push @s, sprintf " %6.2f %s", abs($self->{amount}), $self->{description};
|
||||
|
||||
# Add the plus before the number instead of whitespace, leaving one space
|
||||
# character between the sign and the number to make it stand out more.
|
||||
$s[-1] =~ s/\s(?=\s\d)/+/ if $self->{amount} > 0;
|
||||
push @s, sprintf " %6s %s", $self->{amount}->string_flipped, $self->{description};
|
||||
|
||||
for my $c ($self->contras) {
|
||||
push @s, sprintf(
|
||||
" %9.2f %s %s",
|
||||
abs($c->{amount}),
|
||||
($c->{amount} > 0 ? "->" : "<-"),
|
||||
" %9s %s %s",
|
||||
$c->{amount}->abs->string,
|
||||
($c->{amount}->cents > 0 ? "->" : "<-"),
|
||||
$c->{user}
|
||||
);
|
||||
|
||||
|
|
@ -128,10 +128,10 @@ sub as_loggable {
|
|||
my $description =
|
||||
$quantity == 1
|
||||
? $_->{description}
|
||||
: sprintf("%s [%sx %.2f]", $_->{description}, $quantity, abs($_->{amount}));
|
||||
: sprintf("%s [%sx %s]", $_->{description}, $quantity, abs($_->{amount}));
|
||||
|
||||
push @s, sprintf(
|
||||
"%-12s %4s %3d %5.2f # %s",
|
||||
"%-12s %4s %3d %5s # %s",
|
||||
$_->{user},
|
||||
($total > 0 ? 'GAIN' : $total < 0 ? 'LOSE' : ''),
|
||||
$quantity,
|
||||
|
|
@ -166,20 +166,20 @@ sub sanity_check {
|
|||
return 1 if $self->{FORCE};
|
||||
my @contras = $self->contras or return 1;
|
||||
|
||||
my $amount = List::Util::sum(map $_->{amount}, $self, @contras);
|
||||
my $sum = List::Util::sum(map $_->{amount}->cents, $self, @contras);
|
||||
|
||||
if ($amount >= 0.005) { # meh, floats
|
||||
if ($sum > 0) {
|
||||
$self->{FORCE} = 1;
|
||||
croak join("\n",
|
||||
"BUG! (probably in $self->{caller})",
|
||||
"This adds up to creating money that does not exist:",
|
||||
$self->as_printable,
|
||||
(
|
||||
$amount == 2 * $self->{amount}
|
||||
$sum == 2 * $self->{amount}->cents
|
||||
? "Hint: contras for positive value should be negative values."
|
||||
: ()
|
||||
),
|
||||
sprintf("Cowardly refusing to create %.2f out of thin air", $amount)
|
||||
sprintf("Cowardly refusing to create $sum out of thin air")
|
||||
);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
package RevBank::Global;
|
||||
use strict;
|
||||
use POSIX qw(strftime);
|
||||
use RevBank::Amount;
|
||||
|
||||
sub import {
|
||||
require RevBank::Plugins;
|
||||
|
|
@ -17,15 +18,15 @@ sub import {
|
|||
my ($amount) = @_;
|
||||
defined $amount or return undef;
|
||||
length $amount or return undef;
|
||||
$amount =~ /^(-)?[0-9]*(?:[,.][0-9]{1,2})?$/ or return undef;
|
||||
if ($1) {
|
||||
|
||||
$amount = RevBank::Amount->parse_string($amount) // return undef;
|
||||
if ($amount->cents < 0) {
|
||||
die "For our sanity, no negative amounts, please :).\n";
|
||||
}
|
||||
$amount =~ s/,/./g;
|
||||
if ($amount > 999) {
|
||||
if ($amount->cents > 99900) {
|
||||
die "That's way too much money, or an unknown barcode.\n";
|
||||
}
|
||||
return 0 + $amount;
|
||||
return $amount;
|
||||
};
|
||||
*{"$caller\::call_hooks"} = \&RevBank::Plugins::call_hooks;
|
||||
*{"$caller\::say"} = sub {
|
||||
|
|
|
|||
|
|
@ -29,8 +29,9 @@ sub hook_cart_changed {
|
|||
|
||||
if (not $cart->entries('refuse_checkout')) {
|
||||
my $sum = $cart->sum;
|
||||
my $what = $sum > 0 ? "add %.2f" : "pay %.2f";
|
||||
say sprintf "Enter username to $what; type 'abort' to abort.", abs $sum;
|
||||
my $what = $sum > 0 ? "add" : "pay";
|
||||
my $abs = $sum->abs;
|
||||
say "Enter username to $what $abs; type 'abort' to abort.";
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -53,9 +54,10 @@ sub hook_user_balance {
|
|||
my ($class, $username, $old, $delta, $new) = @_;
|
||||
my $sign = $delta >= 0 ? '+' : '-';
|
||||
my $rood = $new < 0 ? '31;' : '';
|
||||
printf "New balance for %s: %+.2f %s %.2f = \e[${rood}1m%+.2f\e[0m %s\n",
|
||||
$username, $old, $sign, abs($delta), $new,
|
||||
($new < -13.37 ? "\e[5;1m(!!)\e[0m" : "");
|
||||
my $abs = abs($delta);
|
||||
my $warn = $new < -13.37 ? " \e[5;1m(!!)\e[0m" : "";
|
||||
$_ = $_->string("+") for $old, $new;
|
||||
printf "New balance for $username: $old $sign $abs = \e[${rood}1m$new\e[0m$warn\n",
|
||||
}
|
||||
|
||||
sub hook_user_created {
|
||||
|
|
|
|||
|
|
@ -45,7 +45,10 @@ sub update {
|
|||
while (defined (my $line = readline $in)) {
|
||||
my @a = split " ", $line;
|
||||
if (lc $a[0] eq lc $username) {
|
||||
$old = $a[1];
|
||||
$old = RevBank::Amount->parse_string($a[1]);
|
||||
die "Fatal error: invalid balance in revbank:accounts:$.\n"
|
||||
if not defined $old;
|
||||
|
||||
$new = $old + $delta;
|
||||
|
||||
my $since = $a[3] // "";
|
||||
|
|
@ -53,7 +56,7 @@ sub update {
|
|||
$since = "-\@" . now() if $new < 0 and (!$since or $old >= 0);
|
||||
$since = "0\@" . now() if $new == 0 and (!$since or $old != 0);
|
||||
|
||||
printf {$out} "%-16s %+9.2f %s %s\n", (
|
||||
printf {$out} "%-16s %9s %s %s\n", (
|
||||
$username, $new, now(), $since
|
||||
) or die $!;
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -25,11 +25,7 @@ sub amount {
|
|||
$self->{amount} = parse_amount($input)
|
||||
or return REJECT, "$input: Invalid amount.";
|
||||
|
||||
return sprintf(
|
||||
"Why are you giving %.2f to %s, or enter your username to end",
|
||||
$self->{amount},
|
||||
$self->{beneficiary}
|
||||
), \&reason;
|
||||
return "Why are you giving $self->{amount} to $self->{beneficiary}, or enter your username to end", \&reason;
|
||||
}
|
||||
|
||||
sub reason :Tab(whatevah) {
|
||||
|
|
|
|||
|
|
@ -41,9 +41,9 @@ sub hook_user_created {
|
|||
|
||||
sub hook_user_balance {
|
||||
my ($class, $user, $old, $delta, $new, $transaction_id) = @_;
|
||||
$_ = sprintf "%+.02f", $_ for $old, $delta, $new;
|
||||
my $lost = $delta < 0 ? "lost" : "got";
|
||||
$delta = abs($delta);
|
||||
$delta = $delta->abs;
|
||||
$_ = $_->string("+") for $old, $new;
|
||||
_log("BALANCE $transaction_id $user had $old, $lost $delta, now has $new");
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -26,7 +26,8 @@ sub command :Tab(pfand) {
|
|||
|
||||
sub product :Tab(&tab) {
|
||||
my ($self, $cart, $product) = @_;
|
||||
my $pfand = _read_pfand->{ $product };
|
||||
my $pfand = parse_amount(_read_pfand->{ $product })
|
||||
or return REJECT, "Invalid pfand amount for $product";
|
||||
|
||||
if ($pfand) {
|
||||
$cart->add(+$pfand, "Pfand zurueck", { is_return => 1 });
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ sub command {
|
|||
}
|
||||
|
||||
if ($last->has_attribute('is_withdrawal')) {
|
||||
$lhs = abs $last->{amount};
|
||||
$lhs = $last->{amount}->abs->float;
|
||||
$lhs == int $lhs or return REJECT, "Repeat only works on integers.";
|
||||
$cart->delete($last);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ sub command :Tab(take,steal,split) {
|
|||
|
||||
return REJECT, "Nothing to split. Add products first." if not $sum;
|
||||
|
||||
printf "Splitting %.2f over \$you and others.\n", $sum;
|
||||
print "Splitting $sum over \$you and others.\n";
|
||||
return "User to take from (not yourself)", \&arg;
|
||||
}
|
||||
|
||||
|
|
@ -32,8 +32,8 @@ sub arg :Tab(USERS) {
|
|||
|
||||
if (@$users and $arg eq $self->{split_finish}) {
|
||||
my $amount = $self->{split_amount};
|
||||
my $each = sprintf "%.2f", $amount / (@$users + 1);
|
||||
my $total = sprintf "%.2f", @$users * $each;
|
||||
my $each = RevBank::Amount->new_from_float($amount->float / (@$users + 1));
|
||||
my $total = @$users * $each;
|
||||
my $desc = join " + ", map $_->{description}, _select_split($cart);
|
||||
|
||||
my $joined = join '/', @$users;
|
||||
|
|
@ -49,9 +49,9 @@ sub arg :Tab(USERS) {
|
|||
my $user = parse_user($arg) or return REJECT, "$arg: No such user.";
|
||||
push @$users, $user;
|
||||
|
||||
my $each = sprintf "%.2f", $self->{split_amount} / (@$users + 1);
|
||||
$self->{split_finish} = $each;
|
||||
my $each = RevBank::Amount->new_from_float($self->{split_amount}->float / (@$users + 1));
|
||||
$self->{split_finish} = $each->string;
|
||||
|
||||
return "User to take from (not yourself) or $each to finish", \&arg;
|
||||
return "User to take from (not yourself) or $self->{split_finish} to finish", \&arg;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -20,8 +20,8 @@ sub arg :Tab(USERS) {
|
|||
my $amount = parse_amount($arg);
|
||||
|
||||
if (@users and $amount) {
|
||||
my $each = sprintf "%.2f", $amount / @users;
|
||||
my $total = sprintf "%.2f", @users * $each;
|
||||
my $each = RevBank::Amount->new_from_float($amount->float / @users);
|
||||
my $total = $each * @users;
|
||||
|
||||
if ($total != $amount) {
|
||||
print "Adjusted total amount to $total because of rounding.\n";
|
||||
|
|
@ -32,8 +32,7 @@ sub arg :Tab(USERS) {
|
|||
|
||||
my $them = @users == 1 ? $users[0] : 'each';
|
||||
|
||||
return sprintf("Why are you taking %.2f from %s?", $each, $them),
|
||||
\&reason;
|
||||
return "Why are you taking $each from $them", \&reason;
|
||||
}
|
||||
|
||||
my $user = parse_user($arg);
|
||||
|
|
|
|||
55
revbank
55
revbank
|
|
@ -14,7 +14,7 @@ use RevBank::Global;
|
|||
use RevBank::Messages;
|
||||
use RevBank::Cart;
|
||||
|
||||
our $VERSION = "3";
|
||||
our $VERSION = "3.2";
|
||||
our %HELP = (
|
||||
"abort" => "Abort the current transaction",
|
||||
);
|
||||
|
|
@ -259,59 +259,6 @@ OUTER: for (;;) {
|
|||
|
||||
revbank - Banking for hackerspace visitors
|
||||
|
||||
=head1 ANNOUNCEMENTS
|
||||
|
||||
The following features were removed:
|
||||
|
||||
=over
|
||||
|
||||
=item * plugins C<nyan> and C<game>
|
||||
|
||||
Please remove these from your C<revbank.plugins> configuration file.
|
||||
|
||||
=item * creating new accounts with C<deposit>
|
||||
|
||||
Use C<adduser> instead.
|
||||
|
||||
=item * Method C<< $cart->is_multi_user >>
|
||||
|
||||
=item * Method C<< $cart->delete($user, $index) >>
|
||||
|
||||
Delete a specific entry, as returned by C<< $cart->entries >>, instead.
|
||||
|
||||
=back
|
||||
|
||||
The following will disappear in a future version:
|
||||
|
||||
=head2 Hooks C<add> and C<added>
|
||||
|
||||
Use C<add_entry> and C<added_entry> instead, which gets a RevBank::Cart::Entry
|
||||
object, instead.
|
||||
|
||||
Note that the new "entries", unlike old "items", can have a C<quantity> other
|
||||
than 1.
|
||||
|
||||
=head2 Method C<< $cart->add(undef, ...) >>
|
||||
|
||||
=head2 Method C<< $cart->add($user, ...) >>
|
||||
|
||||
The C<add> method now always creates an entry from the perspective of the
|
||||
current user, and returns a RevBank::Cart::Entry object to which "contras" can
|
||||
be added with C<add_contra>. The contras can be used for counteracting a value
|
||||
with an operation on another account.
|
||||
|
||||
To upgrade a plugin that does a single C<add> with C<undef> as the first
|
||||
argument, simply remove the C<undef, >. When multiple items were added that
|
||||
belong together, consider using C<add_contra> for the subsequent lines; see the
|
||||
C<take> and C<give> plugins for examples.
|
||||
|
||||
=head2 Method C<< $cart->select_items >>
|
||||
|
||||
Use C<< entries >> instead, which takes the same kind of argument. Note that
|
||||
entries work slightly differently: they can have a quantity and attached contra
|
||||
entries. Attributes are now accessed through the C<has_attribute> and
|
||||
C<attribute> methods, instead of directly manipulating the hash.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Maybe I'll write some documentation, but not now.
|
||||
|
|
|
|||
173
t/amount.t
Normal file
173
t/amount.t
Normal file
|
|
@ -0,0 +1,173 @@
|
|||
use v5.28;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
use Test::Exception;
|
||||
use Test::Warnings ":all";
|
||||
|
||||
require_ok('RevBank::Amount');
|
||||
|
||||
my $a = RevBank::Amount->new(123);
|
||||
|
||||
# Basic
|
||||
isa_ok($a, "RevBank::Amount");
|
||||
cmp_ok($a->cents, '==', 123);
|
||||
cmp_ok($a->float, '==', 1.23);
|
||||
is($a->string, "1.23");
|
||||
|
||||
# $ perl -le'printf "%.16f\n", 4.56'
|
||||
# 4.5599999999999996
|
||||
cmp_ok(RevBank::Amount->new(456)->cents, '==', 456);
|
||||
cmp_ok(RevBank::Amount->parse_string("4.56")->cents, '==', 456);
|
||||
cmp_ok(RevBank::Amount->parse_string("4,56")->cents, '==', 456);
|
||||
cmp_ok(RevBank::Amount->new_from_float(4.56)->cents, '==', 456);
|
||||
|
||||
cmp_ok(RevBank::Amount->new(-456)->cents, '==', -456);
|
||||
cmp_ok(RevBank::Amount->parse_string("-4.56")->cents, '==', -456);
|
||||
cmp_ok(RevBank::Amount->parse_string("-4,56")->cents, '==', -456);
|
||||
cmp_ok(RevBank::Amount->new_from_float(-4.56)->cents, '==', -456);
|
||||
cmp_ok(RevBank::Amount->new(-456)->string, 'eq', "-4.56");
|
||||
|
||||
cmp_ok(RevBank::Amount->parse_string(".5")->cents, '==', 50);
|
||||
cmp_ok(RevBank::Amount->parse_string("-.5")->cents, '==', -50);
|
||||
cmp_ok(RevBank::Amount->parse_string("4.5")->cents, '==', 450);
|
||||
cmp_ok(RevBank::Amount->parse_string("4,5")->cents, '==', 450);
|
||||
cmp_ok(RevBank::Amount->parse_string("4")->cents, '==', 400);
|
||||
cmp_ok(RevBank::Amount->parse_string("-4")->cents, '==', -400);
|
||||
cmp_ok(RevBank::Amount->parse_string("+4")->cents, '==', 400);
|
||||
cmp_ok(RevBank::Amount->parse_string(" 4")->cents, '==', 400);
|
||||
cmp_ok(RevBank::Amount->parse_string("4 ")->cents, '==', 400);
|
||||
|
||||
cmp_ok(RevBank::Amount->new_from_float(.425)->cents, '==', 42);
|
||||
|
||||
# comparisons
|
||||
ok($a);
|
||||
ok(!RevBank::Amount->new(0));
|
||||
cmp_ok($a, '==', 1.23);
|
||||
cmp_ok($a, '<', 1.24);
|
||||
cmp_ok($a, '>', 1.22);
|
||||
cmp_ok($a, '>', 0.30);
|
||||
cmp_ok($a, '<', 4.56);
|
||||
cmp_ok($a, '<=', 1.23);
|
||||
cmp_ok($a, '>=', 1.23);
|
||||
cmp_ok($a, "eq", "1.23");
|
||||
cmp_ok($a, 'lt', "1.24");
|
||||
cmp_ok($a, 'gt', "1.22");
|
||||
cmp_ok($a, 'le', "1.23");
|
||||
cmp_ok($a, 'ge', "1.23");
|
||||
|
||||
# unary
|
||||
is(+$a, "1.23");
|
||||
is(-$a, "-1.23");
|
||||
|
||||
# ints/floats
|
||||
is("" . $a * 4, "4.92");
|
||||
is("" . 4 * $a, "4.92");
|
||||
is("" .$a + 1.23, "2.46");
|
||||
is("" . 1.23 + $a, "2.46");
|
||||
is("" . $a - 1, "0.23");
|
||||
is("" . 1 - $a, "-0.23");
|
||||
is("" . $a + 1, "2.23");
|
||||
is("" . 1 + $a, "2.23");
|
||||
is("" . $a * 1.21, "1.48");
|
||||
is("" . 1.21 * $a, "1.48");
|
||||
is("" . $a * 1.219, "1.49");
|
||||
is("" . 1.219 * $a, "1.49");
|
||||
like(warning { is("" . $a / 2, "0.61") }, qr/float/);
|
||||
like(warning { is("" . $a / 2.5, "0.49") }, qr/float/);
|
||||
like(warning { "" . 1.5 / $a }, qr/float/);
|
||||
|
||||
# strings
|
||||
is("" . $a * "4", "4.92");
|
||||
is("" . "4" * $a, "4.92");
|
||||
is("" . $a + "1.23", "2.46");
|
||||
is("" . "1.23" + $a, "2.46");
|
||||
is("" . $a - "1", "0.23");
|
||||
is("" . "1" - $a, "-0.23");
|
||||
is("" . $a + "1", "2.23");
|
||||
is("" . "1" + $a, "2.23");
|
||||
is("" . $a * "1.21", "1.48");
|
||||
is("" . "1.21" * $a, "1.48");
|
||||
is("" . $a * "1.219", "1.49");
|
||||
is("" . "1.219" * $a, "1.49");
|
||||
like(warning { is("" . $a / "2", "0.61") }, qr/float/);
|
||||
like(warning { is("" . $a / "2.5", "0.49") }, qr/float/);
|
||||
|
||||
# other amounts
|
||||
is("" . $a + $a, "2.46");
|
||||
my $b = RevBank::Amount->new(.3 * 100);
|
||||
cmp_ok($b, "<", $a);
|
||||
cmp_ok($b, "<=", $a);
|
||||
cmp_ok($b, "lt", $a);
|
||||
cmp_ok($b, "le", $a);
|
||||
is("" . ($b *= 5), "1.50");
|
||||
is("" . $b, "1.50");
|
||||
is("" . $a + $b, "2.73");
|
||||
is("" . $a - $b, "-0.27");
|
||||
like(warning { is($a * $b, "1.84") }, qr/floating-point/);
|
||||
|
||||
# typical float example .3 - .2 - .1 != 0
|
||||
is("" . RevBank::Amount->new_from_float(.3 - .2 - .1), "0.00");
|
||||
#is("" . RevBank::Amount->new(30) - .2 - .1, "0.00"); # chained minus doesn't overload as expected
|
||||
#is("" . RevBank::Amount->new(30) - "0.20" - "0.10", "0.00");
|
||||
is("" . RevBank::Amount->new(30) - RevBank::Amount->new(20) - RevBank::Amount->new(10), "0.00");
|
||||
|
||||
is(
|
||||
""
|
||||
. RevBank::Amount->parse_string("5.55")
|
||||
+ RevBank::Amount->parse_string("18.65")
|
||||
- RevBank::Amount->parse_string("15")
|
||||
- RevBank::Amount->parse_string("5")
|
||||
- RevBank::Amount->parse_string("4.20"),
|
||||
"0.00" # sprintf %.2f would result in "-0.00"
|
||||
);
|
||||
|
||||
is(RevBank::Amount->parse_string("-0.00")->string, "0.00");
|
||||
is(RevBank::Amount->parse_string("-0,00")->string, "0.00");
|
||||
is(RevBank::Amount->parse_string("-0")->string, "0.00");
|
||||
is(RevBank::Amount->parse_string("0.00")->string, "0.00");
|
||||
is(RevBank::Amount->parse_string("0,00")->string, "0.00");
|
||||
is(RevBank::Amount->parse_string("0")->string, "0.00");
|
||||
is(RevBank::Amount->new_from_float(0)->string, "0.00");
|
||||
|
||||
like(warning { 1.5 / $a }, qr/float/);
|
||||
like(warning { $a / $a }, qr/float/);
|
||||
like(warning { rand $a }, qr/float/);
|
||||
|
||||
# Invalid amounts
|
||||
|
||||
is(RevBank::Amount->parse_string("0.000"), undef);
|
||||
is(RevBank::Amount->parse_string("0.042"), undef);
|
||||
is(RevBank::Amount->parse_string("+0.042"), undef);
|
||||
is(RevBank::Amount->parse_string("-0.042"), undef);
|
||||
is(RevBank::Amount->parse_string("0,000"), undef);
|
||||
is(RevBank::Amount->parse_string("0,042"), undef);
|
||||
is(RevBank::Amount->parse_string("+0,042"), undef);
|
||||
is(RevBank::Amount->parse_string("-0,042"), undef);
|
||||
is(RevBank::Amount->parse_string("foo"), undef);
|
||||
is(RevBank::Amount->parse_string(""), undef);
|
||||
is(RevBank::Amount->parse_string("."), undef);
|
||||
is(RevBank::Amount->parse_string(","), undef);
|
||||
is(RevBank::Amount->parse_string("--2"), undef);
|
||||
is(RevBank::Amount->parse_string("+-2"), undef);
|
||||
is(RevBank::Amount->parse_string("++2"), undef);
|
||||
is(RevBank::Amount->parse_string("+ 2"), undef);
|
||||
is(RevBank::Amount->parse_string("- 2"), undef);
|
||||
is(RevBank::Amount->parse_string("2 .00"), undef);
|
||||
dies_ok(sub { $a == 1.231 });
|
||||
dies_ok(sub { $a > 1.231 });
|
||||
dies_ok(sub { $a < 1.231 });
|
||||
dies_ok(sub { $a - 1.231 });
|
||||
dies_ok(sub { $a + 1.231 });
|
||||
dies_ok(sub { $a eq "1.231" });
|
||||
dies_ok(sub { $a gt "1.231" });
|
||||
dies_ok(sub { $a lt "1.231" });
|
||||
|
||||
# Round tripping stringification
|
||||
for (-5e99, -5e12, -1, -.99, 0, .99, 1, 5e12) {
|
||||
# -5e99 becomes -92233720368547760.08 which is great for this test :)
|
||||
my $a = RevBank::Amount->new_from_float($_);
|
||||
is($a->string, RevBank::Amount->parse_string($a->string)->string);
|
||||
}
|
||||
|
||||
done_testing();
|
||||
Loading…
Add table
Add a link
Reference in a new issue