144 lines
3.9 KiB
Perl
144 lines
3.9 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 ($invocant, $cart, $command, @) {
|
|
$S or 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})";
|
|
|
|
my @existing = grep {
|
|
$_->attribute('plugin') eq $invocant->id and
|
|
$_->attribute('addon_id') eq $addon->{id} and
|
|
$_->{description} eq $d
|
|
} $cart->entries('plugin');
|
|
|
|
if (@existing) {
|
|
$existing[0]->quantity($existing[0]->quantity + 1);
|
|
$cart->select($existing[0]);
|
|
next;
|
|
}
|
|
|
|
$cart
|
|
->add(+$addon->{price}, $d, { plugin => $invocant->id, addon_id => $addon->{id} })
|
|
->add_contra($addon->{contra}, -$addon->{price}, "$d for \$you");
|
|
}
|
|
|
|
return ACCEPT;
|
|
}
|
|
|
|
sub hook_added_entry ($class, $cart, $entry, @) {
|
|
$S or 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($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 :)
|
|
}
|
|
}
|