eed0db7897
The signatures feature has been "experimental" since Perl 5.20 (May 2014), but expected to stay. After 8 years I'm ready to take the risk :) Have added Perl v5.28 (June 2018) as the minimum requirement, even though the current revbank should work with 5.20, to see if this bothers any users. Perl v5.28 is in Debian "buster", which is now oldstable.
50 lines
1.4 KiB
Perl
50 lines
1.4 KiB
Perl
#!perl
|
|
|
|
HELP "undo <transactionID>" => "Undo a transaction";
|
|
|
|
my $filename = ".revbank.undo";
|
|
|
|
sub command :Tab(undo) ($self, $cart, $command, @) {
|
|
$command eq 'undo' or return NEXT;
|
|
|
|
$cart->size and return ABORT, "Undo is not available mid-transaction.";
|
|
|
|
return "Transaction ID", \&undo;
|
|
}
|
|
|
|
sub undo($self, $cart, $tid, @) {
|
|
open my $in, '<', $filename or die "$filename: $!";
|
|
open my $out, '>', "$filename.$$" or die "$filename.$$: $!";
|
|
my $description = "Undo $tid";
|
|
|
|
my $entry;
|
|
|
|
while (defined(my $line = readline $in)) {
|
|
if ($line =~ /^\Q$tid\E\s/) {
|
|
my (undef, $user, $delta) = split " ", $line;
|
|
|
|
$entry ||= $cart->add(0, $description);
|
|
$entry->{FORCE} = 1;
|
|
|
|
$entry->add_contra($user, $delta, "Undo $tid");
|
|
} else {
|
|
print {$out} $line;
|
|
}
|
|
}
|
|
close $in;
|
|
close $out or die $!;
|
|
if ($cart->size) {
|
|
rename "$filename.$$", $filename or die $!;
|
|
$cart->checkout('**UNDO**');
|
|
} else {
|
|
return ABORT, "Transaction ID '$tid' not found in undo log.";
|
|
}
|
|
|
|
return ACCEPT;
|
|
}
|
|
|
|
sub hook_user_balance($class, $username, $old, $delta, $new, $transaction_id, @) {
|
|
open my $fh, '>>', $filename or die "$filename: $!";
|
|
print {$fh} join " ", $transaction_id, $username, -$delta, now(), "\n";
|
|
close $fh or die "$filename: $!";
|
|
}
|