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.
This commit is contained in:
Juerd Waalboer 2022-06-12 21:49:22 +02:00
parent 507d368947
commit 65566349f6
4 changed files with 55 additions and 25 deletions

View file

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

View file

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

View file

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

View file

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