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

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;

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<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)
+>>.

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

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

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 {

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 {

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 {