From ca03cb95d4d9fd4a3623ee826b612a71951afc39 Mon Sep 17 00:00:00 2001 From: Juerd Waalboer Date: Mon, 16 Jan 2023 03:08:42 +0100 Subject: [PATCH] New plugin statiegeld_tokens Activating statiegeld_tokens will limit the use of the statiegeld plugin for container deposit refunds to what was bought at this venue. Still needs documentation. Changes to 'statiegeld' and 'undo' were made to support the new plugin, specifically: - metadata (attributes) added in $cart->add, for the statiegeld_tokens plugin to use. - statiegeld plugin now shares a global variable (configuration). - undo can now be rolled back during hook_checkout. --- plugins/statiegeld | 6 +- plugins/statiegeld_tokens | 164 ++++++++++++++++++++++++++++++++++++++ plugins/undo | 26 +++++- 3 files changed, 191 insertions(+), 5 deletions(-) create mode 100644 plugins/statiegeld_tokens diff --git a/plugins/statiegeld b/plugins/statiegeld index 75a5094..2d16647 100644 --- a/plugins/statiegeld +++ b/plugins/statiegeld @@ -18,7 +18,7 @@ use List::Util; # (Note that the Dutch term "statiegeld" should only be displayed if you # choose to use it in the product descriptions.) -my @addon_accounts = ("+statiegeld"); +our @addon_accounts = ("+statiegeld"); my $nope = "Sorry, no deposit on that product.\n"; my $S = ($ENV{REVBANK_STATIEGELD} // 0) == 1; @@ -28,7 +28,7 @@ sub command ($self, $cart, $command, @) { defined &RevBank::Plugin::products::_read_products or die "statiegeld plugin requires products plugin"; - + my $products = RevBank::Plugin::products::_read_products(); my $product = $products->{$command} or return NEXT; @@ -55,7 +55,7 @@ sub command ($self, $cart, $command, @) { my $d = "$addon->{description} ($product->{description})"; $cart - ->add(+$addon->{price}, $d) + ->add(+$addon->{price}, $d, { plugin => $self->id, addon_id => $addon->{id} }) ->add_contra($addon->{contra}, -$addon->{price}, "$d for \$you"); } diff --git a/plugins/statiegeld_tokens b/plugins/statiegeld_tokens new file mode 100644 index 0000000..edb19ab --- /dev/null +++ b/plugins/statiegeld_tokens @@ -0,0 +1,164 @@ +#!perl + +# TODO: +# voiding of tokens +# querying of tokens +# expiry of tokens + +use List::Util; + +my $ttl = 100 * 86400; # expiry time in seconds +my $filename = "revbank.statiegeld"; + +sub _addon_accounts { + my @accounts = @RevBank::Plugin::statiegeld::addon_accounts + or die "statiegeld_tokens plugin requires statiegeld plugin"; + return @accounts; +} + +sub _read { + spurt $filename if not -e $filename; + + my %users_tokens; + for (slurp $filename) { + my ($username, @tokens) = split " ", $_; + if (exists $users_tokens{$username}) { + die "Corrupt data file $filename, $username listed twice"; + } + + my %by_id; + for my $token (@tokens) { + my (undef, $id) = split /:/, $token, 2; + push @{ $by_id{$id} }, $token; + } + + $users_tokens{$username} = \%by_id; + } + return \%users_tokens; +} + +sub _write($username, $tokens_by_id, $create) { + my @tokens = map @{ $tokens_by_id->{$_} }, sort keys %$tokens_by_id; + my $new_line = @tokens == 0 ? undef : join(" ", $username, @tokens) . "\n"; + + if ($create) { + append $filename, $new_line if defined $new_line; + } else { + rewrite $filename, sub ($old_line) { + # removes line from file if $new_line is undef + return /(\S+)/ && $1 eq $username ? $new_line : $old_line; + }; + } +} + +sub _warn($message) { + warn "\e[31;1mSorry,\e[0m $message\n"; +} + +sub _handle_undo($cart) { + # Undoing properly is hard. We can easily void tokens, but we can't restore + # them. That would requires duplicating all of the undo logic that exists + # for account balances, but for tokens. Too much work for something that I + # suspect would hardly be used anyway, so instead we'll just prohibit + # undoing refunds. + for my $entry ($cart->entries) { + # Undo deposit refund: prohibit + for my $contra ($entry->contras) { + next if $contra->{amount} < 0; + next if List::Util::none { $contra->{user} eq $_ } _addon_accounts; + + _warn "deposit refunds cannot be undone."; + die "ROLLBACK_UNDO"; + } + + # Undo buying: void specific tokens + my $undo_tid = $entry->attribute('undo_transaction_id') + or die "Plugin error: broken '-undo' transaction"; + + rewrite $filename, sub ($line) { + my ($username, @tokens) = split " ", $line; + @tokens = grep { + my ($meta, $id) = split /:/, $_; + my (undef, undef, $tid) = split /\./, $meta; + + $tid ne $undo_tid + } @tokens; + + return @tokens ? join(" ", $username, @tokens) : undef; + }; + } +} + +sub hook_checkout($class, $cart, $username, $transaction_id, @) { + if ($username eq '-undo') { + _handle_undo($cart); + return; + } + + # Read data + my $tokens_by_id = _read->{$username}; + my $is_new = !defined $tokens_by_id; + $tokens_by_id = {} if $is_new; + + my $products = RevBank::Plugin::products::_read_products(); + my $tokens_changed = 0; + + # Products bought: add tokens + for my $entry ($cart->entries('addons')) { + for my $addon_id (@{ $entry->attribute('addons') }) { + my $addon = $products->{"+$addon_id"} // $products->{$addon_id}; + + next + if $addon->{percent} + or (List::Util::none { $addon->{contra} eq $_ } _addon_accounts) + or $addon->{price} <= 0; + + for (1 .. $entry->quantity) { + my $token = join(":", + join(".", time(), time() + $ttl, $transaction_id), + $addon->{id} + ); + push @{ $tokens_by_id->{$addon->{id}} }, $token; + } + $tokens_changed++; + } + } + + # Products (containers) returned: void tokens in FIFO order + my $cart_changed = 0; + my %warnings_by_id; + my %had_num_tokens_by_id = map { $_ => scalar @{ $tokens_by_id->{$_} } } keys %$tokens_by_id; + + ENTRY: for my $entry ($cart->entries('plugin')) { + $entry->attribute('plugin') eq 'statiegeld' or next; + + my $id = $entry->attribute('addon_id'); + my $available = @{ $tokens_by_id->{$id} // [] }; + + if ($available < $entry->quantity) { + + if ($available == 0) { + $cart->delete($entry); + $warnings_by_id{$id}++; + next ENTRY; + } + $entry->quantity($available); + $warnings_by_id{$id}++; + } + + splice @{ $tokens_by_id->{$id} }, 0, $entry->quantity; + $tokens_changed++; + } + for my $id (keys %warnings_by_id) { + my $addon = $products->{"+$id"} // $products->{$id}; + my $avail = $had_num_tokens_by_id{$id}; + my $only = $avail ? "only $avail" : "0"; + _warn "you have $only deposit tokens of type $id ($addon->{description})"; + } + + # Store data + _write $username, $tokens_by_id, $is_new if $tokens_changed; + + return ABORT if %warnings_by_id and not $cart->size; + return; +} diff --git a/plugins/undo b/plugins/undo index 18b3c45..0c4bc08 100644 --- a/plugins/undo +++ b/plugins/undo @@ -44,13 +44,19 @@ sub undo :Tab(&tab) ($self, $cart, $tid, @) { my $description = "Undo $tid"; my $entry; my $found = 0; + my $aborted = 0; with_lock { + my $backup = "$filename.bak.$$"; + spurt $backup, slurp $filename; # copy for rollback + + # Immediately remove from file, to avoid double undo when something + # crashes. rewrite $filename, sub($line) { if ($line =~ /^\Q$tid\E\s/) { my (undef, $user, $delta) = split " ", $line; - $entry ||= $cart->add(0, $description); + $entry ||= $cart->add(0, $description, { undo_transaction_id => $tid }); $entry->{FORCE_UNBALANCED} = 1; $entry->add_contra($user, $delta, "Undo $tid"); @@ -63,11 +69,27 @@ sub undo :Tab(&tab) ($self, $cart, $tid, @) { if ($cart->size) { $found = 1; $doing_undo = 1; # don't allow undoing undos - $cart->checkout('-undo'); + + eval { $cart->checkout('-undo') }; + + if ($@ and $@ =~ "ROLLBACK_UNDO") { + # Undo the undo... :) + spurt $filename, slurp $backup; + + # can't 'return ABORT' here; it would return from with_lock + $aborted = 1; + } elsif ($@) { + # Re-throw exception + die "(undo file BACKUP at $backup.)\n$@"; + } else { + unlink $backup; + } + $doing_undo = 0; } }; + return ABORT, "Undo prohibited." if $aborted; return ACCEPT if $found; return ABORT, "Transaction ID '$tid' not found in undo log."; }