From 38a0229899328be9e3eabd907a5f90fe15b143d3 Mon Sep 17 00:00:00 2001 From: Juerd Waalboer Date: Thu, 2 Dec 2021 22:07:58 +0100 Subject: [PATCH] Ditch floating point numbers, use cents instead; bump version to 3.2 --- README.md | 85 ++++--------------- UPGRADING.md | 77 +++++++++++++++++ lib/RevBank/Amount.pm | 126 +++++++++++++++++++++++++++ lib/RevBank/Amount.pod | 104 +++++++++++++++++++++++ lib/RevBank/Cart.pm | 1 + lib/RevBank/Cart/Entry.pm | 28 +++--- lib/RevBank/Global.pm | 11 +-- lib/RevBank/Messages.pm | 12 +-- lib/RevBank/Users.pm | 7 +- plugins/give | 6 +- plugins/log | 4 +- plugins/pfand | 3 +- plugins/repeat | 2 +- plugins/split | 12 +-- plugins/take | 7 +- revbank | 55 +----------- t/amount.t | 173 ++++++++++++++++++++++++++++++++++++++ 17 files changed, 545 insertions(+), 168 deletions(-) create mode 100644 UPGRADING.md create mode 100644 lib/RevBank/Amount.pm create mode 100644 lib/RevBank/Amount.pod create mode 100644 t/amount.t diff --git a/README.md b/README.md index 35d2ecd..3538449 100644 --- a/README.md +++ b/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. diff --git a/UPGRADING.md b/UPGRADING.md new file mode 100644 index 0000000..2971c5e --- /dev/null +++ b/UPGRADING.md @@ -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. diff --git a/lib/RevBank/Amount.pm b/lib/RevBank/Amount.pm new file mode 100644 index 0000000..f27c5a9 --- /dev/null +++ b/lib/RevBank/Amount.pm @@ -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; diff --git a/lib/RevBank/Amount.pod b/lib/RevBank/Amount.pod new file mode 100644 index 0000000..464ba14 --- /dev/null +++ b/lib/RevBank/Amount.pod @@ -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, 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) +>>. diff --git a/lib/RevBank/Cart.pm b/lib/RevBank/Cart.pm index 6393c78..d965d5f 100644 --- a/lib/RevBank/Cart.pm +++ b/lib/RevBank/Cart.pm @@ -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; } diff --git a/lib/RevBank/Cart/Entry.pm b/lib/RevBank/Cart/Entry.pm index 5ed1fe7..3660227 100644 --- a/lib/RevBank/Cart/Entry.pm +++ b/lib/RevBank/Cart/Entry.pm @@ -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") ); } diff --git a/lib/RevBank/Global.pm b/lib/RevBank/Global.pm index 776a518..6fcbead 100644 --- a/lib/RevBank/Global.pm +++ b/lib/RevBank/Global.pm @@ -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 { diff --git a/lib/RevBank/Messages.pm b/lib/RevBank/Messages.pm index 2b990fa..2949167 100644 --- a/lib/RevBank/Messages.pm +++ b/lib/RevBank/Messages.pm @@ -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 { diff --git a/lib/RevBank/Users.pm b/lib/RevBank/Users.pm index f393f2c..053a7d9 100644 --- a/lib/RevBank/Users.pm +++ b/lib/RevBank/Users.pm @@ -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 { diff --git a/plugins/give b/plugins/give index abf616d..f63d30d 100644 --- a/plugins/give +++ b/plugins/give @@ -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) { diff --git a/plugins/log b/plugins/log index d262393..a576dee 100644 --- a/plugins/log +++ b/plugins/log @@ -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"); } diff --git a/plugins/pfand b/plugins/pfand index 0aacfad..bdd9303 100644 --- a/plugins/pfand +++ b/plugins/pfand @@ -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 }); diff --git a/plugins/repeat b/plugins/repeat index f83e0dd..b3c806f 100644 --- a/plugins/repeat +++ b/plugins/repeat @@ -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); } diff --git a/plugins/split b/plugins/split index a1f7fee..dbb2e84 100644 --- a/plugins/split +++ b/plugins/split @@ -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; } diff --git a/plugins/take b/plugins/take index e750c87..70dad93 100644 --- a/plugins/take +++ b/plugins/take @@ -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); diff --git a/revbank b/revbank index f25400a..5a2fe73 100755 --- a/revbank +++ b/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 and C - -Please remove these from your C configuration file. - -=item * creating new accounts with C - -Use C 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 and C - -Use C and C instead, which gets a RevBank::Cart::Entry -object, instead. - -Note that the new "entries", unlike old "items", can have a C other -than 1. - -=head2 Method C<< $cart->add(undef, ...) >> - -=head2 Method C<< $cart->add($user, ...) >> - -The C 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. The contras can be used for counteracting a value -with an operation on another account. - -To upgrade a plugin that does a single C with C as the first -argument, simply remove the C. When multiple items were added that -belong together, consider using C for the subsequent lines; see the -C and C 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 and -C methods, instead of directly manipulating the hash. - =head1 DESCRIPTION Maybe I'll write some documentation, but not now. diff --git a/t/amount.t b/t/amount.t new file mode 100644 index 0000000..95d15c1 --- /dev/null +++ b/t/amount.t @@ -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();