155 lines
4.1 KiB
Perl
155 lines
4.1 KiB
Perl
#!perl
|
|
|
|
HELP1 "<productID>" => "Add a product to pending transaction";
|
|
|
|
my $filename = 'revbank.products';
|
|
my $default_contra = '+sales/products';
|
|
|
|
sub read_products() {
|
|
state %products;
|
|
state $mtime;
|
|
|
|
return \%products if $mtime and $mtime == -M $filename;
|
|
$mtime = -M $filename;
|
|
|
|
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 @addon_ids;
|
|
unshift @addon_ids, $1 while $desc =~ s/\s+ \+ (\S+)$//x;
|
|
|
|
$products{$_} = {
|
|
id => $ids[0],
|
|
price => $sign * $price,
|
|
percent => $percent,
|
|
description => $desc,
|
|
contra => $contra || $default_contra,
|
|
_addon_ids => \@addon_ids,
|
|
line => $line,
|
|
} for @ids;
|
|
}
|
|
|
|
PRODUCT: for my $product (values %products) {
|
|
my %ids_seen = ($product->{id} => 1);
|
|
my @addon_ids = @{ $product->{_addon_ids} };
|
|
|
|
while (my $addon_id = shift @addon_ids) {
|
|
$addon_id = "+$addon_id" if exists $products{"+$addon_id"};
|
|
|
|
if ($ids_seen{$addon_id}++) {
|
|
warn "Infinite addon loop for '$product->{id}' at $filename line $product->{line}.\n";
|
|
next PRODUCT;
|
|
}
|
|
|
|
my $addon = $products{$addon_id};
|
|
if (not $addon) {
|
|
warn "Addon '$addon_id' does not exist for '$product->{id}' at $filename line $product->{line}.\n";
|
|
next PRODUCT;
|
|
}
|
|
|
|
push @{ $product->{addons} }, $addon;
|
|
push @addon_ids, @{ $addon->{_addon_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);
|
|
$cart->select($existing[0]);
|
|
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, product => $product }
|
|
);
|
|
$entry->add_contra(
|
|
$product->{contra},
|
|
+$price,
|
|
$contra_desc,
|
|
$display
|
|
);
|
|
|
|
for my $addon (@addons) {
|
|
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}
|
|
);
|
|
}
|
|
|
|
return ACCEPT;
|
|
}
|
|
|
|
sub tab {
|
|
return grep /\D/, keys %{ read_products() };
|
|
}
|