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

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

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
+    # Turnover and journals were implicit contras in previous versions of
-    # not required. However, in a transaction with contras, one should at least
+    # revbank, but old plugins may need upgrading to the new dual-entry system,
-    # not try to issue money that does not exist.
+    # so (for now) a zero sum is not required.
 
-    return 1 if $self->{FORCE};
+    my @contras = $self->contras;
-    my @contras = $self->contras or return 1;
 
-    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) {
+    # Although unbalanced transactiens are still allowed, a transaction with
-        $self->{FORCE} = 1;
+    # contras should at least not try to issue money that does not exist.
-        croak join("\n",
+    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
+                $sum == 2 * $self->{amount}
-                ? "Hint: contras for positive value should be negative values."
+                ? "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;

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

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 {