#!perl use List::Util; # This plugin is intended for use on a separate terminal. # Run revbank with REVBANK_STATIEGELD=1 on the bottle deposit terminal. # # In revbank.products, add the bottle/can deposit to products: # # clubmate 1.40 Club-Mate bottle +sb # cola 0.90 Cola can +sc # +sb 0.15@+statiegeld Bottle deposit # +sc 0.25@+statiegeld Can deposit # # This plugin is called "statiegeld" to prevent confusion with the existing # plugin "deposit": # geld storten = deposit # statiegeld = deposit # (Note that the Dutch term "statiegeld" should only be displayed if you # choose to use it in the product descriptions.) 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"; 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->{description} ($product->{description})"; $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"; } } sub hook_prompt { # ($class, $cart, $prompt), but via @_ for mutable alias $S or return; my $statiegeld_prompt = "\x01\e[33;1m\x02+>\x01\e[0m\x02"; # yellow "+>" if ($_[2] eq "" or $_[2] eq $statiegeld_prompt) { # Assumption: only the main prompt will have fewer than 3 \w characters print "\e[33;1mScan products for deposit return.\e[0m\n" if not $_[1]->size; } $_[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 :) } }