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:
parent
507d368947
commit
65566349f6
4 changed files with 55 additions and 25 deletions
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
|
27
plugins/log
27
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);
|
||||
}
|
||||
|
|
|
@ -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 {
|
||||
|
|
Loading…
Add table
Reference in a new issue