bitlair/revbank
6
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Ditch floating point numbers, use cents instead; bump version to 3.2

Browse source
This commit is contained in:
Juerd Waalboer 2021-12-02 22:07:58 +01:00
parent 9b582d5f9b
commit 38a0229899
17 changed files with 545 additions and 168 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

85
README.md
View file

@ -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
View 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
View 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
View 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)
>>.

1
lib/RevBank/Cart.pm
View file

@ -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;
}

28
lib/RevBank/Cart/Entry.pm
View file

@ -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")
);
}

11
lib/RevBank/Global.pm
View file

@ -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 {

12
lib/RevBank/Messages.pm
View file

@ -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 {

7
lib/RevBank/Users.pm
View file

@ -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 {

6
plugins/give
View file

@ -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) {

4
plugins/log
View file

@ -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");
}

3
plugins/pfand
View file

@ -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 });

2
plugins/repeat
View file

@ -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);
}

12
plugins/split
View file

@ -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;
}

7
plugins/take
View file

@ -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
View file

@ -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
View 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();