From 65566349f686a638c1d9185d267b2348935507fe Mon Sep 17 00:00:00 2001 From: Juerd Waalboer Date: Sun, 12 Jun 2022 21:49:22 +0200 Subject: [PATCH] Prepare for future removal of support for unbalanced transactions Don't worry, that won't happen for at least months. First we'll just log warnings for a while. --- lib/RevBank/Cart.pm | 2 ++ lib/RevBank/Cart/Entry.pm | 49 ++++++++++++++++++++++++++------------- plugins/log | 27 ++++++++++++++------- plugins/undo | 2 +- 4 files changed, 55 insertions(+), 25 deletions(-) diff --git a/lib/RevBank/Cart.pm b/lib/RevBank/Cart.pm index 1bbf4a6..c38dc05 100644 --- a/lib/RevBank/Cart.pm +++ b/lib/RevBank/Cart.pm @@ -72,6 +72,8 @@ sub checkout($self, $user) { my %deltas; for my $entry (@$entries) { + $entry->sanity_check; + $entry->user($user); $deltas{$entry->{user}} //= RevBank::Amount->new(0); diff --git a/lib/RevBank/Cart/Entry.pm b/lib/RevBank/Cart/Entry.pm index 850bf67..dfa73ed 100644 --- a/lib/RevBank/Cart/Entry.pm +++ b/lib/RevBank/Cart/Entry.pm @@ -19,7 +19,8 @@ sub new($class, $amount, $description, $attributes = {}) { attributes => { %$attributes }, user => undef, contras => [], - caller => (caller 1)[3], + caller => List::Util::first(sub { !/^RevBank::Cart/ }, map { (caller $_)[3] } 1..10) + || (caller 1)[3], }; return bless $self, $class; @@ -76,8 +77,6 @@ sub contras($self) { } sub as_printable($self) { - $self->sanity_check; - my @s; push @s, $self->{quantity} . "x {" if $self->multiplied; @@ -105,7 +104,6 @@ sub as_printable($self) { sub as_loggable($self) { croak "Loggable called before set_user" if not defined $self->{user}; - $self->sanity_check; my $quantity = $self->{quantity}; @@ -143,28 +141,47 @@ sub user($self, $new = undef) { } sub sanity_check($self) { - # Turnover and journals are implicit contras, so (for now) a zero sum is - # not required. However, in a transaction with contras, one should at least - # not try to issue money that does not exist. + # Turnover and journals were implicit contras in previous versions of + # revbank, but old plugins may need upgrading to the new dual-entry system, + # so (for now) a zero sum is not required. - return 1 if $self->{FORCE}; - my @contras = $self->contras or return 1; + my @contras = $self->contras; - my $sum = List::Util::sum(map $_->{amount}->cents, $self, @contras); + my $sum = RevBank::Amount->new( + List::Util::sum(map $_->{amount}->cents, $self, @contras) + ); - if ($sum > 0) { - $self->{FORCE} = 1; - croak join("\n", + # Although unbalanced transactiens are still allowed, a transaction with + # contras should at least not try to issue money that does not exist. + if ($sum > 0 and @contras and not $self->{FORCE_UNBALANCED}) { + local $ENV{REVBANK_DEBUG} = 1; + my $message = join("\n", "BUG! (probably in $self->{caller})", "This adds up to creating money that does not exist:", $self->as_printable, ( - $sum == 2 * $self->{amount}->cents - ? "Hint: contras for positive value should be negative values." + $sum == 2 * $self->{amount} + ? "Hint for the developer: contras for positive value should be negative values and vice versa." : () ), - sprintf("Cowardly refusing to create $sum out of thin air") + "Cowardly refusing to create $sum out of thin air" ); + RevBank::Plugins::call_hooks("log_error", "UNBALANCED ENTRY $message"); + croak $message; + } + + if ($sum != 0) { + local $ENV{REVBANK_DEBUG} = 1; + my $forced = $self->{FORCE_UNBALANCED} ? " (FORCED)" : ""; + RevBank::Plugins::call_hooks( + "log_warning", + "UNBALANCED ENTRY$forced in $self->{caller}: " . ( + @contras + ? "sum of entry with contras ($sum) != 0.00" + : "transaction has no contras" + ) . ". This will probably be a fatal error in a future version of revbank.\n" + . "The unbalanced entry is:\n" . join("\n", $self->as_printable) + ) } return 1; diff --git a/plugins/log b/plugins/log index 52dda26..070d2ad 100644 --- a/plugins/log +++ b/plugins/log @@ -2,9 +2,11 @@ my $filename = ".revbank.log"; -sub _log { +sub _log($tag, @message) { + @message = ("") if not @message; + open my $fh, '>>', $filename or warn "$filename: $!"; - print $fh now(), " ", @_, "\n"; + print $fh map(s/^/now() . " $tag "/rgme, @message), "\n"; close $fh or warn "$filename: $!"; } @@ -18,28 +20,37 @@ sub hook_prompt($class, $cart, $prompt, @) { sub hook_input($class, $cart, $input, $split_input, @) { $input //= "(UNDEF)"; - _log("PROMPT $buffer{prompt} >> $input"); + $input = "(EMPTY)" if not length $input; + _log(PROMPT => "$buffer{prompt} >> $input"); } sub hook_reject($class, $plugin, $reason, $abort, @) { - _log("REJECT [$plugin] $reason"); + _log(REJECT => "[$plugin] $reason"); } sub hook_retry($class, $plugin, $reason, $abort, @) { - _log("RETRY [$plugin] $reason"); + _log(RETRY => "[$plugin] $reason"); } sub hook_user_created($class, $username, @) { - _log("NEWUSER $username"); + _log(NEWUSER => "$username"); } sub hook_user_balance($class, $user, $old, $delta, $new, $transaction_id, @) { my $lost = $delta < 0 ? "lost" : "got"; $delta = $delta->abs; $_ = $_->string("+") for $old, $new; - _log("BALANCE $transaction_id $user had $old, $lost $delta, now has $new"); + _log(BALANCE => "$transaction_id $user had $old, $lost $delta, now has $new"); } sub hook_checkout($class, $cart, $username, $transaction_id, @) { - _log("CHECKOUT $transaction_id $_") for map $_->as_loggable, $cart->entries; + _log(CHECKOUT => "$transaction_id $_") for map $_->as_loggable, $cart->entries; +} + +sub hook_log_warning($class, $message, @) { + _log(WARNING => $message); +} + +sub hook_log_error($class, $message, @) { + _log(ERROR => $message); } diff --git a/plugins/undo b/plugins/undo index 89bb9d5..6c44b71 100644 --- a/plugins/undo +++ b/plugins/undo @@ -52,7 +52,7 @@ sub undo :Tab(&tab) ($self, $cart, $tid, @) { my (undef, $user, $delta) = split " ", $line; $entry ||= $cart->add(0, $description); - $entry->{FORCE} = 1; + $entry->{FORCE_UNBALANCED} = 1; $entry->add_contra($user, $delta, "Undo $tid"); } else {