6b04ecc256
The ancient decision to let undo perform the checkout by itself still makes sense from a UX perspective, but keeps requiring specific handling of edge cases. In this case, the easiest way to deal with trailing input is to just abort entirely. Also: updated lib/RevBank/Plugins.pm to import 'isa' and get up to 5.32 level.
117 lines
3.3 KiB
Perl
117 lines
3.3 KiB
Perl
#!perl
|
|
|
|
HELP1 "undo <transactionID>" => "Undo a transaction";
|
|
|
|
my $filename = ".revbank.undo";
|
|
|
|
my @TAB;
|
|
|
|
{
|
|
package RevBank::Plugin::undo::RollBackUndo;
|
|
sub new($class) { return bless [], $class; }
|
|
}
|
|
|
|
sub command :Tab(undo) ($self, $cart, $command, @) {
|
|
$command eq 'undo' or return NEXT;
|
|
|
|
$cart->size and return REJECT, "Undo is not available mid-transaction.";
|
|
|
|
my @log;
|
|
for my $line (slurp $filename) {
|
|
my ($tid, $user, $delta, $dt) = split " ", $line;
|
|
if (@log and $log[-1]{tid} eq $tid) {
|
|
push @{ $log[-1]{deltas} }, [ $user, $delta ];
|
|
} else {
|
|
push @log, { tid => $tid, dt => $dt, deltas => [ [ $user, $delta ] ] };
|
|
}
|
|
}
|
|
|
|
@TAB = ();
|
|
|
|
my $menu = "";
|
|
my $max = @log < 15 ? @log : 15;
|
|
for my $txn (@log[-$max .. -1]) {
|
|
$menu .= "ID: $txn->{tid} $txn->{dt} " . join(", ",
|
|
map { sprintf "%s:%+.2f", @$_ } @{ $txn->{deltas} }
|
|
) . "\n";
|
|
|
|
push @TAB, $txn->{tid};
|
|
}
|
|
|
|
return $menu . "Transaction ID", \&undo;
|
|
}
|
|
|
|
sub tab { @TAB }
|
|
|
|
my $doing_undo = 0; # Ugly but works, just like the rest of this plugin
|
|
|
|
sub undo :Tab(&tab) ($self, $cart, $tid, @) {
|
|
my $description = "Undo $tid";
|
|
my $entry;
|
|
my $found = 0;
|
|
my $aborted = 0;
|
|
|
|
with_lock {
|
|
my $backup = "$filename.bak.$$";
|
|
spurt $backup, slurp $filename; # copy for rollback
|
|
|
|
# Immediately remove from file, to avoid double undo when something
|
|
# crashes.
|
|
rewrite $filename, sub($line) {
|
|
if ($line =~ /^\Q$tid\E\s/) {
|
|
my (undef, $user, $delta) = split " ", $line;
|
|
|
|
$entry ||= $cart->add(0, $description, { undo_transaction_id => $tid });
|
|
$entry->{FORCE_UNBALANCED} = 1;
|
|
|
|
$entry->add_contra($user, $delta, "Undo $tid");
|
|
return undef; # remove line
|
|
} else {
|
|
return $line;
|
|
}
|
|
};
|
|
|
|
if ($cart->size) {
|
|
$found = 1;
|
|
$doing_undo = 1; # don't allow undoing undos
|
|
|
|
eval { $cart->checkout('-undo') };
|
|
|
|
if ($@ isa RevBank::Plugin::undo::RollbackUndo) {
|
|
# Undo the undo... :)
|
|
spurt $filename, slurp $backup;
|
|
|
|
# can't 'return ABORT' here; it would return from with_lock
|
|
$aborted = 1;
|
|
} elsif ($@ isa RevBank::Cart::CheckoutProhibited) {
|
|
my $reason = $@->reason;
|
|
|
|
# Undo the undo... :)
|
|
spurt $filename, slurp $backup;
|
|
|
|
$aborted = 1;
|
|
warn "$reason\n";
|
|
} elsif ($@ and ref $@) {
|
|
# Re-throw exception object
|
|
die $@;
|
|
} elsif ($@) {
|
|
# Re-throw exception string
|
|
die "(undo file BACKUP at $backup.)\n$@";
|
|
} else {
|
|
unlink $backup;
|
|
}
|
|
|
|
$doing_undo = 0;
|
|
}
|
|
};
|
|
|
|
return ABORT, "Undo prohibited." if $aborted;
|
|
return ACCEPT if $found;
|
|
return ABORT, "Transaction ID '$tid' not found in undo log.";
|
|
}
|
|
|
|
sub hook_user_balance($class, $username, $old, $delta, $new, $transaction_id, @) {
|
|
return if $doing_undo; # don't allow undoing undos
|
|
|
|
append $filename, join(" ", $transaction_id, $username, -$delta, now()), "\n";
|
|
}
|