d4c6c1be35
add_info was a thing that grew organically to account for hidden contras, but just wasn't right. The assumption was that if the contra account is hidden, the contra itself should be hidden from view - the sign of the amount would be wrong anyway. The correct approach, however, would of course to flip the sign so it matches the user's perspective, and to add a separate description string to display to the user.
138 lines
3.6 KiB
Perl
138 lines
3.6 KiB
Perl
#!perl
|
|
|
|
HELP1 "<productID>" => "Add a product to pending transaction";
|
|
|
|
my $filename = 'revbank.products';
|
|
my $default_contra = '+sales/products';
|
|
|
|
sub _read_products() {
|
|
my %products;
|
|
my $line = 0;
|
|
for (slurp $filename) {
|
|
$line++;
|
|
|
|
s/^\s+|\s+$//g; # trim
|
|
next if /^#/;
|
|
next if not length;
|
|
|
|
my ($ids, $p, $desc) = split " ", $_, 3;
|
|
my @ids = split /,/, $ids;
|
|
|
|
$p ||= "invalid";
|
|
$desc ||= "(no description)";
|
|
|
|
my ($price, $contra) = split /\@/, $p, 2;
|
|
|
|
my $sign = $price =~ s/^-// ? -1 : 1;
|
|
my $percent = $price =~ s/%$//;
|
|
|
|
if ($percent) {
|
|
if (grep !/^\+/, @ids) {
|
|
warn "Percentage invalid for non-addon at $filename line $line.\n";
|
|
next;
|
|
}
|
|
$price = 0 + $price;
|
|
} else {
|
|
$price = eval { parse_amount($price) };
|
|
if (not defined $price) {
|
|
warn "Invalid price for '$ids[0]' at $filename line $line.\n";
|
|
next;
|
|
}
|
|
}
|
|
|
|
my @addons;
|
|
unshift @addons, $1 while $desc =~ s/\s+ \+ (\S+)$//x;
|
|
|
|
$products{$_} = {
|
|
id => $ids[0],
|
|
price => $sign * $price,
|
|
percent => $percent,
|
|
description => $desc,
|
|
contra => $contra || $default_contra,
|
|
addons => \@addons,
|
|
line => $line,
|
|
} for @ids;
|
|
}
|
|
|
|
return \%products;
|
|
}
|
|
|
|
sub command :Tab(&tab) ($self, $cart, $command, @) {
|
|
$command =~ /\S/ or return NEXT;
|
|
$command =~ /^\+/ and return NEXT;
|
|
|
|
my $products = _read_products;
|
|
my $product = $products->{ $command } or return NEXT;
|
|
my $price = $product->{price};
|
|
|
|
my @existing = grep {
|
|
$_->attribute('plugin') eq $self->id and
|
|
$_->attribute('product_id') eq $product->{id}
|
|
} $cart->entries('plugin');
|
|
|
|
if (@existing) {
|
|
$existing[0]->quantity($existing[0]->quantity + 1);
|
|
return ACCEPT;
|
|
}
|
|
|
|
my $contra_desc = "\$you bought $product->{description}";
|
|
|
|
my @addons = @{ $product->{addons} };
|
|
|
|
my $display = undef;
|
|
$display = "Product" if @addons and $price->cents > 0;
|
|
$display = "Reimbursement" if @addons and $price->cents < 0;
|
|
|
|
my $entry = $cart->add(
|
|
-$price,
|
|
$product->{description},
|
|
{ product_id => $product->{id}, plugin => $self->id, addons => $product->{addons} }
|
|
);
|
|
$entry->add_contra(
|
|
$product->{contra},
|
|
+$price,
|
|
$contra_desc,
|
|
$display
|
|
);
|
|
|
|
my %ids_seen = ($product->{id} => 1);
|
|
|
|
while (my $addon_id = shift @addons) {
|
|
$addon_id = "+$addon_id" if exists $products->{"+$addon_id"};
|
|
|
|
if ($ids_seen{$addon_id}++) {
|
|
return REJECT, "Infinite addons are not supported.";
|
|
}
|
|
|
|
my $addon = $products->{$addon_id}
|
|
or return REJECT, "Addon '$addon_id' does not exist.";
|
|
|
|
my $addon_price = $addon->{price};
|
|
if ($addon->{percent}) {
|
|
my $sum = List::Util::sum map {
|
|
$_->{amount}
|
|
} grep {
|
|
$_->{user} eq $addon->{contra}
|
|
} $entry->contras;
|
|
|
|
$addon_price = $addon_price / 100 * $sum;
|
|
}
|
|
|
|
$entry->amount( $entry->amount - $addon_price );
|
|
|
|
$entry->add_contra(
|
|
$addon->{contra},
|
|
$addon_price,
|
|
"$addon->{description} ($contra_desc)",
|
|
$addon->{description}
|
|
);
|
|
|
|
push @addons, @{ $addon->{addons} };
|
|
}
|
|
|
|
return ACCEPT;
|
|
}
|
|
|
|
sub tab {
|
|
return grep /\D/, keys %{ _read_products() };
|
|
}
|