From ef0039bc335e4e8c82e4f4be2b4af84cc067a052 Mon Sep 17 00:00:00 2001 From: Juerd Waalboer Date: Wed, 28 Aug 2024 05:08:20 +0200 Subject: [PATCH] Handle huge numbers better A sufficiently big number, i.e. longer than a long long, had interesting effects. Perl would promote it to a float, and format it as -1 in sprintf, which RevBank::Amount didn't handle correctly. In extreme cases the number got rounded to Inf and would no longer round-trip. As a result, numbers returned by RevBank::Amount are now Math::BigInt and Math::BigFloat objects. Those should be transparent to all existing code. It's amazing to see the unit tests pass. I don't think there is any actual use case in RevBank for numbers this large and I don't think anyone will have actually encountered the aforementioned weird effects. Mostly, the input would be parsed with parse_amount which refuses any number greater than 99900 anyway. Only where parse_string was used directly, such large numbers could actually have been used, but in stock RevBank that is only done when reading the accounts file. This change also introduces a new global function parse_any_amount that is like parse_amount but doesn't complain about negative or large numbers, to further improve the adduser plugin (see previous commit) in insane edge cases. It differs from RevBank::Amount->parse_string in that it does support addition and subtraction operators. --- lib/RevBank/Amount.pm | 29 +++++++++++-------------- lib/RevBank/Global.pm | 50 +++++++++++++++++++++++++------------------ plugins/adduser | 5 +++-- revbank | 2 +- t/amount.t | 8 +++++++ 5 files changed, 54 insertions(+), 40 deletions(-) diff --git a/lib/RevBank/Amount.pm b/lib/RevBank/Amount.pm index 98c97df..5f3f351 100644 --- a/lib/RevBank/Amount.pm +++ b/lib/RevBank/Amount.pm @@ -8,6 +8,7 @@ use experimental 'signatures'; # stable since v5.36 use Carp qw(carp croak); use Scalar::Util; use POSIX qw(lround); +use Math::BigInt; our $C = __PACKAGE__; @@ -41,12 +42,12 @@ use overload ( }, "*" => sub ($a, $b, $swap) { $b = $b->_float_warn if ref $b; - $C->new($$a * $b); + $C->new($$a->as_float * ($b->can('float') ? $b->float : $b->can('as_float') ? $b->as_float : $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); + $C->new($$a->as_float / $b); }, "<=>" => sub ($a, $b, $swap) { _coerce($a, $b); @@ -59,19 +60,15 @@ use overload ( ); sub new($class, $cents) { - my $int = int sprintf "%d", $cents; - #carp "$cents rounded to $int cents" if $int != $cents; + my $int = Math::BigInt->new($cents->can("as_int") ? $cents->as_int : $cents); + croak "Non-integer not supported" if $int->is_nan; + croak "Infinite number not supported" if $int->is_inf; + 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. + return $class->new((100 * Math::BigFloat->new($num))->bfround(0)->as_int); } sub parse_string($class, $str) { @@ -88,7 +85,7 @@ sub parse_string($class, $str) { $cents *= 10 if length($cents) == 1; # 4.2 -> 4.20 return $class->new( - ($neg ? -1 : 1) * ($int * 100 + $cents) + ($neg ? -1 : 1) * (100 * Math::BigInt->new($int) + $cents) ); } @@ -97,7 +94,7 @@ sub cents($self) { } sub float($self) { - return $$self / 100; + return $$self->as_float / 100; } sub _float_warn($self) { @@ -107,9 +104,9 @@ sub _float_warn($self) { sub string($self, $plus = "") { return sprintf( - "%s%d.%02d", + "%s%s.%02d", $$self < 0 ? "-" : $plus, - abs($$self) / 100, + abs($$self) / 100, # %s for bigint abs($$self) % 100, ); } @@ -119,7 +116,7 @@ sub string_flipped($self, $sep = " ") { "%s%s%d.%02d", $$self > 0 ? "+" : "", $$self > 0 ? $sep : "", - abs($$self) / 100, + abs($$self) / 100, # %s for bigint abs($$self) % 100, ); } diff --git a/lib/RevBank/Global.pm b/lib/RevBank/Global.pm index c5240e6..a55a5d2 100644 --- a/lib/RevBank/Global.pm +++ b/lib/RevBank/Global.pm @@ -14,6 +14,32 @@ use RevBank::FileIO; sub reason($self) { return $$self; } } +sub _parse_any_amount($amount) { + defined $amount or return undef; + length $amount or return undef; + + my @split = grep /\S/, split /([+-])/, $amount; + + my $posneg = 1; + $amount = RevBank::Amount->new(0); + for my $token (@split) { + if ($token eq '-') { + $posneg = $posneg == -1 ? 1 : -1; + } elsif ($token eq '+') { + $posneg ||= 1; + } else { + $posneg or return undef; # two terms in a row + my $term = RevBank::Amount->parse_string($token) // return undef; + $amount += $posneg * $term; + $posneg = 0; + } + } + $posneg and return undef; # last token must be term + + return $amount; + +} + sub import { require RevBank::Plugins; require RevBank::Users; @@ -31,27 +57,9 @@ sub import { *{"$caller\::append"} = \&RevBank::FileIO::append; *{"$caller\::with_lock"} = \&RevBank::FileIO::with_lock; *{"$caller\::parse_user"} = \&RevBank::Users::parse_user; - *{"$caller\::parse_amount"} = sub ($amount) { - defined $amount or return undef; - length $amount or return undef; - - my @split = grep /\S/, split /([+-])/, $amount; - - my $posneg = 1; - $amount = RevBank::Amount->new(0); - for my $token (@split) { - if ($token eq '-') { - $posneg = $posneg == -1 ? 1 : -1; - } elsif ($token eq '+') { - $posneg ||= 1; - } else { - $posneg or return undef; # two terms in a row - my $term = RevBank::Amount->parse_string($token) // return undef; - $amount += $posneg * $term; - $posneg = 0; - } - } - $posneg and return undef; # last token must be term + *{"$caller\::parse_any_amount"} = \&_parse_any_amount; + *{"$caller\::parse_amount" } = sub ($amount) { + $amount = _parse_any_amount($amount) // return undef; if ($amount->cents < 0) { die RevBank::Exception::RejectInput->new( diff --git a/plugins/adduser b/plugins/adduser index 3c9f83d..a6e9353 100644 --- a/plugins/adduser +++ b/plugins/adduser @@ -21,8 +21,9 @@ sub username($self, $cart, $name, @) { return REJECT, "Sorry, - + / ^ * are not allowed as the first character." if $name =~ /^[-+*\/\^]/; - return REJECT, "Sorry, that's too numeric to be a user name." - if defined RevBank::Amount->parse_string($name); + my $num; + return REJECT, "Sorry, that evaluates to the amount $num and can't be an account name." + if defined($num = parse_any_amount($name)); return REJECT, "That name is not available." if defined parse_user($name, 1); diff --git a/revbank b/revbank index df9b933..d5ae6f7 100755 --- a/revbank +++ b/revbank @@ -17,7 +17,7 @@ use RevBank::Messages; use RevBank::Cart; use RevBank::Prompt; -our $VERSION = "6.2.1"; +our $VERSION = "6.2.2"; our %HELP1 = ( "abort" => "Abort the current transaction", ); diff --git a/t/amount.t b/t/amount.t index 9318e8e..d1024cf 100644 --- a/t/amount.t +++ b/t/amount.t @@ -40,6 +40,12 @@ cmp_ok(RevBank::Amount->parse_string("4 ")->cents, '==', 400); cmp_ok(RevBank::Amount->new_from_float(.425)->cents, '==', 42); + +my $big = "9" x 123; +cmp_ok(RevBank::Amount->new($big)->cents, 'eq', $big); +cmp_ok(RevBank::Amount->parse_string($big)->cents, 'eq', $big . "00"); +cmp_ok(RevBank::Amount->new_from_float($big)->cents, 'eq', $big . "00"); + # comparisons ok($a); ok(!RevBank::Amount->new(0)); @@ -136,6 +142,8 @@ like(warning { rand $a }, qr/float/); # Invalid amounts +throws_ok(sub { RevBank::Amount->new(1.1) }, qr/Non-integer/); +throws_ok(sub { RevBank::Amount->new("+Inf") }, qr/Infinite/); is(RevBank::Amount->parse_string("0.000"), undef); is(RevBank::Amount->parse_string("0.042"), undef); is(RevBank::Amount->parse_string("+0.042"), undef);