eed0db7897
The signatures feature has been "experimental" since Perl 5.20 (May 2014), but expected to stay. After 8 years I'm ready to take the risk :) Have added Perl v5.28 (June 2018) as the minimum requirement, even though the current revbank should work with 5.20, to see if this bothers any users. Perl v5.28 is in Debian "buster", which is now oldstable.
51 lines
1.3 KiB
Perl
51 lines
1.3 KiB
Perl
#!perl
|
|
|
|
HELP "pfand" => "Pfand zurueck";
|
|
|
|
# This is a demo plugin. It's called "pfand" because "deposit" would be
|
|
# confusing and only the Germans are crazy enough to have deposits on small
|
|
# bottles anyway ;)
|
|
|
|
# The file format for 'revbank.pfand' is simply two whitespace separated
|
|
# columns: product id and pfand amount.
|
|
|
|
sub _read_pfand() {
|
|
open my $fh, 'revbank.pfand' or die $!;
|
|
return {
|
|
map { split " " } grep /\S/, grep !/^\s*#/, readline $fh
|
|
};
|
|
}
|
|
|
|
sub command :Tab(pfand) ($self, $cart, $command, @) {
|
|
return NEXT if $command ne 'pfand';
|
|
|
|
return "Pfand zurueck fuer", \&product;
|
|
}
|
|
|
|
sub product :Tab(&tab) ($self, $cart, $product, @) {
|
|
my $pfand = parse_amount(_read_pfand->{ $product })
|
|
or return REJECT, "Invalid pfand amount for $product";
|
|
|
|
if ($pfand) {
|
|
$cart->add(+$pfand, "Pfand zurueck", { is_return => 1 });
|
|
} else {
|
|
say "$product: Kein Pfand";
|
|
}
|
|
return ACCEPT;
|
|
}
|
|
|
|
sub tab {
|
|
return keys %{ _read_pfand() };
|
|
}
|
|
|
|
sub hook_add_entry ($class, $cart, $entry, @) {
|
|
return if $entry->has_attribute('is_return');
|
|
return if not $entry->has_attribute('product_id');
|
|
|
|
my $pfand = _read_pfand->{ $entry->attribute('product_id') } or return;
|
|
|
|
$cart->add(-$pfand, "Pfand", { is_pfand => 1 });
|
|
|
|
return;
|
|
}
|
|
|