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.
52 lines
1.5 KiB
Perl
52 lines
1.5 KiB
Perl
#!perl
|
|
|
|
use List::Util ();
|
|
|
|
HELP "split <account>..." => "Split the bill with others";
|
|
|
|
sub _select_split($cart) {
|
|
grep $_->{amount} < 0, $cart->entries
|
|
}
|
|
|
|
sub command :Tab(take,steal,split) ($self, $cart, $command, @) {
|
|
$command eq 'split' or return NEXT;
|
|
|
|
$self->{users} = [];
|
|
|
|
my $sum = List::Util::sum(map -$_->{amount}, _select_split($cart));
|
|
$self->{split_amount} = $sum;
|
|
|
|
return REJECT, "Nothing to split. Add products first." if not $sum;
|
|
|
|
print "Splitting $sum over \$you and others.\n";
|
|
return "User to take from (not yourself)", \&arg;
|
|
}
|
|
|
|
sub arg :Tab(USERS) ($self, $cart, $arg, @) {
|
|
my $users = $self->{users};
|
|
|
|
if (@$users and $arg eq $self->{split_finish}) {
|
|
my $amount = $self->{split_amount};
|
|
my $each = RevBank::Amount->new_from_float($amount->float / (@$users + 1));
|
|
my $total = @$users * $each;
|
|
my $desc = join " + ", map $_->{description}, _select_split($cart);
|
|
|
|
my $joined = join '/', @$users;
|
|
my $entry = $cart->add($total, "Taken from $joined (Split: $desc)" );
|
|
|
|
for my $user (@$users) {
|
|
$entry->add_contra( $user, -$each, "Taken by \$you (Split: $desc)" );
|
|
}
|
|
|
|
return ACCEPT;
|
|
}
|
|
|
|
my $user = parse_user($arg) or return REJECT, "$arg: No such user.";
|
|
push @$users, $user;
|
|
|
|
my $each = RevBank::Amount->new_from_float($self->{split_amount}->float / (@$users + 1));
|
|
$self->{split_finish} = $each->string;
|
|
|
|
return "User to take from (not yourself) or $self->{split_finish} to finish", \&arg;
|
|
}
|
|
|