revbank/plugins/statiegeld
Juerd Waalboer fffb2d72e9 Fix deduplication bug, refactor deduplication to own plugin
(Bumps version to 3.8 because admins should update the plugin list.)

Deduplication didn't work on quantified additions, i.e. if you added
"20x clubmate" when there was already clubmate in the cart, it would add
just ONE item, and have a lingering message that the next thing would be
multiplied by 20.

This old bug was especially annoying if there is a barcode "20x
clubmate" to scan 20 bottles (which is the size of a crate), and this is
repeated.

The fix also uncovered another bug: newly added entries were selected
too early. There are two hooks, hook_add_entry and hook_added_entry, and
of course the selection should happen in between, not before the former.
No entry in UPGRADING.md, because I think it is extremely unlikely that
any plugin author will have used the selection feature yet, which is
very new.
2023-02-12 17:53:14 +01:00

151 lines
4.2 KiB
Perl

#!perl
use List::Util;
our @addon_accounts = ("+statiegeld");
my $nope = "Sorry, no deposit on that product.\n";
our $S = ($ENV{REVBANK_STATIEGELD} // 0) == 1;
sub statiegeld_product($product) {
if (not ref $product) {
# $product is a product id string; look up in product list
my $products = RevBank::Plugin::products::read_products();
$product = $products->{$product} or return;
}
# Called 'addons' here but also includes the queried product itself,
# to support things that are 100% statiegeld (e.g. empty crate)
my @relevant_addons = grep {
my $addon = $_;
!$addon->{percent}
and (List::Util::any { $addon->{contra} eq $_ } @addon_accounts)
and $addon->{price} > 0;
} $product, @{ $product->{addons} // [] };
return 0 if not @relevant_addons;
return { product => $product, statiegeld_addons => \@relevant_addons };
}
sub hook_deposit_command($class, $prompt, $array, @) {
$$prompt =~ s/$/, or scan empty container/;
push @$array, sub($, $cart, $input, @) {
my $p = statiegeld_product($input) // return NEXT;
if (not $p) {
print $nope;
return NEXT;
}
local $S = 1;
return command($class, $cart, $input);
};
}
sub command { # args via @_ for mutable alias
my ($invocant, $cart, $command) = @_;
$S or return NEXT;
# Hidden feature: use \ in front of product id to ignore statiegeld plugin.
# Not sure if this will stay; there might be a negative social aspect to
# normalizing grabbing a product and walking away from where one would
# normally pay.
if ($_[2] =~ s/^\\//) {
$cart->{statiegeld_ignore} = 1;
return NEXT;
}
defined &RevBank::Plugin::products::read_products
or die "statiegeld plugin requires products plugin";
$command =~ /^\+/ and return NEXT;
my $sg = statiegeld_product($command) // return NEXT;
if (not $sg) {
print $nope;
return ACCEPT;
}
my $product = $sg->{product};
my $addons = $sg->{statiegeld_addons};
for my $addon (@$addons) {
my $d = $addon->{id} eq $product->{id}
? "$addon->{description}"
: "$addon->{description} ($product->{description})";
$cart
->add(+$addon->{price}, $d, {
plugin => $invocant->id,
addon_id => $addon->{id},
deduplicate => join("/", $invocant->id, $addon->{id}),
})
->add_contra($addon->{contra}, -$addon->{price}, "$d for \$you");
}
return ACCEPT;
}
sub hook_added_entry ($class, $cart, $entry, @) {
$S or return;
$cart->{statiegeld_ignore} and return;
$entry->has_attribute('plugin') or return;
if ($entry->attribute('plugin') eq 'market') {
print $nope;
$cart->delete($entry);
}
if ($entry->attribute('plugin') eq 'products') {
my $id = $class->id;
die "Configuration error: the '$id' plugin must be *before* the 'products' plugin in revbank.plugins.\n";
}
}
# Override main revbank prompt
sub hook_prompt { # ($class, $cart, $prompt), but via @_ for mutable alias
$S or return;
my $m = "Scan empty container for deposit return.";
# The message is prepended to the prompt, so it is printed after
# clear-screen (^L).
# ignore----------end ignore-----end
# yellow----------------reset
my $statiegeld_prompt = "\x01\e[33;1m\x02$m\n+>\x01\e[0m\x02";
# Actual text: ^^^^^^
$_[2] =~ s/^$/$statiegeld_prompt/;
}
sub hook_input { # args via @_ for mutable alias
my ($class, $cart, $input, $split_input) = @_;
$S or return;
# Extra newline before new "Scan products for ..." line.
print "\n" if $input eq "" and $split_input;
# Hijack 'help' command so it never reaches the 'help' plugin.
if ($split_input and $input eq "help") {
print <<"END";
This is a beverage container (e.g. bottle) deposit return terminal to get your
money back; please use the other RevBank terminal for buying things and to read
the regular RevBank help text. (Normal RevBank commands are available.)
\e[1mJust scan the products and type your account name.\e[0m; deposits are only refunded
for container deposits on products that we have sold to you.
END
no warnings qw(exiting);
# "Exiting subroutine via %s"
# "(W exiting) You are exiting a subroutine by unconventional means,
# such as a goto, or a loop control statement."
redo OUTER; # this is phenominally vile :)
}
$_[2] = "help" if $split_input and $input eq "\\help";
}