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.
64 lines
1.7 KiB
Perl
64 lines
1.7 KiB
Perl
#!perl
|
|
|
|
HELP "take <account>... <amount> <reason>" => "Transfer money from them to you";
|
|
|
|
sub command :Tab(take,steal) ($self, $cart, $command, @) {
|
|
$command eq 'take' or $command eq 'steal'
|
|
or return NEXT;
|
|
|
|
$self->{users} = [];
|
|
|
|
return "User to take from", \&arg;
|
|
}
|
|
|
|
sub arg :Tab(USERS) ($self, $cart, $arg, @) {
|
|
my @users = @{ $self->{users} };
|
|
my $amount = parse_amount($arg);
|
|
|
|
if (@users and $amount) {
|
|
my $each = RevBank::Amount->new_from_float($amount->float / @users);
|
|
my $total = $each * @users;
|
|
|
|
if ($total != $amount) {
|
|
print "Adjusted total amount to $total because of rounding.\n";
|
|
}
|
|
|
|
$self->{each} = $each;
|
|
$self->{total} = $total;
|
|
|
|
my $them = @users == 1 ? $users[0] : 'each';
|
|
|
|
return "Why are you taking $each from $them", \&reason;
|
|
}
|
|
|
|
my $user = parse_user($arg);
|
|
if ($user) {
|
|
push @{ $self->{users} }, $user;
|
|
} else {
|
|
return REJECT, "$arg: No such user" .
|
|
($amount ? "." : ", and not a valid amount.");
|
|
}
|
|
|
|
return "User to take from, or total amount to finish", \&arg;
|
|
}
|
|
|
|
# finish
|
|
sub reason :Tab(bbq,NOABORT) ($self, $cart, $reason, @) {
|
|
return REJECT, "'$reason' is a username, not a description :)."
|
|
if parse_user($reason);
|
|
return REJECT, "'$reason' is an amount, not a description :)."
|
|
if parse_amount($reason);
|
|
|
|
my @users = @{ $self->{users} };
|
|
my $each = $self->{each};
|
|
my $total = $self->{total};
|
|
|
|
my $users = join '/', @users;
|
|
my $entry = $cart->add($total, "Taken from $users ($reason)", { is_take => 1 });
|
|
for my $user (@users) {
|
|
$entry->add_contra( $user, -$each, "Taken by \$you ($reason)" );
|
|
}
|
|
|
|
return ACCEPT;
|
|
}
|
|
|