Bitlair plugins

Some transactions with only one contra account, but used multiple times,
or with the actor's own account as the only other contra account, were
erroneously allowed.

INSTALLING.md

@@ -0,0 +1,78 @@
+## Installing RevBank
+
+1. Install the dependencies:
+
+```
+Debian:  apt install libterm-readline-gnu-perl libcurses-ui-perl
+Generic: cpan Term::ReadLine::Gnu Curses::UI
+```
+
+2. Clone the repository, run `./revbank` :)
+
+## Configuring RevBank
+
+`revbank` uses data files from the _working directory_ from which it runs. You
+can use that to your advantage, if you don't want to change anything in your
+git working tree - in that case, copy `revbank.*` to the intended working
+directory, and symlink `plugins`. But you can also just change the files and
+deal with merge conflicts later, if you prefer.
+
+**RevBank just works out of the box** if you're in a hurry, but there's a lot you
+could customize.
+
+### Pick a transaction ID scheme
+
+If you skip this step, RevBank will use a large timestamp as a safe fallback.
+
+You can use any string that Perl can increment with the ++ operator:
+
+```sh
+# Simple, recommended:
+echo 1 > .revbank.nextid
+# or
+echo 00001 > .revbank.nextid
+# or
+echo AAAA > .revbank.nextid
+```
+
+This should be done only once. RevBank will increment the number. If you do
+wish to start a new sequence, you should clear `.revbank.undo` first if there
+is any chance that the sequences will overlap.
+
+(Note: letters in transaction IDs are supported, but may not be compatible with
+local laws or external accounting software.)
+
+### Other configuration
+
+- `revbank.plugins`: enable or disable plugins here.
+- `revbank.accounts`: if you're migrating from another system, you can add the
+  existing account balances here. Only the first two columns are mandatory
+  (account name and balance). Editing the accounts file when revbank is in
+  active use is not recommended because you might overwrite the effect of the
+  latest transactions, but you can maybe get away with it if you're fast
+  enough.
+- `revbank.products`: list your products here; the first column is a comma
+  separated (no space after the comma!) list of product codes. Only the
+  description makes it into the logs so make it sufficiently unique.
+- `plugins/deposit_methods`: if you want to enable this plugin (which is highly
+  recommended!), at least change the bank account number. When customizing
+  plugins, you can either copy the file and use your own, or edit the existing
+  file and deal with merge conflicts later. Either way you'll have to pay
+  attention to changes when upgrading.
+
+After changing `revbank.plugins` or any of the actual plugin files, you'll need
+to restart `revbank`. This is done with the `restart` command, unless the
+corresponding plugin was disabled. No restart is required after editing
+`revbank.products`, `revbank.market`, or `revbank.accounts`.
+
+If your terminal is unable to beep, e.g. if it's Linux console on a Raspberry
+Pi, copy the `beep_terminal` plugin to a new file, and figure out another way
+to play a sound or make a light flash. This is optional, but in general it's
+useful to have something that alerts users to the mistakes they make. An
+audible bell works better than a visual effect, but why not both?
+
+### Cash box
+
+If you want RevBank to indicate how much money it thinks the cash box should
+contain after every cash transaction, you'll probably want to enable the
+plugins `deposit_methods`, `cash`, and `skim`.

LICENSE

@@ -0,0 +1,3 @@
+Pick your favourite OSI approved license :)
+
+http://www.opensource.org/licenses/alphabetical

README.md

@@ -1,24 +1,51 @@
 # revbank - Banking for hackerspace visitors
 
-## Upgrading
+## Installing RevBank
 
-When upgrading from a previous version, please refer to the file `UPGRADING.md`
-because there might be incompatible changes that require your attention.
+For new installations, refer to [INSTALLING.md](INSTALLING.md).
 
-## Installing
+## Upgrading RevBank
 
-1. Install the Perl module Term::ReadLine::Gnu
+When upgrading from a previous version, please refer to the file
+[UPGRADING.md](UPGRADING.md) because there might be incompatible changes that
+require your attention.
 
-```
-Debian:  apt install libterm-readline-gnu-perl
-Generic: cpan Term::ReadLine::Gnu
-```
+## Using RevBank (for end users)
 
-2. Clone the repository, run revbank :)
+Type `help`.
 
-## Exiting revbank
+### Exiting revbank
+
+Exiting is not supported because it's designed to run continuously on its main
+terminal. But if you run it from a shell, you can probably stop it using ctrl+Z
+and then kill the process (e.g. `kill %1`). RevBank does not keep any files
+open, so it's safe to kill when idle.
+
+## Documentation
+
+End-user documentation is provided through the `help` command. For RevSpace
+visitors, some additional end-user documentation is available in Dutch at
+https://revspace.nl/RevBank.
+
+RevBank can be used without RTFM, but some documentation is provided to
+describe the inner workings in more detail:
+
+- [RevBank](lib/RevBank.pod) - technical overview
+- [RevBank::Amount](lib/RevBank/Amount.pod) - fixed decimal numbers
+- [RevBank::FileIO](lib/RevBank/FileIO.pod) - reading and writing files
+- [RevBank::Global](lib/RevBank/Global.pod) - constants and utility functions
+- [RevBank::Plugins](lib/RevBank/Plugins.pod) - writing plugins
+- [RevBank::Products](lib/RevBank/Products.pod) - revbank.products file format
+- [RevBank::TextEditor](lib/RevBank/TextEditor.pod) - internal pager and editor
+- [RevBank::Users](lib/RevBank/Users.pod) - user accounts and special accounts
+
+The plugins are mostly undocumented, but some have useful hints in the source
+files, and some have actual documentation:
+
+- [statiegeld](plugins/statiegeld.pod)
+- [statiegeld\_tokens](plugins/statiegeld_tokens.pod)
+- [vat](plugins/vat.pod)
+
+> Note: internal links between POD files are all broken in GitHub's rendering,
+> because GitHub wrongly assumes that every Perl package lives on CPAN.
 
-Exiting is not supported because it's desigend to run continuously. But if you
-run it from a shell, you can probably stop it using ctrl+Z and then kill the
-process (e.g. `kill %1`). RevBank does not keep any files open, so it's safe
-to kill when idle.

UPGRADING.md

@@ -1,3 +1,562 @@
+# Upgrade procedure
+
+1. Stop any running `revbank` instances, or at least make sure nobody will be
+   using RevBank during the upgrade.
+2. **Make a backup** of your RevBank data and code repo(s).
+3. Read this file :) to see if you need to change anything. Check your current
+   version and read everything pertaining to newer versions, from oldest to newest (top).
+4. Use `git pull --rebase` in the right directory. Don't ignore its output,
+   because you may need to manually resolve merge conflicts.
+5. (Re)start `revbank`. If the old version was still running, use the `restart`
+   command before issuing any other commands.
+
+The standard deprecation cycle is 2 years. **It is recommended that you upgrade
+RevBank at least once a year.**
+
+While you're at it, upgrade the rest of your system too. RevBank currently
+supports Perl versions down to 5.32 (2020), which is in Debian 11 "bullseye"
+(oldstable). Once Debian 13 "trixie" is released as stable (expected in 2025)
+and 12 "bookworm" becomes the new oldstable, RevBank will begin to require Perl
+5.36 (2022).
+
+# (2024-12-26) RevBank 8.0.0
+
+Another breaking change, another major version upgrade due to semantic versioning!
+
+## Breaking change:
+
+This is very unlikely to affect anyone, but still: `percent` addons (like
+discounts) applied by `read_products` now have the calculated price in
+`->{price}`, and the percent amount was moved to `->{percent}`, which was
+previously just a boolean.
+
+This change has had no deprecation cycle because I don't think anyone would be
+using this in custom code. But if you did use this feature in a custom plugin
+(wow, I really want to know all about it!), just change `price` to `percent`
+where appropriate.
+
+## Non-breaking changes:
+
+* `RevBank::Plugins::products::read_products` was moved to
+  `RevBank::Products::read_products`, but the old symbol still works.
+
+* `read_products` gained some additional features, such as price tag
+  calculations. Top-level products now have `->{tag_price}`, `->{hidden_fees}`,
+  and `->{total_price}` in addition to the existing base price which is still
+  in `->{price}`.
+
+* Because `read_products` is now in a module, you can `use RevBank::Products;`
+  in your own scripts so you don't have to write your own parser for
+  `revbank.products` anymore. (Don't forget to `use lib "path/to/lib";` first!)
+
+The calculated tag prices are not displayed anywhere in RevBank, but meant for
+an upcoming feature which is to generate images for electronic price tags. To
+exclude addon prices from the price tag (as is customary with
+statiegeld/pfand/deposits), add the new `#OPAQUE` hashtag to the respective
+addon lines in `revbank.products`.
+
+## Deprecation announcement
+
+* Support for the old file format for `revbank.products` will be removed in
+  2026. The new format was introduced in 6.0.0 in January 2024, but the old
+  format still works (and it gives a lot of warnings if you use it). See below
+  for how to update your products file.
+
+* The plugin `deprecated_raw` will be removed after February 2025. This plugin
+  warns tells users to use `withdraw` or `unlisted` instead of a raw amount,
+  after support for that was dropped in 3.3 in June 2022.
+
+# (2024-11-17) RevBank 7.1.0
+
+The new plugin `nomoney` is enabled by default. For rationale, see
+https://forum.revspace.nl/t/inkoopacties-via-revbank/469.
+
+Whether this constitutes a breaking change is debatable, and it wasn't added to
+this file until 2025-03-06. It's a new feature, but the feature is to disallow
+some transactions which used to be allowed. (Specifically, it denies
+transactions if the user has insufficient balance; by default only for
+give/take/withdraw, but the list of affected plugins can be customized.)
+
+
+# (2024-10-18) RevBank 7.0.0
+
+Support for unbalanced entries has been removed, ensuring a pure double-entry
+bookkeeping system. Grep your log for the string `UNBALANCED` if you're not
+sure that all your custom plugins are already well-behaved. Note that since
+unbalanced transactions are no longer supported, transactions from before that
+change can't be reverted with `undo`.
+
+There are no other changes in this version.
+
+Since all transactions are now balanced, the sum of all the balances is
+`revbank.accounts` will remain fixed forever. It is recommended to make that
+sum equal to `0.00` (only once) by adding a dummy account which acts a
+retroactive opening balance:
+
+```sh
+perl -Ilib -MRevBank::Amount -lane'$sum += RevBank::Amount->parse_string($F[1])
+}{ printf "-deposits/balance %s\n", -$sum if $sum;' revbank.accounts >> revbank.accounts
+```
+
+From that point forward, the sum of all the values in the second column of the
+`revbank.accounts` file should forever be 0.00; if it's not, either someone
+tampered with the file or there is data corruption, and the cause should be
+investigated and corrected.
+
+```sh
+perl -Ilib -MRevBank::Amount -lane'$sum += RevBank::Amount->parse_string($F[1])
+}{ print $sum' revbank.accounts
+```
+
+# (2024-01-20) RevBank 6.0.0
+
+Note that the changes to `revbank.products` do NOT apply to `revbank.market`
+and other files.
+
+## Update your `revbank.products` file
+
+TL;DR: Product descriptions now need `"quotes"` around them.
+
+This version comes with breaking changes to the `revbank.products` syntax, to
+expand the capabilities of the file in a more future-proof way. Bitlair
+(Hackerspace Amersfoort) has requested a way to add metadata to products for
+automation, which together with recent other additions to the format, made
+clear a more structured approach was needed.
+
+The line format for the products file is now like the input format of the
+command line interface. This means that if product descriptions contain spaces,
+as they typically do, quotes are needed around them. You can pick between
+`"double"` and `'single'` quotes. Any backslashes and quotes within the same
+kind of quotes need escaping by adding a `\` in front, e.g. `\"` and `\\`.
+
+```
+# Old format:
+product_id    0.42    Can't think of a good description +addon1 +addon2
+
+# New format, recommended style:
+product_id    0.42    "Can't think of a good description" +addon1 +addon2
+
+# Automatically generated? You may wish to quote all fields:
+"product_id" "0.42" "Can't think of a good description" "+addon1" "+addon2"
+
+# Escaping also works:
+product_id 0.42 Can\'t\ think\ of\ a\ good\ description +addon1 +addon2
+```
+
+To convert your `revbank.products` file to the recommended style automatically,
+you could use:
+
+```sh
+# The following is one command. It was obviously not optimized for readability :)
+
+perl -i.backupv6 -ple'unless (/^\s*#/ or /^\s*$/) {
+  my ($pre, $desc) = /(^\s*\S+\s+\S+\s*)(.*)/; $pre .= " " if $pre !~ /\s$/;
+  my @a; unshift @a, $1 while $desc =~ s/\s\+(\S+)$//;
+  $desc =~ s/([\"\\])/\\$1/g; $_ = "$pre\"$desc\"";
+  for my $a (@a) { $_ .= " +$a" }
+}' revbank.products
+```
+
+Note that this will leave commented lines unchanged! If those contain disabled
+products, you'll have to add the quotes yourself.
+
+## New feature: hashtags in `revbank.products`
+
+After the description field, you can add hashtag fields. These begin with `#`
+and may take the form of a lone `#hashtag`, or they may be used as a
+`#key=value` pair. The hashtags can be read by plugins. Out of the box, they
+currently do nothing.
+
+```
+8711327538481  0.80  "Ola Liuk"   #ah=wi162664 #q=8
+8712100340666  0.45  "Ola Raket"  #ah=wi209562 #q=12
+5000112659184,5000112658873  0.95  "Coca-Cola Cola Zero Sugar (33 cl)" #sligro +sb
+
+# equivalent:
+"8711327538481" "0.80" "Ola Liuk" "#ah=wi162664" "#q=8"
+```
+
+See https://github.com/bitlair/revbank-inflatinator/ for a possible use of adding metadata.
+
+# (2023-12-26) RevBank 5.0.0
+
+This version comes with breaking changes to the command line syntax, to shield
+overconfident users of the interface for advanced users from several classes of
+common mistakes, and to add support for quoted and escaped strings to this
+interface.
+
+Basically, you can now use `;` to separate multiple commands on a single line
+of input, and in some cases this is mandatory.
+
+## Limited set of characters allowed in usernames and product IDs
+
+Historically, RevBank has allowed almost every character as a valid character,
+because it wasn't known if these would show up in barcodes. In more than 13
+years of real world use, though, it seems that barcodes and usernames with
+"special" characters are incredibly uncommon.
+
+Since `' " \ ;` now have special meanings, they are no longer supported in
+product IDs. In theory, they could be quoted or escaped, but barcode scanners
+don't know that. Existing users with those characters in their names can
+continue to use their accounts by quoting or escaping them.
+
+New usernames must now only contain the characters from the set 
+`A-Z a-z 0-9 _ - + / ^ * [] {}` and the first character must not be any of
+`- + / ^ *`.
+
+## Update scripts that run revbank commands
+
+When providing multiple commands on a single line, RevBank now requires a
+separating `;` after commands that finalize transactions, and after commands
+that take arguments.
+
+End-users are guided interactively to deal with the change, but automated
+commands require changing. Specifically, add a `;` between a multi-word command
+and the final username (e.g. `give *lasercutter 10; xyzzy`) and in between
+transactions.
+
+## Update your custom plugins
+
+* The undocumented feature `ROLLBACK_UNDO` is gone. Use `return ABORT` in a
+  function called `hook_undo` instead.
+* Plugins are now evaluated with an implicit `use v5.32;` which enables many
+  new Perl features and disables some old ones. Specifically, the old-style
+  "indirect object notation" is disabled, which means that `new Foo(...)`
+  should be rewritten as `Foo->new(...)`.
+* `$cart->checkout` now throws an exception if there is unprocessed input in
+  the queue (the user can use `;` if it was intentional). There were always
+  reasons a checkout could fail, but now it is much more likely. Things that
+  should only happen if the checkout succeeds, should be put *after* the call,
+  or in a hook.
+
+# (2023-11-05) RevBank 4.2.0
+
+Accounts that begin with `*` are now special: like hidden accounts, they do not
+count towards the grand total, but unlike hidden accouns, they can be used as
+normal user accounts too.
+
+The intended application is for liabilities accounts that are also used
+directly for revenues and expenses.
+
+They can be used with or without the `*` prefix, e.g. the account
+`*lasercutter` can also be used as `lasercutter`. Such accounts cannot be
+created from within the software: to create a user-accessible special account,
+you need to edit `revbank.accounts` manually.
+
+When upgrading, check that no accounts beginning with `*` already exist.
+
+# (2023-09-20) RevBank 4.0.0
+
+## You must pick a transaction ID style
+
+Transaction IDs are now sequential for better auditability. In previous
+versions, they were timestamps (unix time minus 1.3e9).
+
+Because of this change, you must restart *every* running RevBank instance or
+else the transaction IDs will no longer be monotonic between processes, which
+would be bad.
+
+You should choose which transaction IDs you want, and write your choice to a
+file called `.revbank.nextid`.
+
+### Option 1: continue with large IDs but increment by 1 from now on
+
+**If you don't write a `.revbank.nextid` file,** RevBank will create one for
+you, but you might not like it. It will generate one more timestamp based ID
+and then increment that for subsequent transactions. This has the advantage of
+not having the one-time break of monotonicity, but you will be stuck with the
+long IDs and they will no longer convey time information.
+
+### Option 2: beginning a new sequence
+
+Anything that works with Perl's `++` operator will work, and that gives a few
+options. If you want to start over with transaction ID **1**, write that to the
+file:
+
+```sh
+echo 1 > .revbank.nextid
+```
+
+You can also use padding zeroes if you like. They will safely overflow to use
+an extra digit after all-nines is reached:
+
+```sh
+echo 00001 > .revbank.nextid
+```
+
+(You can also use alphanumeric IDs, but I'm not sure if you should.)
+
+Or, if you still have all the logs from since you started using RevBank, you
+can pretend RevBank has always had simple incremental transaction IDs and use
+the number of distinct transaction IDs from the log file as the basis for the
+next ID:
+
+```sh
+# This is my personal preference
+
+perl -lane'BEGIN { $max = time() - 1.3e9 }
+    /^\d+$/ and $_ > 0 and $_ < $max and $x{$_}++ for @F[1, 2];
+    }{ print 1 + keys %x' .revbank.log > .revbank.nextid
+
+# Note: use multiple filenames (e.g. .revbank.log*) if you rotate log files
+# (like when you have yearly logs).
+```
+
+This is safe because the timestamp based IDs were huge and are unlikely to
+overlap at least the next few decades.
+
+### Option 3: keeping the legacy transaction ID scheme (for now)
+
+Finally, for those who really don't want to change the scheme now, the old
+system can be retained by writing the special-cased value `LEGACY`. This
+feature will be supported at least until 2024-01-01, but might be removed after
+if nobody tries to convince me otherwise.
+
+```sh
+echo LEGACY > .revbank.nextid
+```
+
+## Update `revbank.plugins`
+
+There are a few new plugins that you may wish to enable. Some have been around
+longer than RevBank 3.9, but haven't been mentioned in UPGRADING.md before.
+
+### `vat`
+
+Automatically calculate and set aside VAT ("BTW" in Dutch) on generated
+revenue. You will probably not need this. Before enabling this plugin, read the
+documentation in `plugins/vat.pod` first.
+
+### `regex_gtin`
+
+To support GS1 Digital Links and other GS1 barcodes. The DL are a new way for
+QR codes that contain product IDs and other metadata while also being usable
+for promotional stuff. At least one popular brand of soft drinks is already
+using them. There's a huge standard that describes these codes, but basically,
+they're URLs with /01/ and a 14-digit product ID in them. Enabling this plugin
+is probably useful and harmless; add it to `revbank.plugins` *after* plugins
+that deal with product IDs like `products` and `market`.
+
+### `regex_angel`
+
+Replaces custom SHA2017/MCH2022 angel badge hacks. Add after `users` in
+`revbank.plugins` after removing your custom plugin for `angel-` barcodes.
+
+### `adduser_note`
+
+Add *before* `adduser` in `revbank.plugins`. This will inform new users that
+RevBank is insecure by design and what implications that can have. Enabling
+this plugin is recommended.
+
+### `statiegeld` and `statiegeld_tokens`
+
+Charge and refund container deposit return ("statiegeld" in Dutch). Read the
+documentation in `plugins/statiegeld.pod` and `plugins/statiegeld_tokens.pod`
+for instructions.
+
+### `cash_drawer`
+
+If you have an electronic cash drawer, copy or change this plugin and add code
+to trigger it whenever something is done that involves cash.
+
+## Deprecation note
+
+RevBank has supported "doubly entry bookkeeping" since version 3.4 last year.
+For backwards compatibility with custom plugins, support for unbalanced
+transactions was retained.
+
+Support for unbalanced transactions will be removed after 2024-06-10, after a
+period of 2 years after the introduction of balanced transactions. If you're
+using custom plugins, grep your log file for the text "UNBALANCED ENTRY" to see
+if changes are needed.
+
+# (2023-08-21) RevBank 3.9
+
+A tiny change that could break things: the shebang was changed from
+`#!/usr/bin/perl` to the more modern `#!/usr/bin/env perl`.
+
+In the unlikely event that your system has multiple perl executables in the
+search path of `PATH`, this change could mean that revbank now uses a different
+perl, in which case you may have to reinstall the required Perl libraries.
+
+Background: NixOS doesn't follow the previously uni(x)versal convention that,
+when Perl is available, an executable exists at `/usr/bin/perl`. The only
+stable paths that NixOS provides for shebangs are `#!/bin/sh` or
+`#!/usr/bin/env`. There were always pros and cons to switching the shebang to
+`env` (e.g. for use with perlbrew), but learning about Nix has tipped the
+scales for me. (The performance penalty is not relevant for RevBank.)
+
+# (2023-02-12) RevBank 3.8
+
+## Update your `revbank.plugins`
+
+Deduplication is moved from individual plugins to a plugin that does that. If
+you want to keep deduplication of cart items, and you probably do want that,
+add `deduplicate` to `revbank.plugins` just below `repeat`.
+
+The deprecation warning was moved from the `withdraw` plugin to a new plugin
+called `deprecated_raw`. If you're upgrading from an older versions and some of
+your users have been around since before the withdraw/unlisted split, you may
+want to keep the deprecation warning. But for new RevBank installations it does
+not make sense. To keep providing these warnings to users that enter raw
+amounts, add `deprecated_raw` to the very end of `revbank.plugins`.
+
+# (2022-12-25) RevBank 3.6
+
+## Update your `revbank.plugins`
+
+The `edit` command is now in its own plugin, so that it can be disabled (this
+has been requested several times). To keep the ability to edit the products
+list from within RevBank, add `edit` to `revbank.plugins`.
+
+## Check your `revbank.products`
+
+> Added 2024-01-20 v6.0.0: if you're upgrading to v6.0.0 from a version before
+> v3.6, instead of following these instructions, you can just add quotes to the
+> descriptions (when using the perl oneliner from the v6.0.0 upgrade
+> instructions, check if any `+something` that got placed outside of the quotes
+> should have been within the quotes.)
+
+~~There's new syntax for `revbank.products`: addons. Check that your lines don't
+have `+foo` at the end, where `foo` can be anything.~~
+
+~~Also check that you don't have any product ids that start with `+`; those can
+no longer be entered as this syntax now has special semantics.~~
+
+~~So these don't work as before:~~
+
+    example_id      1.00  Example product +something
+    +something      1.00  Product id that starts with plus
+    example,+alias  1.00  Alias that starts with plus
+
+~~These will keep working as they were:~~
+
+    example_id1     1.00  Example product+something
+    example_id2     1.00  Example product + something
+    more_stuff      1.00  Example product with +something but not at the end
+    bbq             1.00  3+ pieces of meat
+
+## New features in `products` plugin
+
+There are several new features that you may wish to take advantage of. By
+combining the new features, powerful things can be done that previously
+required custom plugins.
+
+The syntax for `revbank.products` has become complex. Please refer to the new
+documentation in [products.pod](plugins/products.pod) for details.
+
+### Negative prices (add money to account)
+
+Support for non-positive prices was requested several times over the years and
+has now finally been implemented.
+
+It's now possible to have a product with a negative amount, which when "bought"
+will cause the user to receive money instead of spending it.
+
+### Product addons
+
+It is now possible to add products to products, which is done by specifying
+`+foo` at the end of a product description, where `foo` is the id of another
+product. This can be used for surcharges and discounts, or for bundles of
+products that can also be bought individually.
+
+### Explicit contra accounts
+
+By default, products sold via the `products` plugin, are accounted on the
+`+sales/products` contra account. This can now be overridden by specifying
+`@accountname` after the price in `revbank.products`. For example,
+`1.00@+sales/products/specificcategory`. While this will mess up your tidy
+columns, you may be able to get rid of a bunch of custom plugins now.
+
+When the specified contra account is a regular account (does not start with `+`
+or `-`), this works similar to the `market` plugin, but without any commission
+for the organization.
+
+## Pfand plugin: gone
+
+The `pfand` plugin, that was originally written as a proof-of-concept demo, has
+been removed without deprecation cycle. To my knowledge, nobody uses this
+plugin. If you did use it, just grab the old version from git. Please let me
+know about your usecase!
+
+The introduction of beverage container deposits in The Netherlands has
+triggered reevaluation, and several things about that plugin were wrong,
+including the condescending comments that bottle deposits for small bottles
+would be crazy or wouldn't make sense in a self-service environment. RevBank
+was too limited to support it properly, but I think current RevBank fulfills
+all requirements for making a better, proper pfand plugin.
+
+## Perl warnings are now enabled for plugins
+
+If you get Perl warnings from a plugin, and don't want to fix the issues with
+the code (or disagree with the warning), just add "no warnings;" to the top of
+the plugin file. However, the warnings are often indicative of suboptimal code
+that is ground for improvement!
+
+Most warnings will be about unitialized (undefined) values. Some guidance for
+Perl newbies: you can test whether something is defined with `if
+(defined($foo)) { ... }`, or provide a default value with `$foo // "example
+default value"`.
+
+# (2022-08-30) RevBank 3.5
+
+RevBank now has a simple built-in text editor for products and market;
+rationale in lib/RevBank/TextArea.pod.
+
+This comes with a new dependency, the perl module Curses::UI (debian:
+libcurses-ui-perl).
+
+# (2022-06-11) RevBank 3.4
+
+RevBank now has built-in hidden accounts and balanced transactions
+(double-entry bookkeeping). These accounts will be made automatically, and
+hidden from the user interface.
+
+## Update external scripts
+
+If you have scripts that parse `.revbank.log` or `revbank.products`, you may
+want to ignore all accounts that start with `-` or `+`.
+
+## User account names that are now invalid
+
+In the hopefully very unlikely event that you have existing user accounts that
+start with `-` or `+`, those will have to be renamed manually, as such accounts
+are no longer accessible.
+
+## Updating custom plugins (optional for now)
+
+For your custom plugins, you may want to add `->add_contra` calls to every
+`$cart->add` call that does not already have them. Unbalanced transactions will
+probably be deprecated in a future version.
+
+## New feature: cashbox tracking
+
+The new `cash` plugin will display messages about how much the cash box should
+hold, whenever someone withdraws or does a cash deposit. For that to make
+sense, this requires the `deposit_methods` plugin to be enabled, and to have
+a `"cash"` deposit method.
+
+When adding the `cash` plugin in `revbank.plugins`, make sure it is listed
+_before_ `stock` if you have that one too. And you probably want to enable
+the `skim` plugin too, which introduces the (hidden) commands `skim` and
+`unskim` which can be used to keep the cash box data synchronised when someone
+(probably a board member) skims it.
+
+# (2022-06-04) RevBank 3.3
+
+Raw amounts without a command are no longer supported. There was already an
+explicit command for unlisted products, `unlisted`, and for withdrawals there
+is now the new command `withdraw`. An explanatory message guides users who
+use the old style towards the new commands.
+
+This change makes it possible for treasurers to more accurately deduce the
+intention of a revbank transaction.
+
+When upgrading, make sure the `unlisted` plugin is installed in
+`revbank.plugins`. Without it, the instruction text presented when someone
+enters an amount is wrong and the functionality for paying for unlisted
+products is lost.
+
 # (2021-12-02) RevBank 3.2
 
 ## Update your custom plugins!

contrib/oepl_resources/LICENSE-TerminusTTF

@@ -0,0 +1,97 @@
+Copyright (c) 2010 Dimitar Toshkov Zhekov,
+with Reserved Font Name "Terminus Font".
+
+Copyright (c) 2011-2023 Tilman Blumenbach,
+with Reserved Font Name "Terminus (TTF)".
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+This license is copied below, and is also available with a FAQ at:
+http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded, 
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

contrib/openepaperlink.pl

@@ -0,0 +1,272 @@
+#!/usr/bin/perl
+use v5.36;
+use autodie;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use RevBank::Products;
+
+use Imager;
+use Imager::Fill;
+use Imager::Font::Wrap;
+use LWP::Simple qw($ua);
+use JSON::XS ();
+
+my $json = JSON::XS->new;
+$ua->timeout(2);
+
+my $resources = "$FindBin::Bin/oepl_resources";
+my $outdir = "./oepl_images";
+my $ap = 'http://10.42.42.123';
+
+eval { mkdir $outdir };
+
+sub slurp ($fn) { local (@ARGV) = $fn; local $/ = wantarray ? "\n" : undef; <> }
+sub spurt ($fn, @data) { open my $fh, '>', $fn; print $fh @data; }
+
+sub post ($uri, $kv) {
+	for (my $i = 0; $i < @$kv; $i += 2) {
+		if ($kv->[$i] eq "file") {
+			$kv->[$i + 1] = [ $kv->[$i + 1], "filename.jpg", Content_Type => "image/jpeg" ];
+			last;
+		}
+	}
+
+	my $response = $ua->post("$ap/$uri", Content_Type => 'form-data', Content => $kv);
+	warn $response->content if not $response->is_success;
+	return $response->is_success;
+}
+
+
+sub draw ($product, $hwtype, $force) {
+	my $sub = main->can("draw_hwtype_$hwtype") or do {
+		warn "Unsupported hwtype ($hwtype)";
+		return undef;
+	};
+	$product->{_fn} = $product->{id} =~ s/([^A-Za-z0-9_])/sprintf("%%%02x", ord $1)/ger;
+	my $image = $sub->($product);
+
+	my $fn = "$outdir/$product->{_fn}\_$hwtype.jpg";
+	my $old = -e $fn ? slurp($fn) : "";
+
+	$image->write(
+		data => \my $new,
+		type => "jpeg",
+		jpegquality => 100,  # no underscore
+		jpeg_optimize => 1,
+		jpeg_sample => "1x1",  # 1x1 = 4:4:4
+	) or die $image->errstr;
+
+	if ($force or $new ne $old) {
+		spurt $fn, $new if $new ne $old;
+		return $fn;
+	}
+
+	return undef;
+}
+
+sub get_dbitem($mac) {
+	my $response = $ua->get("$ap/get_db?mac=$mac");
+	my $hash = eval { $json->decode($response->content) } || { tags => [] };
+	my $tags = $hash->{tags};
+	if (@$tags != 1) {
+		my $status = $response->status_line;
+		warn "Can't get info for $mac (HTTP $status); new tag not ready yet?\n";
+		return {};
+	}
+	return $tags->[0];
+}
+
+sub comma($str) {
+	"$str" =~ s/\./,/gr =~ s/0/O/gr;
+}
+
+sub aztec($product) {
+	my $fn = "$outdir/$product->{_fn}_aztec.png";
+
+	if (not -e $fn) {
+		system qw(zint --barcode 92 --vers 3 --scale 1 --filetype PNG --nobackground --whitesp 0 --vwhitesp 0), "--data" => $product->{id}, "--output" => $fn;
+	}
+
+	return Imager->new->read(file => $fn) if -e $fn;
+}
+
+sub _draw_hwtype_3_4 ($product, $xsize, $ysize, $fontsize, $lineheight) {
+	# Same design for hwtype 3 and hwtype 4, but on hwtype 4, with larger font.
+
+	my @colors = (
+		my $white = Imager::Color->new(255,255,255),
+		my $black = Imager::Color->new(0,0,0),
+		my $red   = Imager::Color->new(255,0,0),
+	);
+
+	my $font = Imager::Font->new(file => "$resources/TerminusTTF-Bold-4.49.3.ttf", aa => 0);
+
+	# Terminus sizes: 12 14 16 18 20 22 24 28 32
+
+	my $is_erase = $product->{id} eq "_ERASE_";
+	my $is_promo = $product->{tags}{promo};
+	my $fg = $is_promo ? $white : $black;
+	my $bg = $is_promo || $is_erase ? $red : $white;
+
+	my $image = Imager->new(xsize => $xsize, ysize => $ysize);
+	$image->setcolors(colors => \@colors);
+	$image->box(filled => 1, color => $bg);
+	return $image if $is_erase;
+
+	my $addon_text;
+	my $addon_highlight = 0;
+
+	for my $addon (@{ $product->{addons} }) {
+		next if $addon->{tags}{OPAQUE};
+		my $d = $addon->{description};
+		$addon_text = ($addon->{price} < 0) ? $d : "+ $d";
+		$addon_highlight = 1 if $addon->{price} < 0;
+		last;
+	}
+
+	my $text = $product->{description};
+
+	my (undef, undef, undef, $bottom) = Imager::Font::Wrap->wrap_text(
+		image => $image,
+		font => $font,
+		string => $text,
+		color => $fg,
+		justify => "center",
+		x => 0,
+		y => 0,
+		size => $fontsize,
+		height => ($addon_text ? 3 : 2) * $lineheight,
+	);
+
+	$addon_text and Imager::Font::Wrap->wrap_text(
+		image => $image,
+		font => $font,
+		string => $addon_text,
+		color => ($addon_highlight ? ($is_promo ? $black : $red) : $fg),
+		justify => "center",
+		x => 0,
+		y => $bottom,
+		size => $fontsize,
+		height => (3 * $lineheight) - $bottom,
+	);
+
+	my $xmargin = 6;
+	my $ymargin = 2;
+	my $has_discount = $product->{tag_price} < $product->{price};
+
+	my $price = sub {
+		return $image->align_string(
+			x => $xsize - 1 - $xmargin,
+			y => $ysize - 1 - $ymargin,
+			valign => 'bottom',
+			halign => 'right',
+			string => comma($product->{tag_price}),
+			utf8 => 1,
+			color => ($has_discount ? $white : $white),
+			font => $font,
+			aa => 0,
+			size => 32,
+		);
+	};
+
+	my @bounds = $price->();
+
+
+	my @box = ($bounds[0] - $xmargin, $bounds[1] - $ymargin, $bounds[2] + $xmargin, $bounds[3] + $ymargin);
+	$image->box(box => \@box, fill => { solid => ($has_discount ? $red : $black) });
+	$price->();
+
+	if (my $unit = $product->{tags}{ml} ? "ml" : $product->{tags}{g} ? "g" : undef) {
+		my $X = $unit eq "ml" ? "L" : $unit eq "g" ? "kg" : die;
+		my $perX = sprintf "%.02f", $product->{tag_price}->float * 1000 / $product->{tags}{$unit};
+
+		@bounds = $image->align_string(
+			x => $box[2],
+			y => $box[1],
+			valign => 'bottom',
+			halign => 'right',
+			string => comma("$product->{tags}{$unit} $unit $perX/$X"),
+			utf8 => 1,
+			color => $fg,
+			font => $font,
+			aa => 0,
+			size => 12,
+		);
+	}
+
+	# There's place for only 1 but looping over all is easier :)
+	# Intended purpose is statiegeld logos.
+	for my $addon (@{ $product->{addons} }) {
+		my $fn = "$resources/$addon->{id}.png";
+		-e $fn or next;
+		my $statiegeld = Imager->new->read(file => $fn);
+		$image->compose(src => $statiegeld, tx => 63, ty => $ysize - 48 - 1);
+	}
+
+	if (my $aztec = aztec $product) {
+		$image->compose(src => $aztec, tx => 1, ty => $ysize - 46 - 1);
+	}
+
+	return $image;
+}
+
+sub draw_hwtype_3 ($product) {
+	_draw_hwtype_3_4($product, 212, 104, 18, 18);
+}
+
+sub draw_hwtype_4 ($product) {
+	_draw_hwtype_3_4($product, 296, 152, 28, 30);
+}
+
+my @lines = slurp ".revbank.oepl";
+my %new_hwtype;
+
+my $products = read_products;
+$products->{_NOTFOUND_} = {
+	id => "_NOTFOUND_",
+	description => "(product unavailable)",
+	price => "999.99",
+	tag_price => "999.99",
+};
+
+my $fix_mode = @ARGV && $ARGV[0] eq 'fix';
+shift if $fix_mode;
+
+my $erase_mode = !$fix_mode && @ARGV && $ARGV[0] eq 'erase';
+shift if $erase_mode;
+die "Usage: $0 erase <mac>...\n" if $erase_mode and not @ARGV;
+
+my %fns;
+
+for my $line (@lines) {
+	my ($mac, $product_id, $hwtype) = split " ", $line;
+	$mac and $mac =~ /^[0-F]{12,16}$/ or next;
+	$product_id or next;
+	(grep { $_ eq $product_id or $_ eq $mac } @ARGV) or next if @ARGV;
+
+	my $product = $erase_mode
+		? { id => "_ERASE_", description => $mac }
+		: $products->{$product_id} || $products->{_NOTFOUND_};
+
+	my $needs_fixing = 0;
+	if ($fix_mode or not $hwtype) {
+		my $dbitem = get_dbitem($mac);
+		next if not %$dbitem;
+		$hwtype ||= $new_hwtype{$mac} = $dbitem->{hwType};
+		$needs_fixing = $dbitem->{hash} =~ /^0+$/;
+	}
+
+	my $fn = $fns{$product} ||= draw($product, $hwtype, $needs_fixing || !!@ARGV) or next;
+
+	print "Uploading image for $mac ($product->{description}).\n";
+	post "imgupload" => [ mac => $mac, lut => 1, alias => $product->{description}, file => $fn ];
+
+	if ($new_hwtype{$mac}) {
+		$line =~ s/$/ $new_hwtype{$mac}/;
+	}
+}
+
+if (%new_hwtype) {
+	spurt ".revbank.oepl", @lines;
+}

contrib/revbank2beancount.pl

@@ -0,0 +1,166 @@
+#!/usr/bin/env perl
+
+=head1 DESCRIPTION
+
+This script translates a RevBank log file to Beancount 2 format, which can then
+be used with beancount tools such as the web interface Fava:
+
+	perl contrib/revbank-log2beancount.pl > revbank.beancount
+	fava revbank.beancount
+
+Call this script from the directory that contains C<revbank.accounts> and
+C<.revbank.log>. Optionally, a different log file can be given on the command
+line, to be used instead of C<.revbank.log>.
+
+=head2 Caveats
+
+This results in an incomplete administration, as RevBank will undoubtedly be
+unaware of most expenses, and income through contribution fees. So while the
+total numbers (like "net profit") are mostly useless, the numbers for
+individual accounts may be insightful, and it provides pretty charts.
+
+RevBank uses datetime with a 1 second resolution, but Beancount 2 only supports
+date granularity, so it can't give intradate numbers. The time is recorded as
+metadata but otherwise ignored by Beancount; they postings are in the right
+order because it's a stable sort, not because the time is taken into account.
+
+Note that compared to a typical Beancount ledger, all amounts will be flipped,
+i.e. -42 becomes +42 and +42 becomes -42. This is because RevBank's bookkeeping
+is done from the users' perspectives, rather than that of the organization.
+Incidentally, the resulting numbers will also make more intuitive sense as
+income is now positive and expenses are negative - which is not what a typical
+Beancount administration would look like, but would seem more logical to most
+lay persons.
+
+Beancount transaction descriptions are attached to the booking, not to its
+individual postings, while RevBank has a different description for each
+account, again because it works from the perspectives of the users. The
+descriptions are converted as string metadata. To view them in Fava, enable
+both Metadata and Postings.
+
+Fava beans can be deadly for persons with G6PD deficiency, because the beans
+contain vicine, which is toxic to them as vicine oxidises glutathione faster
+than these people can regenerate it. The resulting hemolytic anemia due to
+premature breakdown of red blood cells can culminate in a fatal hemolytic
+crisis. G6PD deficiency is a hereditary enzyme deficiency that is estimated to
+affect 5% of Earth's human population.
+
+=cut
+
+use v5.32;
+use warnings;
+use autodie;
+
+use FindBin qw($RealBin);
+use lib "$RealBin/../lib";
+use RevBank::Amount;
+
+my %transactions;
+my @transaction_ids;  # keep order: future revbank might have non-monotonic ids
+my %balances;
+my $currency = "EUR";
+my $first_date = "9999-99-99";
+my $fn = shift;
+
+print qq{option "operating_currency" "$currency"\n};
+
+sub rb2bc {
+	# TODO Rewrite. What a mess.
+
+	local $_ = join ":", map ucfirst, split m[/], shift;
+	s/_/-/g;
+	s/^-cash$/-cash:Box/;  # skimmed would be sub category
+	return "Expenses:Reimbursed" if $_ eq "-deposits:Reimburse";
+	return "Assets:\u$_" if /^(?:-cash|-deposits)\b/i and s/^-//;
+	return "Expenses:\u$_" if /^(?:-expenses)\b/i and s/^-//;
+	return "Liabilities:Ibuttonborg" if $_ eq "+ibuttonborg";
+	return "Equity:\u$_" if s/^-//;
+	return "Income:\u$_" if s/^\+//;
+	return "Liabilities:$_";
+}
+
+open my $fh, $fn || ".revbank.log";
+
+while (defined(my $line = readline $fh)) {
+	if ($line =~ /CHECKOUT/) {
+		my ($date, $time, $id, $account, $dir, $qty, $amount, $desc) = $line =~ m[
+			^(\d\d\d\d-\d\d-\d\d)_(\d\d:\d\d:\d\d)  # date_time
+			\s++ CHECKOUT
+			\s++ (\S++)            # transaction id
+			\s++ (\S++)            # account name
+			\s++ (GAIN|LOSE|====)  # direction
+			\s++ (\d++)            # quantity
+			\s++ ([\d.]++)         # total amount (absolute)
+			\s++ \#\s(.*)          # description
+		]x or warn;
+	
+		$first_date = $date if $date lt $first_date;
+
+		if (not exists $transactions{$id}) {
+			$transactions{$id} = { date => $date, time => $time };
+			push @transaction_ids, $id;
+		}
+
+		push @{ $transactions{$id}{legs} }, {
+			account => $account,
+			dir     => $dir,
+			amount  => $amount,
+			desc    => $desc,
+		};
+	}
+
+	elsif ($line =~ /BALANCE/) {
+		my ($date, $id, $account, $balance) = $line =~ m[
+			^(\d\d\d\d-\d\d-\d\d)_\S++  # date
+			\s++ BALANCE
+			\s++ (\S++)         # transaction id
+			\s++ (\S++)         # account name
+			\s++ had
+			\s++ ([+-][\d.]++)  # account balance before transaction
+		]x or warn;
+
+		# This uses the fact that revbank will *always* emit a BALANCE event
+		# for every account modified by a CHECKOUT event, and that transactions
+		# will be in chronological order in the log. That is, the first old
+		# balance will be the opening balance, regardless of the corresponding
+		# transaction id.
+		$balances{$account} //= $balance;
+	}
+}
+
+print "$first_date open Equity:Opening-Balances\n";
+print "$first_date open Equity:Undo\n";
+
+# Opening balances for accounts that had transactions
+for my $account (sort keys %balances) {
+	printf "$first_date open %s $currency\n", rb2bc($account);
+	print qq{$first_date * "Opening balance for $account"\n};
+	printf(
+		"  %s %s $currency\n",
+		rb2bc($account),
+		RevBank::Amount->parse_string($balances{$account})
+	);
+	printf "  Equity:Opening-Balances\n\n";
+
+}
+
+# Transactions
+for my $id (@transaction_ids) {
+	my $txn = $transactions{$id};
+
+	print qq{$txn->{date} * "RevBank-transaction $id"\n};
+	print qq{  time: "$txn->{time}"\n};
+
+	for my $leg (@{ $txn->{legs} }) {
+		printf(
+			qq{  %s %s $currency\n    description: "%s"\n},
+			rb2bc($leg->{account}),
+			($leg->{dir} eq 'GAIN' ? +1 : -1) * RevBank::Amount->parse_string($leg->{amount}),
+			$leg->{desc} =~ s/\"/\\\"/gr
+		);
+	}
+	print "\n";
+}
+
+# TODO: read revbank.accounts and "open" beancount accounts for all accounts
+# that didn't have any transactions.

lib/RevBank.pod

@@ -0,0 +1,81 @@
+=head1 NAME
+
+RevBank - Pre-paid bar tab for hackerspaces
+
+=head1 DESCRIPTION
+
+=head2 High-level architecture
+
+Since version 2, RevBank is loosely modeled after C<qpsmtpd>, which is an SMTP server in which the core speaks the SMTP protocol, but doesn't do anything with the commands it receives. Actually handling the commands is the responsibility of plugins. Without plugins, the software is useless.
+
+RevBank is interactive and stateful. Global state is provided in the form of a "shopping cart", a L<RevBank::Cart> object, which represents the ongoing, unfinished, transaction. The terms "cart", "unfinished transaction", and "current transaction" generally all refer to the same thing in the context of RevBank.
+
+In addition, RevBank provides the concept of accounts through L<RevBank::Users>. There are user accounts and internal accounts; internal accounts are used as contra accounts for I<double-entry bookkeeping>, and are hidden from the user interface. Accounts only have a name, a balance, and some timestamps; things like transaction histories are provided by plugins.
+
+Notably, the RevBank core does B<not> have any notion of "products". Support for buying products through RevBank is provided by plugins, like the included C<products> and C<market> plugins. It is easy to add another source of products by writing another plugin. A plugin contains arbitrary code and can do anything, including querying external resources.
+
+=head2 Data files
+
+All files are simple text files, generally whitespace and newline separated. While this isn't particularly "cool", there are many tools that work with them, like C<diff> and C<git> and C<vim>. That means a lot of functionality (such as editing a product list) doesn't require any specialized user interfaces. It also makes creating backups trivial.
+
+RevBank uses a single lock file, so you can safely use multiple processes. It doesn't keep any files open, making it safe to just kill C<revbank> at any moment (only the current transaction will be lost) or to edit some files with an external editor (not the files that RevBank writes to, though).
+
+RevBank does currently not behave well with non-ASCII data.
+
+=head2 The input loop
+
+RevBank is a user-interactive CLI, intended for use with a keyboard and a barcode scanner. The barcode scanner is configured as a virtual keyboard device; RevBank doesn't care if the input is given with the barcode scanner or the keyboard, and it is considered a feature that everything that can be typed, can be turned into a scannable barcode, and that any barcode data can be typed instead of scanned.
+
+Most barcode scanners virtually press the I<Enter> key after each scan, and RevBank is made with this in mind: any command parameters are typically presented as follow-up prompts.
+
+For advanced users, a more shell-like interface is provided: a command and its arguments can be given on a single line, separated by spaces. On the top-level prompt (i.e. not in follow-up prompts), the input is whitespace separated, and each of the terms is added to a stack, from which subsequent prompts are fed. At that level, terms can be quoted with C<'single'> or C<"double"> quotes, and C<\> escapes the subsequent character. As long as there are words on the stack, the printing of further prompts is suppressed.
+
+Multiple commands on a single line can be separated with C<;>. This is required after a command that finalizes a transaction (like a bare username after adding products), or between a command that takes arguments and a command that follows it.
+
+There is no syntax for indicating the end of a command in the simple mode. Every command has either a fixed number of arguments (follow-up questions), or its own specialized way to indicate the end of a variable length list.
+
+Similarly, the end of the "list of products" is not indicated by syntax, but by entering a username. Or, more technically correct: every product id is a command, and so is every username. The product id command adds an entry to the cart, the username command finalizes the transaction and empties the cart.
+
+=head3 abort
+
+The string C<abort> is hard-coded and will always abort the current transaction (i.e. reset the global state (cart)). This is intentional as users always need a "way out", and C<abort> is unlikely to be a valid response to any prompt anyway. (The "advanced" input method lets you quote it, like C<"abort">, although that is probably only useful for a print-a-barcode plugin...)
+
+=head2 Plugins
+
+All user input, except C<abort>, is handled by plugins. Without plugins, C<abort> is the only input that does something, and even then, it's just emptying an already empty shopping cart.
+
+Information about writing plugins is provided in L<RevBank::Plugins>.
+
+Commands and hooks can manipulate the cart to delete, add, or modify its entries.
+
+=head3 Commands
+
+For every command given on the top-level prompt of the input loop, the C<command> method of every plugin is queried until a plugin returns C<ACCEPT>, C<REJECT>, or C<ABORT>. All other plugins return C<NEXT> to indicate that the remaining plugins should be tried. A plugin can, however, do something with the input, and still return C<NEXT>. It can even manipulate the input before passing it on to the next plugin.
+
+Plugins are always used in the order specified in the configuration file C<revbank.plugins>, and the order in which they are defined is vital to a correctly functioning RevBank instance. Some, but not all, plugins will detect if other plugins they depend on, are loaded. In general, though, it is up to the administrator to carefully maintain the C<revbank.plugins> list.
+
+There can be overlap between plugins; C<cola> might be a valid product and also a valid username, in which case the user is out of luck if the C<products> plugin is specified before the C<users> plugin: they will not be able to complete a transaction. In practice, this does not present much of a problem, because product ids are typically numerical barcodes. It does happen, however, that there's a clash between a command and a username. A user with a nickname that is exactly equal to a command like C<help> or C<undo> is SOL unless the C<users> plugin is specified early in the list; this is not recommended, because it means that using C<adduser>, anyone can easily cause denial of service.
+
+Commands can request arguments by returning a reference to a function. This is then handled by the main input loop, which will either use words on its stack, or prompt for further input.
+
+There is no way for a command to declare its number of arguments (follow-up questions), which means that it is not possible to interpret RevBank input without executing it. This also means that it is not safe to replay the log file in a different version or configuration (e.g. in lieu of restoring a backup).
+
+=head3 Hooks
+
+All kinds of things in RevBank will "call hooks", which is a fancy way of saying they'll try to call a certain method, for each and every plugin. With commands, the intention is that one plugin will be "the one" to handle the command, but with hooks, I<every> plugin's hook method is called. The only way around that is returning ABORT, which will kill the entire unfinished transaction.
+
+=head1 SECURITY
+
+RevBank is insecure by design. It does not ship with any authentication or authorization mechanism, nor was it designed with such things in mind.
+
+The concept of unsupervised 100% self-service access to a fully stocked refrigerator is in itself insecure. It probably does not scale well to a huge number of people, but it's proven to serve small communities well. It's primarily based on trust, or what's sometimes referred to as the "honor system".
+
+It may be possible to implement some semblance of security with a plugin (and by disabling plugins like C<take>), but that still wouldn't keep anyone from stealing drinks from the fridge. If you can't trust your users, RevBank is probably not the right tool for the job. And if you are in these unfortunate circumstances, you should really reconsider that unsupervised access to the fridge.
+
+This said, RevBank does come with a C<log> plugin, which enables external auditing of its use. With every balance change, the old and new balances are recorded. The log file is also very useful to investigate user mistakes.
+
+Hardware can fail, software can fail, and users can fail. Make backups. Make lots of backups. Maybe once an hour, or even after every transaction. Don't just synchronize, but keep the old versions too.
+
+=head1 AUTHOR
+
+Juerd Waalboer

lib/RevBank/Amount.pm

@@ -1,7 +1,10 @@
 package RevBank::Amount;
-use v5.28;
+
+use v5.32;
 use warnings;
-use experimental qw(signatures);
+use experimental 'isa';         # stable since v5.36
+use experimental 'signatures';  # stable since v5.36
+
 use Carp qw(carp croak);
 use Scalar::Util;
 use POSIX qw(lround);
@@ -10,7 +13,7 @@ our $C = __PACKAGE__;
 
 sub _coerce {
     for (@_) {
-        unless (ref and UNIVERSAL::isa($_, $C)) {
+        unless ($_ isa $C) {
             croak "Unsupported operation on $C with " . ref if ref;
             croak "Unsupported operation on $C with undef" if not defined;
 
@@ -72,12 +75,14 @@ sub new_from_float($class, $num) {
 }
 
 sub parse_string($class, $str) {
-    $str =~ /\S/ or return undef;
+    defined $str and $str =~ /\S/ or return undef;
 
     my ($neg, $int, $cents)
         = $str =~ /^\s*(?:\+|(-)?)([0-9]+)?(?:[,.]([0-9]{1,2}))?\s*$/
         or return undef;
 
+    defined $int or defined $cents or return undef;
+
     $int //= 0;
     $cents //= 0;
     $cents *= 10 if length($cents) == 1;  # 4.2 -> 4.20
@@ -113,7 +118,7 @@ sub string_flipped($self, $sep = " ") {
     return sprintf(
         "%s%s%d.%02d",
         $$self > 0 ? "+" : "",
-        $sep,
+        $$self > 0 ? $sep : "",
         abs($$self) / 100,
         abs($$self) % 100,
     );

lib/RevBank/Amount.pod

@@ -4,6 +4,8 @@ RevBank::Amount - Fixed point 2-decimal numeric values that DWYM
 
 =head1 SYNOPSIS
 
+	$amount = parse_amount("1.23");  # in plugins, best to use this
+
     $amount = RevBank::Amount->new(30);               # 0.30
     $amount = RevBank::Amount->parse_string("0.30");  # 0.30
 
@@ -51,6 +53,16 @@ do that), strange things can happen. Also, "-0.00" is annoying...
 Note: this class does not play nice with other classes that use operator
 overloading.
 
+=head2 Functions
+
+=head3 parse_amount
+
+Provided by RevBank::Global, and available in plugins. Unlike the
+method C<< RevBank::Amount->parse_string >>, the function C<parse_amount> will
+not allow negative numbers, which is typically a good idea to maintain sanity.
+When writing plugins, you should strongly consider providing two different
+commands instead of allowing negative numbers.
+
 =head2 Constructors
 
 =head3 new
@@ -99,6 +111,6 @@ $amount + 1.001 >> won't work because 0.001 has too many digits after
 the decimal point.
 
 When working with values that aren't safe, hard-coded literals, always
-turn them into RevBank::Amount objects first, which takes care of te
+turn them into RevBank::Amount objects first, which takes care of the
 necessary rounding: C<< $amount + RevBank::Amount->new_from_float(1.001)
 >>.

lib/RevBank/Cart.pm

@@ -1,50 +1,59 @@
 package RevBank::Cart;
-use strict;
+
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+
 use Carp ();
 use List::Util ();
 use RevBank::Global;
+use RevBank::Users;
+use RevBank::FileIO;
 use RevBank::Cart::Entry;
 
-sub new {
-    my ($class) = @_;
+{
+    package RevBank::Cart::CheckoutProhibited;
+    sub new($class, $reason) { return bless \$reason, $class; }
+    sub reason($self) { return $$self; }
+}
+
+sub new($class) {
     return bless { entries => [] }, $class;
 }
 
-sub add_entry {
-    my ($self, $entry) = @_;
-
-    $self->_call_old_hooks("add", $entry);
+sub add_entry($self, $entry) {
     RevBank::Plugins::call_hooks("add_entry", $self, $entry);
 
     push @{ $self->{entries} }, $entry;
     $self->{changed}++;
-    $self->_call_old_hooks("added", $entry);
+    $self->select($entry);
+
     RevBank::Plugins::call_hooks("added_entry", $self, $entry);
 
     return $entry;
 }
 
-sub add {
-    # Deprecated interface: ->add($user, ...)
-    if (defined $_[3] and not ref $_[3]) {
-        return shift->old_add(@_);
-    }
+sub add($self, $amount, $description, $data = {}) {
+    ref $data or Carp::croak "Non-hash data argument";
 
-    # ->add($entry)
-    if (@_ == 2) {
-        my ($self, $entry) = @_;
-        return $self->add_entry($entry);
-    }
-
-    # ->add($amount, ...)
-    my ($self, $amount, $description, $data) = @_;
     return $self->add_entry(RevBank::Cart::Entry->new($amount, $description, $data));
 }
 
-sub delete {
-    Carp::croak("\$cart->delete(\$user, \$index) is no longer supported") if @_ > 2;
+sub select($self, $entry) {
+    return $self->{selected_entry} = $entry;
+}
 
-    my ($self, $entry) = @_;
+sub selected($self) {
+    return undef if not @{ $self->{entries} };
+
+    for my $entry (@{ $self->{entries} }) {
+        return $entry if $entry == $self->{selected_entry};
+    }
+
+    return $self->select( $self->{entries}->[-1] );
+}
+
+sub delete($self, $entry) {
     my $entries = $self->{entries};
 
     my $oldnum = @$entries;
@@ -54,152 +63,125 @@ sub delete {
     return $oldnum - @$entries;
 }
 
-sub empty {
-    my ($self) = @_;
-
+sub empty($self) {
     $self->{entries} = [];
     $self->{changed}++;
 }
 
-sub display {
-    my ($self, $prefix) = @_;
-    $prefix //= "";
+sub display($self, $prefix = "") {
     say "$prefix$_" for map $_->as_printable, @{ $self->{entries} };
 }
 
-sub size {
-    my ($self) = @_;
+sub size($self) {
     return scalar @{ $self->{entries} };
 }
 
-sub checkout {
-    my ($self, $user) = @_;
-
-    if ($self->entries('refuse_checkout')) {
-        warn "Refusing to finalize deficient transaction.\n";
-        $self->display;
-        return;
+sub prohibit_checkout($self, $bool, $reason) {
+    if ($bool) {
+        $self->{prohibited} = $reason;
+    } else {
+        delete $self->{prohibited};
     }
+}
 
-    my $entries = $self->{entries};
+sub deltas($self, $user) {
+    my %deltas = ($user => RevBank::Amount->new(0));
 
-    my %deltas;
-    for my $entry (@$entries) {
-        $entry->user($user);
-
-        $deltas{$entry->{user}} //= RevBank::Amount->new(0);
+    for my $entry (@{ $self->{entries} }) {
         $deltas{$_->{user}} += $_->{amount} * $entry->quantity
             for $entry, $entry->contras;
     }
 
-    my $transaction_id = time() - 1300000000;
-    RevBank::Plugins::call_hooks("checkout", $self, $user, $transaction_id);
-
-    for my $account (keys %deltas) {
-        RevBank::Users::update($account, $deltas{$account}, $transaction_id)
-            if $deltas{$account} != 0;
-    }
-
-    RevBank::Plugins::call_hooks("checkout_done", $self, $user, $transaction_id);
-
-    $self->empty;
-
-    sleep 1;  # Ensure new timestamp/id for new transaction
-    return 1;
+    return \%deltas;
 }
 
-sub entries {
-    my ($self, $attribute) = @_;
 
+sub checkout($self, $user) {
+    if ($self->{prohibited}) {
+        die RevBank::Cart::CheckoutProhibited->new(
+            "Cannot complete transaction: $self->{prohibited}"
+        );
+    }
+
+    if ($self->entries('refuse_checkout')) {
+        $self->display;
+        die "Refusing to finalize deficient transaction";
+    }
+
+    $user = RevBank::Users::assert_user($user);
+
+    my $entries = $self->{entries};
+
+    for my $entry (@$entries) {
+        $entry->sanity_check;
+        $entry->user($user);
+    }
+
+    RevBank::FileIO::with_lock {
+        my $fn = ".revbank.nextid";
+        my $transaction_id = eval { RevBank::FileIO::slurp($fn) };
+        my $legacy_id = 0;
+
+        if (defined $transaction_id) {
+            chomp $transaction_id;
+            if ($transaction_id eq "LEGACY") {
+                $legacy_id = 1;
+                $transaction_id = time() - 1300000000;;
+            }
+        } else {
+            warn "Could not read $fn; using timestamp as first transaction ID.\n";
+            $transaction_id = time() - 1300000000;
+        }
+
+        RevBank::Plugins::call_hooks("checkout_prepare", $self, $user, $transaction_id)
+            or die "Refusing to finalize after failed checkout_prepare";
+
+        for my $entry (@$entries) {
+            $entry->sanity_check;
+            $entry->user($user) if not $entry->user;
+        }
+
+        RevBank::FileIO::spurt($fn, ++(my $next_id = $transaction_id)) unless $legacy_id;
+
+        RevBank::Plugins::call_hooks("checkout", $self, $user, $transaction_id);
+
+        my $deltas = $self->deltas($user);
+
+        for my $account (reverse sort keys %$deltas) {
+            # The reverse sort is a lazy way to make the "-" accounts come last,
+            # which looks nicer with the "cash" plugin.
+            RevBank::Users::update($account, $deltas->{$account}, $transaction_id)
+                if $deltas->{$account} != 0;
+        }
+
+        RevBank::Plugins::call_hooks("checkout_done", $self, $user, $transaction_id);
+
+        sleep 1;  # look busy
+
+        $self->empty;
+    };
+}
+
+sub entries($self, $attribute = undef) {
     my @entries = @{ $self->{entries} };
     return grep $_->has_attribute($attribute), @entries if defined $attribute;
     return @entries;
 }
 
-sub changed {
-    my ($self) = @_;
-
+sub changed($self, $keep = 0) {
     my $changed = 0;
     for my $entry ($self->entries('changed')) {
-        $entry->attribute('changed', undef);
+        $entry->attribute('changed', undef) unless $keep;
         $changed = 1;
     }
-    $changed = 1 if delete $self->{changed};
+    $changed = 1 if $self->{changed};
+    delete $self->{changed} unless $keep;
+
     return $changed;
 }
 
-sub sum {
-    my ($self) = @_;
+sub sum($self) {
     return List::Util::sum(map $_->{amount} * $_->quantity, @{ $self->{entries} });
 }
 
-
-### Old stuff, to be deleted in a future version:
-
-sub _call_old_hooks {
-    my ($self, $hook, $entry) = @_;
-
-    my $data = $entry->{attributes};
-
-    for (1 .. $entry->quantity) {
-        for ($entry, $entry->contras) {
-            my $item = {
-                %$data,
-                amount => $_->{amount},
-                description => $_->{description},
-            };
-
-            RevBank::Plugins::call_hooks($hook, $self, $_->{user}, $item);
-        }
-    }
-}
-
-sub as_strings {
-    my ($self) = @_;
-    Carp::carp("Plugin uses deprecated \$cart->as_strings");
-
-    return map $_->as_loggable, @{ $self->{entries} };
-}
-
-sub is_multi_user {
-    Carp::carp("\$cart->is_multi_user is no longer supported, ignoring");
-}
-
-sub select_items {
-    my ($self, $key) = @_;
-    Carp::carp("Plugin uses deprecated \$cart->select_items");
-
-    my @matches;
-    for my $entry (@{ $self->{entries} }) {
-        my %attributes = %{ $entry->{attributes} };
-        for (1 .. $entry->quantity) {
-            for my $item ($entry, $entry->contras) {
-                push @matches, { %attributes, %$item }
-                    if @_ == 1  # No key or match given: match everything
-                    or @_ == 2 and $entry->has_attribute($key)   # Just a key
-            }
-        }
-    }
-
-    return @matches;
-}
-
-sub old_add {
-    my ($self, $user, $amount, $description, $data) = @_;
-
-    Carp::carp("Plugin uses deprecated old-style call to \$cart->add");
-
-    $data->{COMPATIBILITY} = 1;
-
-    my $entry = RevBank::Cart::Entry->new(
-        defined $user ? 0 : $amount,
-        $description,
-        $data
-    );
-    $entry->add_contra($user, $amount, $description) if defined $user;
-    $entry->{FORCE} = 1;
-
-    return $self->add_entry($entry);
-}
-
 1;

lib/RevBank/Cart/Entry.pm

@@ -1,16 +1,22 @@
-use strict;
-
 package RevBank::Cart::Entry;
 
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+
 use Carp qw(carp croak);
+use RevBank::Users;
 use List::Util ();
+use Scalar::Util ();
 
-sub new {
-    my ($class, $amount, $description, $attributes) = @_;
-
-    @_ >= 3 or croak "Not enough arguments for RevBank::Cart::Entry->new";
-    $attributes //= {};
+# Workaround for @_ in signatured subs being experimental and controversial
+my $NONE = \do { my $dummy };
+sub _arg_provided($a) {
+    return 1 if not ref $a;
+    return Scalar::Util::refaddr($a) != Scalar::Util::refaddr($NONE) 
+}
 
+sub new($class, $amount, $description, $attributes = {}) {
     $amount = RevBank::Amount->parse_string($amount) if not ref $amount;
 
     my $self = {
@@ -20,104 +26,146 @@ sub new {
         attributes  => { %$attributes },
         user        => undef,
         contras     => [],
-        caller      => (caller 1)[3],
+        caller      => List::Util::first(sub { !/^RevBank::Cart/ }, map { (caller $_)[3] } 1..10)
+                       || (caller 1)[3],
+        highlight   => 1,
     };
 
     return bless $self, $class;
 }
 
-sub add_contra {
-    my ($self, $user, $amount, $description) = @_;
+sub add_contra($self, $user, $amount, $description, $display = undef) {
+    # $display should be given for either ALL or NONE of the contras,
+    # with the exception of contras with $amount == 0.00;
 
     $amount = RevBank::Amount->parse_string($amount) if not ref $amount;
+    $user = RevBank::Users::assert_user($user);
 
     $description =~ s/\$you/$self->{user}/g if defined $self->{user};
 
     push @{ $self->{contras} }, {
         user        => $user,
         amount      => $amount,  # should usually have opposite sign (+/-)
-        description => $description,
+        description => $description,  # contra user's perspective
+        display     => $display,  # interactive user's perspective
+        highlight   => 1,
     };
 
     $self->attribute('changed', 1);
+
+    return $self;  # for method chaining
 }
 
-sub has_attribute {
-    my ($self, $key) = @_;
-
+sub has_attribute($self, $key) {
     return (
         exists      $self->{attributes}->{$key}
         and defined $self->{attributes}->{$key}
     );
 }
 
-sub attribute {
-    my ($self, $key, $new) = @_;
-
+sub attribute($self, $key, $new = $NONE) {
     my $ref = \$self->{attributes}->{$key};
-    $$ref = $new if @_ > 2;
+    $$ref = $new if _arg_provided($new);
     return $$ref;
 }
 
-sub quantity {
-    my ($self, $new) = @_;
+sub amount($self, $new = undef) {
+    my $ref = \$self->{amount};
+    if (defined $new) {
+        $new = RevBank::Amount->parse_string($new) if not ref $new;
+        $$ref = $new;
+        $self->attribute('changed', 1);
+        $self->{highlight_amount} = 1;
+    }
 
+    return $$ref;
+}
+
+sub quantity($self, $new = undef) {
     my $ref = \$self->{quantity};
     if (defined $new) {
         $new >= 0 or croak "Quantity must be positive";
         $$ref = $new;
         $self->attribute('changed', 1);
+        $self->{highlight_quantity} = 1;
     }
 
     return $$ref;
 }
 
-sub multiplied {
-    my ($self) = @_;
-
+sub multiplied($self) {
     return $self->{quantity} != 1;
 }
 
-sub contras {
-    my ($self) = @_;
-
+sub contras($self) {
     # Shallow copy suffices for now, because there is no depth.
     return map +{ %$_ }, @{ $self->{contras} };
 }
 
-sub as_printable {
-    my ($self) = @_;
+sub delete_contras($self) {
+    $self->{contras} = [];
+}
 
-    $self->sanity_check;
+my $HI = "\e[37;1m";
+my $LO = "\e[2m";
+my $END = "\e[0m";
 
+sub as_printable($self) {
     my @s;
-    push @s, $self->{quantity} . "x {" if $self->multiplied;
 
     # Normally, the implied sign is "+", and an "-" is only added for negative
     # numbers. Here, the implied sign is "-", and a "+" is only added for
     # positive numbers.
-    push @s, sprintf "  %6s %s", $self->{amount}->string_flipped, $self->{description};
+    my $q = $self->{quantity};
+    push @s, sprintf "%s%-4s%s" . "%s%8s%s" . " " . "%s%s%s", 
+        ($self->{highlight} || $self->{highlight_quantity} ? $HI : $LO),
+        ($q > 1 || $self->{highlight_quantity} ? "${q}x" : ""),
+        ($self->{highlight} ? "" : $END),
 
-    for my $c ($self->contras) {
+        ($self->{highlight} || $self->{highlight_amount} ? $HI : $LO),
+        $self->{amount}->string_flipped,
+        ($self->{highlight} ? "" : $END),
+
+        ($self->{highlight} ? $HI : $LO),
+        $self->{description},
+        $END;
+
+    for my $c (@{ $self->{contras} }) {
+        my $description;
+        my $amount = $self->{amount};
+        my $hidden = RevBank::Users::is_hidden($c->{user});
+        my $fromto = $c->{amount}->cents < 0 ? "<-" : "->";
+        $fromto .= " $c->{user}";
+
+        if ($c->{display}) {
+            $description =
+                $hidden
+                ? ($ENV{REVBANK_DEBUG} ? "($fromto:) $c->{display}" : $c->{display})
+                : "$fromto: $c->{display}";
+
+            $amount *= -1;
+        } elsif ($hidden) {
+            next unless $ENV{REVBANK_DEBUG};
+            $description = "($fromto: $c->{description})";
+        } else {
+            $description = $fromto;
+        }
         push @s, sprintf(
-            "  %9s %s %s",
-            $c->{amount}->abs->string,
-            ($c->{amount}->cents > 0 ? "->" : "<-"),
-            $c->{user}
+            "%s%15s %s%s",
+            ($self->{highlight} || $c->{highlight} ? $HI : $LO),
+            ($self->{amount} > 0 ? $c->{amount}->string_flipped("") : $c->{amount}->string),
+            $description,
+            $END,
         );
-
+        delete $c->{highlight};
     }
-
-    push @s, "}" if $self->multiplied;
+    delete $self->@{qw(highlight highlight_quantity highlight_amount)};
 
     return @s;
 }
 
-sub as_loggable {
-    my ($self) = @_;
-
+sub as_loggable($self) {
     croak "Loggable called before set_user" if not defined $self->{user};
-    $self->sanity_check;
 
     my $quantity = $self->{quantity};
 
@@ -128,14 +176,14 @@ sub as_loggable {
         my $description =
             $quantity == 1
             ? $_->{description}
-            : sprintf("%s [%sx %s]", $_->{description}, $quantity, abs($_->{amount}));
+            : sprintf("%s [%sx %s]", $_->{description}, $quantity, $_->{amount}->abs);
 
         push @s, sprintf(
-            "%-12s %4s %3d %5s  # %s",
+            "%-12s %4s %3d %6s  # %s",
             $_->{user},
-            ($total > 0 ? 'GAIN' : $total < 0 ? 'LOSE' : ''),
+            ($total->cents > 0 ? 'GAIN' : $total->cents < 0 ? 'LOSE' : '===='),
             $quantity,
-            abs($total),
+            $total->abs,
             $description
         );
     }
@@ -143,9 +191,7 @@ sub as_loggable {
     return @s;
 }
 
-sub user {
-    my ($self, $new) = @_;
-
+sub user($self, $new = undef) {
     if (defined $new) {
         croak "User can only be set once" if defined $self->{user};
 
@@ -156,31 +202,29 @@ sub user {
     return $self->{user};
 }
 
-sub sanity_check {
-    my ($self) = @_;
+sub sanity_check($self) {
+    my @contras = $self->contras;
 
-    # Turnover and journals are implicit contras, so (for now) a zero sum is
-    # not required. However, in a transaction with contras, one should at least
-    # not try to issue money that does not exist.
+    my $sum = RevBank::Amount->new(
+        List::Util::sum(map $_->{amount}->cents, $self, @contras)
+    );
 
-    return 1 if $self->{FORCE};
-    my @contras = $self->contras or return 1;
-
-    my $sum = List::Util::sum(map $_->{amount}->cents, $self, @contras);
-
-    if ($sum > 0) {
-        $self->{FORCE} = 1;
-        croak join("\n",
+    if ($sum != 0) {
+        local $ENV{REVBANK_DEBUG} = 1;
+        my $message = join("\n",
             "BUG! (probably in $self->{caller})",
-            "This adds up to creating money that does not exist:",
+            "Unbalanced transactions are not possible in double-entry bookkeeping.",
             $self->as_printable,
             (
-                $sum == 2 * $self->{amount}->cents
-                ? "Hint: contras for positive value should be negative values."
+                !@contras
+                ? "Use \$entry->add_contra to balance the transaction."
+                : abs($sum) == 2 * abs($self->{amount})
+                ? "Contras for positive value should be negative values and vice versa."
                 : ()
             ),
-            sprintf("Cowardly refusing to create $sum out of thin air")
         );
+        RevBank::Plugins::call_hooks("log_error", "UNBALANCED ENTRY $message");
+        croak $message;
     }
 
     return 1;

lib/RevBank/FileIO.pm

@@ -0,0 +1,122 @@
+package RevBank::FileIO;
+
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+
+use autodie;
+use Fcntl qw(:flock);
+use Carp qw(croak);
+use Time::HiRes qw(sleep);
+
+my $tempfn = ".revbank.$$";
+my $lockfn = ".revbank.global-lock";
+my $lockfh;
+my $lockcount = 0;
+
+sub get_lock() {
+	if (defined $lockfh) {
+		die "Fatal inconsistency" if $lockcount < 1;
+		return ++$lockcount;
+	}
+	die "Fatal inconsistency" if $lockcount;
+
+	open $lockfh, ">", $lockfn;
+	my $attempt = 1;
+
+	my $debug = !!$ENV{REVBANK_DEBUG};
+	FLOCK: {
+		if (flock $lockfh, LOCK_EX | LOCK_NB) {
+			syswrite $lockfh, $$;
+			return ++$lockcount;
+		}
+
+		if (($attempt % 50) == 0 or $debug) {
+			warn "Another revbank instance has the global lock. Waiting for it to finish...\n"
+		}
+		sleep .1;
+
+		$attempt++;
+		redo FLOCK;
+	}
+
+
+	croak "Could not acquire lock on $lockfn; file access failed";
+}
+
+sub release_lock() {
+	if (not defined $lockfh) {
+		die "Fatal inconsistency" if $lockcount;
+		return;
+	}
+	die "Fatal inconsistency" if $lockcount < 1;
+
+	if (--$lockcount == 0) {
+		flock $lockfh, LOCK_UN;
+		close $lockfh;
+
+		undef $lockfh;
+	}
+}
+
+sub release_all_locks() {
+	release_lock while $lockcount;
+}
+
+sub with_lock :prototype(&) ($code) {
+	my $skip = $ENV{REVBANK_SKIP_LOCK};
+	get_lock unless $skip;
+	my @rv;
+	my $rv;
+	my $list_context = wantarray;
+	eval {
+		@rv = $code->() if $list_context;
+		$rv = $code->() if not $list_context;
+	};
+	release_lock unless $skip;
+	croak $@ =~ s/\.?\n$/, rethrown/r if $@;
+	return @rv if $list_context;
+	return $rv if not $list_context;
+}
+
+sub slurp($fn) {
+	return with_lock {
+		local $/ = wantarray ? "\n" : undef;
+		open my $fh, "<", $fn;
+		return readline $fh;
+	}
+}
+
+sub spurt($fn, @data) {
+	return with_lock {
+		open my $out, ">", $tempfn;
+		print $out @data;
+		close $out;
+		rename $tempfn, $fn;
+	};
+}
+
+sub append($fn, @data) {
+	return with_lock {
+		open my $out, ">>", $fn;
+		print $out @data;
+		close $out;
+	};
+}
+
+sub rewrite($fn, $sub) {
+	return with_lock {
+		open my $in, "<", $fn;
+		open my $out, ">", $tempfn;
+		while (defined(my $line = readline $in)) {
+			local $_ = $line;
+			my $new = $sub->($line);
+			print $out $new if defined $new;
+		}
+		close $out;
+		close $in;
+		rename $tempfn, $fn;
+	};
+}
+
+1;

lib/RevBank/FileIO.pod

@@ -0,0 +1,96 @@
+=head1 NAME
+
+RevBank::FileIO - Line-based text file manipulation with advisory locking
+
+=head1 SYNOPSIS
+
+	with_lock {
+		...
+	};
+
+	my $data  = slurp $filename;
+	my @lines = slurp $filename;
+	spurt $filename, @data;
+	append $filename, @data;
+
+	rewrite $filename, sub($line) {
+		return $line;  # return changed or unchanged line
+		return undef;  # exclude line from file
+	};
+
+=head1 DESCRIPTION
+
+This package implements very simple locking to protect against filesystem
+based race conditions when running multiple instances of revbank on the same
+data files.
+
+These race conditions are probably exceptionally rare and very hard to trigger
+in real-world conditions, because file system access is very fast due to
+caching and buffering by the kernel. RevBank was used for over a decade without
+any known problem due such a race condition, before locking was finally
+added.
+
+No attempt was made to optimize for performance, and all locks are global and
+exclusive.
+
+Will wait for the global lock for as long as it takes, printing a message every
+few seconds to keep the user informed.
+
+=head2 Functions
+
+=head3 with_lock BLOCK
+
+Gets the lock, executes the block, releases the lock again. Returns whatever
+the block returned.
+
+Use this instead of C<get_lock> to prevent forgetting to release the lock.
+
+=head3 get_lock
+
+Acquires the lock if it is not already held. Keeps extra virtual locks (by
+virtue of a simple counter) if the global lock is already held by the current
+process.
+
+Calling this function directly is discouraged. Use C<with_lock> instead.
+
+=head3 release_lock
+
+Decreases the number of virtual locks, releasing the real lock if none are
+left.
+
+Calling this function directly is discouraged. Use C<with_lock> instead.
+
+=head1 slurp($filename)
+
+Returns the entire contents of the file. In list context, returns a list of
+lines (including the line ending).
+
+=head1 spurt($filename, @data)
+
+=head1 append($filename, @data)
+
+Writes to a file. No separators or delimiters are added to the provided data,
+so in general you will want to pass either the entire contents as a single
+string, or a list of lines that already have line endings.
+
+=head1 rewrite($filename, sub($line) { ...; return $line; })
+
+Rewrites the existing text file. The provided subroutine is called for each
+line, and must return everything that should be written back. The sub can
+return undef to essentially skip (remove) a line.
+
+=head2 CAVEATS
+
+=over 2
+
+=item * A lock file is used, so external processes should not depend on the
+individual files being flocked.
+
+=item * Using a text editor while revbank is running and changing files will
+still mess things up.
+
+=item * The locking mechanism provides a lock per process; different parts
+(e.g. plugins) of the same process can still simultaneously do things, so keep
+to the pattern of always closing files before returning control or forking.
+
+=back

lib/RevBank/Global.pm

@@ -1,30 +1,67 @@
 package RevBank::Global;
-use strict;
+
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+
 use POSIX qw(strftime);
 use RevBank::Amount;
+use RevBank::FileIO;
+
+{
+    package RevBank::Exception::RejectInput;
+    sub new($class, $reason) { return bless \$reason, $class; }
+    sub reason($self) { return $$self; }
+}
 
 sub import {
     require RevBank::Plugins;
     require RevBank::Users;
     no strict 'refs';
     my $caller = caller;
-    *{"$caller\::ACCEPT"} = sub () { \1 };
-    *{"$caller\::ABORT"}  = sub () { \2 };
-    *{"$caller\::REJECT"} = sub () { \3 };
-    *{"$caller\::NEXT"}   = sub () { \4 };
-    *{"$caller\::DONE"}   = sub () { \5 };
-    *{"$caller\::parse_user"} = \&RevBank::Users::parse_user;
-    *{"$caller\::parse_amount"} = sub {
-        my ($amount) = @_;
+    *{"$caller\::ACCEPT"}       = sub () { \1 };
+    *{"$caller\::ABORT"}        = sub () { \2 };
+    *{"$caller\::REJECT"}       = sub () { \3 };
+    *{"$caller\::NEXT"}         = sub () { \4 };
+    *{"$caller\::DONE"}         = sub () { \5 };
+    *{"$caller\::REDO"}         = sub () { \6 };
+    *{"$caller\::slurp"}        = \&RevBank::FileIO::slurp;
+    *{"$caller\::spurt"}        = \&RevBank::FileIO::spurt;
+    *{"$caller\::rewrite"}      = \&RevBank::FileIO::rewrite;
+    *{"$caller\::append"}       = \&RevBank::FileIO::append;
+    *{"$caller\::with_lock"}    = \&RevBank::FileIO::with_lock;
+    *{"$caller\::parse_user"}   = \&RevBank::Users::parse_user;
+    *{"$caller\::parse_amount"} = sub ($amount) {
         defined $amount or return undef;
         length  $amount or return undef;
 
-        $amount = RevBank::Amount->parse_string($amount) // return undef;
+        my @split = grep /\S/, split /([+-])/, $amount;
+
+        my $posneg = 1;
+        $amount = RevBank::Amount->new(0);
+        for my $token (@split) {
+            if ($token eq '-') {
+                $posneg = $posneg == -1 ? 1 : -1;
+            } elsif ($token eq '+') {
+                $posneg ||= 1;
+            } else {
+                $posneg or return undef;  # two terms in a row
+                my $term = RevBank::Amount->parse_string($token) // return undef;
+                $amount += $posneg * $term;
+                $posneg = 0;
+            }
+        }
+        $posneg and return undef;  # last token must be term
+
         if ($amount->cents < 0) {
-            die "For our sanity, no negative amounts, please :).\n";
+            die RevBank::Exception::RejectInput->new(
+                "For our sanity, no negative amounts, please :)."
+            );
         }
         if ($amount->cents > 99900) {
-            die "That's way too much money, or an unknown barcode.\n";
+            die RevBank::Exception::RejectInput->new(
+                "That's way too much money."
+            );
         }
         return $amount;
     };
@@ -32,57 +69,12 @@ sub import {
     *{"$caller\::say"} = sub {
         print @_, "\n";
     };
-    *{"$caller\::now"} = sub {
+    *{"$caller\::now"} = sub () {
         return strftime '%Y-%m-%d_%H:%M:%S', localtime;
     };
 
 }
 
+__PACKAGE__->import;
+
 1;
-__END__
-
-=head1 NAME
-
-RevBank::Global - Constants and utility functions
-
-=head1 SYNOPSIS
-
-    use RevBank::Global;
-
-=head1 DESCRIPTION
-
-This module unconditionally exports the following symbols into the calling
-namespace:
-
-=head2 ACCEPT, ABORT, REJECT, NEXT, DONE
-
-Return codes for plugins. See L<RevBank::Plugins>.
-
-=head2 say
-
-Print with newline, in case your Perl version doesn't already have a C<say>.
-
-=head2 call_hooks($hook, @arguments)
-
-See C<call_hooks> in L<RevBank::Plugins>.
-
-=head2 parse_amount($amount)
-
-Returns the amount given if it is well formed, undef if it was not. Dies if
-the given amount exceeds certain boundaries.
-
-Commas are changed to periods so C<3,50> and C<3.50> both result in C<3.5>.
-
-=head2 parse_user($username)
-
-See C<parse_user> in L<RevBank::Users>.
-
-Returns the canonical username, or undef if the account does not exist.
-
-=head1 AUTHOR
-
-Juerd Waalboer <#####@juerd.nl>
-
-=head1 LICENSE
-
-Pick your favourite OSI license.

lib/RevBank/Global.pod

@@ -0,0 +1,45 @@
+=head1 NAME
+
+RevBank::Global - Constants and utility functions
+
+=head1 SYNOPSIS
+
+    use RevBank::Global;
+
+=head1 DESCRIPTION
+
+This module unconditionally exports the following symbols into the calling
+namespace:
+
+=head2 ACCEPT, ABORT, REJECT, NEXT, DONE
+
+Return codes for plugins. See L<RevBank::Plugins>.
+
+=head2 say
+
+Print with newline, in case your Perl version doesn't already have a C<say>.
+
+=head2 call_hooks($hook, @arguments)
+
+See C<call_hooks> in L<RevBank::Plugins>.
+
+=head2 parse_amount($amount)
+
+Returns the amount given if it is well formed, undef if it was not. Dies if
+the given amount exceeds certain boundaries.
+
+Commas are changed to periods so C<3,50> and C<3.50> both result in C<3.5>.
+
+=head2 parse_user($username)
+
+See C<parse_user> in L<RevBank::Users>.
+
+Returns the canonical username, or undef if the account does not exist.
+
+=head1 AUTHOR
+
+Juerd Waalboer <#####@juerd.nl>
+
+=head1 LICENSE
+
+Pick your favourite OSI license.

lib/RevBank/Messages.pm

@@ -1,4 +1,9 @@
 package RevBank::Messages;
+
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+
 use RevBank::Global;
 use base 'RevBank::Plugin';
 
@@ -7,8 +12,10 @@ use base 'RevBank::Plugin';
 
 BEGIN {
     RevBank::Plugins::register("RevBank::Messages");
+    *hidden = \&RevBank::Users::is_hidden;
 }
 
+
 sub command { return NEXT; }
 sub id { 'built in messages' }
 
@@ -16,52 +23,64 @@ sub hook_startup {
     say "\e[0m\n\n\nWelcome to the RevBank Shell, version $::VERSION\n";
 }
 
-sub hook_plugin_fail {
-    my ($class, $plugin, $error) = @_;
+sub hook_plugin_fail($class, $plugin, $error, @) {
     warn "Plugin '$plugin' failed: $error\n";
 }
 
-sub hook_cart_changed {
-    my ($class, $cart) = @_;
+sub hook_cart_changed($class, $cart, @) {
     $cart->size or return;
     say "Pending:";
     $cart->display;
 
     if (not $cart->entries('refuse_checkout')) {
-        my $sum = $cart->sum;
-        my $what = $sum > 0 ? "add" : "pay";
-        my $abs = $sum->abs;
-        say "Enter username to $what $abs; type 'abort' to abort.";
+        my $sum  = $cart->sum;
+        my $what = $sum->cents > 0 ? "add" : $cart->entries('is_withdrawal') ? "deduct" : "pay";
+        my $dir  = $sum->cents > 0 ? "to" : "from";
+        my $abs  = $sum->abs;
+        say "Enter username to $what $abs $dir your account; type 'abort' to abort.";
     }
 }
 
-sub hook_abort {
-    my ($class, $cart) = @_;
+sub hook_checkout($class, $cart, $user, $transaction_id, @) {
+    if ($cart->changed) {
+        say "Done:";
+        $cart->display;
+    }
+    say "Transaction ID: $transaction_id";
+}
+
+sub hook_abort($class, $cart, @) {
     say "\e[1;4mABORTING TRANSACTION.\e[0m";
 }
 
-sub hook_invalid_input {
-    my ($class, $cart, $word) = @_;
-    say "$word: No such product, user, or command.";
+sub hook_invalid_input($class, $cart, $origword, $lastword, $allwords, @) {
+    say "$origword: No such product, user, or command.";
+    my @other = splice @$allwords, 1;
+    if (@other) {
+        $other[-1] =~ s/^/ and / if @other > 1;
+        say "(Also tried as " . join(@other > 2 ? ", " : "", @other) . ".)";
+    }
 }
 
-sub hook_reject {
-    my ($class, $plugin, $reason, $abort) = @_;
+sub hook_reject($class, $plugin, $reason, $abort, @) {
     say $abort ? $reason : "$reason Enter 'abort' to abort.";
 }
 
-sub hook_user_balance {
-    my ($class, $username, $old, $delta, $new) = @_;
-    my $sign = $delta >= 0 ? '+' : '-';
-    my $rood = $new < 0 ? '31;' : '';
-    my $abs = abs($delta);
-    my $warn = $new < -13.37 ? " \e[5;1m(!!)\e[0m" : "";
+sub hook_user_balance($class, $username, $old, $delta, $new, @) {
+    return if hidden $username and not $ENV{REVBANK_DEBUG};
+
+    my $sign = $delta->cents >= 0 ? '+' : '-';
+    my $rood = $new->cents < 0 ? '31;' : '';
+    my $abs  = $delta->abs;
+    my $warn = $new->cents < -1337 ? " \e[5;1m(!!)\e[0m" : "";
+
     $_ = $_->string("+") for $old, $new;
     printf "New balance for $username: $old $sign $abs = \e[${rood}1m$new\e[0m$warn\n",
 }
 
-sub hook_user_created {
-    my ($class, $username) = @_;
+sub hook_user_created($class, $username, @) {
+    return if hidden $username and not $ENV{REVBANK_DEBUG};
+
     say "New account '$username' created.";
 }
 

lib/RevBank/Plugin.pm

@@ -1,11 +1,56 @@
 package RevBank::Plugin;
-use strict;
 
-sub new {
-    my ($class) = @_;
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+use attributes;
+
+require RevBank::Global;
+
+sub new($class) {
     return bless { }, $class;
 }
 
+sub command($self, $cart, $command, @) {
+    return RevBank::Global::NEXT();
+}
+
+sub Tab($self, $method) {
+    my %completions;
+
+    my $attr = attributes::get(
+        ref $method ? $method : $self->can($method)
+    ) or return;
+
+    my ($tab) = $attr =~ /Tab \( (.*?) \)/x or return;
+    for my $keyword (split /\s*,\s*/, $tab) {
+        if ($keyword =~ /^&(.*)/) {
+            my $method = $1;
+            @completions{ $self->$method } = ();
+        } else {
+            $completions{ $keyword }++;
+        }
+    }
+
+    if (delete $completions{USERS}) {
+        for my $name (RevBank::Users::names()) {
+            next if RevBank::Users::is_hidden($name);
+
+            $completions{ $name }++;
+            $completions{ $1 }++ if $name =~ /^\*(.*)/;
+        }
+    }
+
+    return keys %completions;
+}
+
+sub AllChars($self, $method) {
+    my $attr = attributes::get(
+        ref $method ? $method : $self->can($method)
+    ) or return;
+
+    return !!($attr =~ /AllChars/);
+}
 
 1;
 

lib/RevBank/Plugins.pm

@@ -1,5 +1,9 @@
 package RevBank::Plugins;
-use strict;
+
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+
 use RevBank::Eval;
 use RevBank::Plugin;
 use RevBank::Global;
@@ -8,32 +12,41 @@ our @EXPORT = qw(call_hooks load_plugins);
 
 my @plugins;
 
-sub _read_file {
-    local (@ARGV) = @_;
+sub _read_file($fn) {
+    local @ARGV = ($fn);
     readline *ARGV;
 }
 
 sub call_hooks {
     my $hook = shift;
     my $method = "hook_$hook";
+    my $success = 1;
+
     for my $class (@plugins) {
          if ($class->can($method)) {
-            my ($rv, $message) = $class->$method(@_);
+            my ($rv, @message) = eval { $class->$method(@_) };
 
-            if (defined $rv and ref $rv) {
-                main::abort($message) if $rv == ABORT;
-                warn "$class->$method returned an unsupported value.\n";
+            if ($@) {
+                $success = 0;
+                call_hooks("plugin_fail", $class->id, "$class->$method died: $@");
+            } elsif (defined $rv and ref $rv) {
+                main::abort(@message) if $rv == ABORT;
+
+                $success = 0;
+                call_hooks("plugin_fail", $class->id, "$class->$method returned an unsupported value");
             }
         }
     }
+
+    return $success;
 };
 
-sub register {
-    call_hooks("register", $_) for @_;
-    push @plugins, @_;
+sub register(@new_plugins) {
+    call_hooks("register", $_) for @new_plugins;
+    push @plugins, @new_plugins;
 }
 
-sub load {
+sub load($class) {
     my @config = _read_file('revbank.plugins');
     chomp @config;
     s/#.*//g for @config;
@@ -48,18 +61,24 @@ sub load {
         }
         RevBank::Eval::clean_eval(qq[
             use strict;
+            use warnings;
+            use v5.32;
+            use experimental 'signatures';
+            use experimental 'isa';
             package $package;
             BEGIN { RevBank::Global->import; }
             our \@ISA = qw(RevBank::Plugin);
             our \%ATTR;
-            sub MODIFY_CODE_ATTRIBUTES {
-                my (\$class, \$sub, \@attrs) = \@_;
+            sub MODIFY_CODE_ATTRIBUTES(\$class, \$sub, \@attrs) {
                 \$ATTR{ \$sub } = "\@attrs";
                 return;
             }
             sub FETCH_CODE_ATTRIBUTES {
                 return \$ATTR{ +pop };
             }
+            sub HELP1 {
+                \$::HELP1{ +shift } = +pop;
+            }
             sub HELP {
                 \$::HELP{ +shift } = +pop;
             }
@@ -79,7 +98,7 @@ sub load {
     }
 }
 
-sub new {
+sub new($class) {
     return map $_->new, @plugins;
 }
 

lib/RevBank/Plugins.pod

@@ -45,16 +45,15 @@ There is no protection against infinite loops. Be careful!
     because that's canonicalised.
 
     Don't do this:
-        $cart->add($u, $a, "Bad example");
+        $entry->add_contra($u, $a, "Bad example");
 
     But do this:
         $u = parse_user($u)   or return REJECT, "$u: No such user.";
         $a = parse_amount($a) or return REJECT, "$a: Invalid amount.";
-        $cart->add($u, $a, 'Good, except that $a is special in Perl :)');
+        $entry->add_contra($u, $a, 'Good, except that $a is special in Perl :)');
 
-There are two kinds of plugin methods: input methods and hooks. A plugin MUST
-define one C<command> input method (but it MAY be a no-op), and can have any
-number of hooks.
+There are two kinds of plugin methods: input methods and hooks. A plugin may
+define one C<command> input method, and can have any number of hooks.
 
 =head2 Input methods
 
@@ -115,41 +114,38 @@ cart, re-evaluate your assumptions when upgrading!
 
 Hooks SHOULD NOT prompt for input or execute programs that do so.
 
-A plugin that exists only for its hooks, MUST still provide a C<command> method.
-The suggested implementation for a no-op C<command> method is:
+Hooks are called as class methods. The return value MUST be either C<ABORT>,
+which causes the ongoing transaction to be aborted, or a non-reference, which
+will be ignored.
 
-    sub command {
-        return NEXT;
-    }
-
-Hooks are called as class methods. The return value is ignored. Hooks MUST NOT
-interfere with the transaction flow (e.g. abort it).
+Hooks SHOULD have a dummy C<@> parameter at the end of their signatures,
+so they don't break when more information is added 
 
 The following hooks are available, with their respective arguments:
 
 =over 10
 
-=item hook_register $class, $plugin
+=item hook_register($class, $plugin, @)
 
 Called when a new plugin is registered.
 
-=item hook_abort $class, $cart
+=item hook_abort($class, $cart, @)
 
 Called when a transaction is being aborted, right before the shopping cart is
 emptied.
 
-=item hook_prompt $class, $cart, $prompt
+=item hook_prompt($class, $cart, $prompt, @)
 
 Called just before the user is prompted for input interactively. The prompt
 MAY be altered by the plugin.
 
-=item hook_input $class, $cart, $input, $split_input
+=item hook_input($class, $cart, $input, $split_input, @)
 
 Called when user input was given. C<$split_input> is a boolean that is true
 if the input will be split on whitespace, rather than treated as a whole.
 The input MAY be altered by the plugin.
 
-=item hook_add $class, $cart, $user, $item
+=item hook_add($class, $cart, $user, $item, @)
 
 Called when something is added to the cart. Of course, like in C<< $cart->add
 >>, C<$user> will be undef if the product is added for the current user.
@@ -160,35 +156,47 @@ item going into the cart!
 
 Be careful to avoid infinite loops if you add new stuff.
 
-=item hook_checkout $class, $cart, $user, $transaction_id
+=item hook_checkout_prepare($class, $cart, $user, $transaction_id, @)
 
-Called when the transaction is finalized, before accounts are updated.
+Called when the transaction is about to be processed. In this phase, the cart and its entries can still be manipulated. If the hook throws an exception, the transaction is aborted.
 
-=item hook_checkout_done $class, $cart, $user, $transaction_id
+=item hook_checkout($class, $cart, $user, $transaction_id, @)
+
+Called when the transaction is finalized, before accounts are updated. The cart and cart entries must not be changed.
+
+=item hook_checkout_done($class, $cart, $user, $transaction_id, @)
 
 Called when the transaction is finalized, after accounts were updated.
 
-=item hook_reject $class, $plugin, $reason, $abort
+=item hook_reject($class, $plugin, $reason, $abort, @)
 
 Called when input is rejected by a plugin. C<$abort> is true when the
 transaction will be aborted because of the rejection.
 
-=item hook_invalid_input $class, $cart, $word
+=item hook_invalid_input($class, $cart, $word, @)
 
 Called when input was not recognised by any of the plugins.
 
-=item hook_plugin_fail $class, $plugin, $error
+=item hook_plugin_fail($class, $plugin, $error, @)
 
 Called when a plugin fails.
 
-=item hook_user_created $class, $username
+=item hook_user_created($class, $username, @)
 
 Called when a new user account was created.
 
-=item hook_user_balance $class, $username, $old, $delta, $new, $transaction_id
+=item hook_user_balance($class, $username, $old, $delta, $new, $transaction_id, @)
 
 Called when a user account is updated.
 
+=item hook_products_changed($class, $changes, $mtime, @)
+
+Called after reading a changed products file. C<$changes> is a reference to an array of C<[old, new]> pairs. For new products, C<old> will be undef. For deleted products, C<new> will be undef.
+
+The mtime is the mtime of the products file, not necessarily when the product was changed.
+
+Caveats: Only things that change during runtime cause this hook to be called. When multiple revbank instances are running, each process gets this hook. When the products file is modified externally, the new file is loaded only after user interaction. When a product's primary id changes, it is registered as a deletion and addition, not a change.
+
 =back
 
 Default messages can be silenced by overriding the hooks in
@@ -196,7 +204,7 @@ C<RevBank::Messages>. Such a hack might look like:
 
     undef &RevBank::Messages::hook_abort;
 
-    sub hook_abort {
+    sub hook_abort($class, $cart, @) {
         print "This message is much better!\n"
     }
 

lib/RevBank/Products.pm

@@ -0,0 +1,214 @@
+package RevBank::Products;
+
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since 5.36
+
+use RevBank::Prompt;
+use RevBank::Global;
+use Exporter qw(import);
+our @EXPORT = qw(read_products);
+
+# Note: the parameters are subject to change
+sub read_products($filename = "revbank.products", $default_contra = "+sales/products") {
+    state %caches;   # $filename => \%products
+    state %mtimes;  # $filename => mtime
+
+    my $mtime = \$mtimes{$filename};
+    my $cache = $caches{$filename} ||= {};
+    return $cache if $$mtime and (stat $filename)[9] == $$mtime;
+
+    my %products;
+    my $linenr = 0;
+    my $warnings = 0;
+
+    $$mtime = (stat $filename)[9];
+    for my $line (slurp $filename) {
+        $linenr++;
+
+        next if $line =~ m[
+            ^\s*\#    # comment line
+            |
+            ^\s*$     # empty line, or only whitespace
+        ]x;
+
+        my @split = RevBank::Prompt::split_input($line);
+
+        if (not @split or ref $split[0] or grep /\0/, @split) {
+            warn "Invalid value in $filename line $linenr.\n";
+            next;
+        }
+
+        my ($ids, $p, $desc, @extra) = @split;
+
+        my @addon_ids;
+        my %tags;
+
+        my $compat = 0;
+        if (@split == 1 and ref $split[0]) {
+            $compat = 1;
+        } else {
+            for (@extra) {
+                if (/^\+(.*)/) {
+                    push @addon_ids, $1;
+                } elsif (/^\#(\w+)(=(.*))?/) {
+                    $tags{$1} = $2 ? $3 : 1;
+                } else {
+                    $compat = 1;
+                    last;
+                }
+            }
+        }
+
+        if ($compat) {
+            $warnings++;
+            warn "$filename line $linenr: can't parse as new format; assuming old format.\n" if $warnings < 4;
+            warn "Too many warnings; suppressing the rest. See UPGRADING.md for instructions.\n" if $warnings == 4;
+
+            ($ids, $p, $desc) = split " ", $line, 3;
+
+            @addon_ids = ();
+            unshift @addon_ids, $1 while $desc =~ s/\s+ \+ (\S+)$//x;
+        }
+
+        my @ids = split /,/, $ids;
+
+        $p //= 0;
+        $desc ||= "(no description)";
+
+        my $canonical = join " ", map RevBank::Prompt::reconstruct($_), $ids, $p, $desc, @extra;
+
+        my ($price, $contra) = split /\@/, $p, 2;
+
+        my $sign = $price =~ s/^-// ? -1 : 1;
+        my $percent = $price =~ s/%$//;
+
+        if ($percent) {
+            if (grep !/^\+/, @ids) {
+                warn "Percentage invalid for non-addon at $filename line $linenr.\n";
+                next;
+            }
+            $percent = $sign * (0 + $price);
+            $price = undef;  # calculated later
+        } else {
+            $price = eval { parse_amount($price) };
+            if (not defined $price) {
+                warn "Invalid price for '$ids[0]' at $filename line $linenr.\n";
+                next;
+            }
+            $price *= $sign;
+        }
+        for my $id (@ids) {
+            warn "Product '$id' redefined at $filename line $linenr (original at line $products{$id}{line}).\n" if exists $products{$id};
+
+            # HERE (see .pod)
+            $products{$id} = {
+                id          => $ids[0],
+                aliases     => [ @ids[1 .. $#ids] ],
+                is_alias    => $id ne $ids[0],
+                description => $desc,
+                contra      => $contra || $default_contra,
+                _addon_ids  => \@addon_ids,
+                line        => $linenr,
+                tags        => \%tags,
+                config      => $canonical,
+
+                percent     => $percent,
+                price       => $price,  # base price
+
+                # The following are calculated below, for top-level products only:
+                # tag_price   => base price + sum of transparent addons
+                # hidden_fees => sum of opaque addons
+                # total_price => tag_price + hidden_fees
+            };
+        }
+    }
+
+    # Resolve addons
+    PRODUCT: for my $product (values %products) {
+        my %ids_seen = ($product->{id} => 1);
+        my @addon_ids = @{ $product->{_addon_ids} };
+
+        while (my $addon_id = shift @addon_ids) {
+            $addon_id = "+$addon_id" if exists $products{"+$addon_id"};
+
+            if ($ids_seen{$addon_id}++) {
+                warn "Infinite addon loop for '$product->{id}' at $filename line $product->{line}.\n";
+                next PRODUCT;
+            }
+
+            my $addon = $products{$addon_id};
+            if (not $addon) {
+                warn "Addon '$addon_id' does not exist for '$product->{id}' at $filename line $product->{line}.\n";
+                next PRODUCT;
+            }
+            $addon = { %$addon }; # shallow copy to overwrite ->{price} later
+
+            push @{ $product->{addons} }, $addon;
+            push @addon_ids, @{ $addon->{_addon_ids} };
+        }
+    }
+
+    # Calculate tag and total price
+    PRODUCT: for my $id (keys %products) {
+        next if $id =~ /^\+/;
+        my $product = $products{$id};
+
+        my $tag_price = $product->{price} || RevBank::Amount->new(0);
+        my $hidden = 0;
+
+        my @seen = ($product);
+        for my $addon (@{ $product->{addons} }) {
+            if ($addon->{percent}) {
+                my $sum = List::Util::sum map {
+                    $_->{price}
+                } grep {
+                    $_->{contra} eq $addon->{contra}
+                } @seen;
+
+                $addon->{price} = $addon->{percent} / 100 * $sum;
+            }
+
+            if ($addon->{tags}{OPAQUE}) {
+                $hidden += $addon->{price};
+            } else {
+                $tag_price += $addon->{price};
+            }
+
+            push @seen, $addon;
+        }
+
+        $product->{tag_price} = $tag_price;
+        $product->{hidden_fees} = $hidden;
+        $product->{total_price} = $tag_price + $hidden;
+    }
+
+    my @changes;
+
+    if (%$cache) {
+        for my $new (values %products) {
+            next if $new->{is_alias};
+
+            my $id = $new->{id};
+            my $old = $cache->{$id};
+
+            if (not defined $old or $new->{config} ne $old->{config}) {
+                push @changes, [$old, $new];
+            }
+
+            delete $cache->{$id};
+        }
+
+        for my $p (values %$cache) {
+            next if $p->{is_alias};
+            push @changes, [$p, undef];
+        }
+
+        call_hooks("products_changed", \@changes, $$mtime);
+    }
+
+    %$cache = %products;
+    return \%products;
+}
+
+1;

lib/RevBank/Products.pod

@@ -0,0 +1,185 @@
+=head1 NAME
+
+RevBank::Products - Product list
+
+=head1 SYNOPISIS
+
+	# Comments are lines that begin with a # character.
+	# Empty lines are ignored.
+
+	8710447032756          0.80        "Festini Peer"
+	4029764001807,clubmate 1.40        "Club-Mate" +pf +half
+	pf                     0.15@+pfand "Pfand NRW-Flasche" #OPAQUE
+	+half                  -50%        "50% discount \\o/"
+	123                    0.42        "Hashtag example" #tag #tag2=42
+
+=head1 DESCRIPTION
+
+This module implements a products database, based on a text file. It supports
+additional fees, discounts, compound products, and optional metadata that can
+be read by plugins.
+
+=head2 read_products
+
+The only function of this module is exported by default. It returns a reference
+to a hash of products (each represented as a hash), keyed by product id.
+
+The available keys per product are currently not documented; refer to the
+C<Products.pm> file after the line that is commented C<# HERE> for a list.
+
+=head1 CONFIGURATION
+
+The configuration for this plugin lives in a text file called
+C<revbank.products>.
+
+Whitespace at the beginning or end of a line are ignored. Blank lines are
+ignored. Comments are lines that start with C<#> and are also ignored. Note
+that a whole line is either a comment or a data line; trailing comments are
+not supported and C<#> is a valid character in a product description.
+
+Data lines have whitespace-separated columns:
+
+=head2 Product ids
+
+One or more product ids, separated by commas (no whitespace before or after the
+commas). There is no way to have a comma or whitespace in a product id, but
+every other printable character is valid.
+
+The first product id on the line is considered canonical, the rest are aliases.
+
+Note: if a product id is the same as another RevBank command (e.g. a username),
+the first plugin that accepts the command will "win"; the precedence order is
+defined by the C<revbank.plugins> configuration file. However, when a product
+id appears multiple times within C<revbank.products>, the I<last> one is used.
+
+Product ids that begin with C<+> can only be used as addons. When entered as
+user input, it will be ignored by the C<products> plugin.
+
+=head2 Price
+
+The price of the product. This is the price to be deducted from the user's
+account when they check out with this product in the cart. When it is a
+negative number, the user will instead have money added to their account when
+"buying" this product.
+
+Optionally, the price can be augmented with an C<@> sign and the name of the
+contra account. When no contra account is specified, C<+sales/products> is used.
+Internal accounts (that start with C<-> or C<+>) are created automatically. A
+regular account can also be used, but has to exist before the product can be
+used.
+
+(Note on internal accounts because they aren't documented elsewhere: liability
+and revenue accounts begin with C<+>, asset and expense accounts begin with
+C<->. The C<+> accounts typically grow larger over time, while C<-> accounts
+typically go negative. In general, you would use a C<+> account in
+C<revbank.products>. User accounts are liability accounts.)
+
+=head2 Description
+
+The description, like other columns, may contain whitespace, but to use
+whitespace, either the entire field "needs quotes" around it, or the whitespace
+can be escaped with backslashes.
+
+It is suggested to always use quotes around the description.
+
+=head2 Additional fields
+
+=head3 Addons
+
+Addons are products that are added as part of the main product. They are
+specified after the description, with a C<+> sign that has whitespace before
+it, and no whitespace after it.
+
+When specifying an addon C<+foo>, and no product with the id C<+foo> exists,
+the product id C<foo> is used instead. The difference is that a product id
+C<+foo> can only be used as an addon for another product, while C<foo> can be
+used either as an addon or a manually entered as a standalone product.
+
+	example_id          2.20     "Example product" +first +second
+	+first              1.20     "First thing"
+	second              0.80     "Second thing"
+
+In this example, the final price of the example product will be 4.20. It is not
+possible to buy the first thing separate, but it is possible to buy the second
+thing separate.
+
+The addon product must be specified in C<revbank.products>; market products
+cannot be used as addons.
+
+When a product has addons, it becomes a compound product. This can be used to
+separate a product into individual counter accounts for bookkeeping purposes,
+to add a bottle deposit, or to add other additional fees or discounts.
+
+When a compound product has a bare price that isn't 0.00, the bare price is
+listed as a component named "Product".
+
+A product can have multiple addons. Addon products themselves can also have
+further addons, but circular recursion is not supported.
+
+=head4 Percentage addons
+
+As a special case, an addon's price can be a percentage. In this case, the
+price is calculated from the sum of the the product components I<up to that
+point> that have I<the same contra account> as the percentage addon.
+
+So, given the following example,
+
+	example_id          0.90          "Example product" +some_fee +discount
+	+some_fee           0.15@+fees    "Some fee; might be a bottle deposit"
+	+discount           -50%          "Special offer discount!"
+
+only 0.45 is discounted, because the 0.15 has a different contra account. While
+complicated, this is probably what you want in most cases. There is currently
+no way to apply a discount to the product with all of its addons.
+
+A percentage addon must have a product_id that begins with C<+>.
+
+=head3 Tags
+
+Additional metadata can be given in additional fields that begin with C<#> and
+the name of the tag, optionally followed by C<=> and a value to turn it into a
+key/value pair. If no value is specified, a value of C<1> is used.
+
+The name of a hashtag must contain only C<A-Z a-z 0-9 _> characters. There must
+not be whitespace after the C<#> or around the C<=>.
+
+Like all the fields, the field can be quoted to contain whitespace. Note,
+however, that the quotes must be placed around the entire field, not just the
+value part.
+
+	ht1         0.42           "Just one hashtag" #tag
+	ht2         0.42           "Two hashtags!" #tag #key=value
+	ht3         0.42           "Surprising syntax" "#x=spaces in value"
+
+Tags can be accessed by custom plugins.
+
+The following tags are used by RevBank itself:
+
+=over 10
+
+=item C<#OPAQUE>
+
+When used on an addon, the price of the addon will be excluded when calculating
+the tag price. The default is to use transparent pricing, i.e. that all
+additional fees are included in the tag price. In specific cases, such as
+container deposits, the addon price should not be considered part of the
+product price, and C<#OPAQUE> can be used.
+
+The tag price is not displayed in the RevBank user interface, but may be used
+in generated price tags and price listings.
+
+The sum of a product's opaque prices is available via the key C<hidden_fees>.
+
+=back
+
+By convention, tags that affect internal semantics get uppercase names. It is
+suggested that tags used only by plugins get C<lowercase> names.
+
+=head3 Other additional fields
+
+When any field is added after the description, that does not begin with C<+> or
+C<#>, RevBank currently assumes it's the old syntax (which is not described in
+the current version of this document!), and parses it using the old semantics
+while showing a warning.
+
+This compatibility feature will be removed from a future version of RevBank.

lib/RevBank/Prompt.pm

@@ -0,0 +1,134 @@
+package RevBank::Prompt;
+
+use v5.32;
+use warnings;
+use feature qw(signatures isa);
+no warnings "experimental::signatures";
+
+use List::Util qw(uniq);
+use Term::ReadLine;
+require Term::ReadLine::Gnu;  # The other one sucks.
+
+use RevBank::Global;
+
+my %escapes = (a => "\a", r => "\r", n => "\n", t => "\t", 0 => "\0");
+my %unescapes = reverse %escapes;
+my $unescapes = join "", keys %unescapes;
+
+sub split_input($input) {
+    $input =~ s/\s+$//;
+
+    my @terms;
+    my $pos = 0;
+    my $lastpos = 0;
+
+    my sub _P($nudge = 0) { $pos = pos($input) + $nudge; }
+
+    while (
+        $input =~ m[
+            \G \s*+
+            (?| (') (?{_P -1}) ( (?: \\. | [^\\']     )*+ ) ' (?{_P}) (?=\s|;|$)
+              | (") (?{_P -1}) ( (?: \\. | [^\\"]     )*+ ) " (?{_P}) (?=\s|;|$)
+              | ()             ( (?: \\. | [^\\;'"\s] )++ )   (?{_P}) (?=\s|;|$)
+              | ()  (;)
+            )
+        ]xg
+    ) {
+        push @terms, (
+              (not $1) && $2 eq ";" ? "\0SEPARATOR"
+            : (not $1) && $2 eq "abort" ? "\0ABORT"
+            : $1 && $2 eq "abort" ? "abort"
+            : $2
+        );
+        $lastpos = pos($input) || 0;
+        $pos ||= $lastpos;
+    }
+
+    # End of string not reached
+    return \$pos if $lastpos < length($input);
+
+    # End of string reached
+    s[\\(.)]{ $escapes{$1} // $1 }ge for @terms;
+    return @terms;
+}
+
+sub reconstruct($word) {
+    $word =~ s/([;'"\\])/\\$1/g;
+    $word =~ s/\0SEPARATOR/;/;
+    $word =~ s/([$unescapes])/\\$unescapes{$1}/g;
+    $word = "'$word'" if $word =~ /\s/ or $word eq "abort";
+    return $word;
+}
+
+sub prompt($prompt, $completions = [], $default = "", $pos = 0, $cart = undef, $plugins = []) {
+    state $readline = Term::ReadLine->new($0);
+    my $attribs = $readline->Attribs;
+
+    if ($prompt) {
+        $prompt =~ s/$/:/ if $prompt !~ /[?>](?:\x01[^\x02]*\x02)?$/;
+        $prompt .= " ";
+    } else {
+        # \x01...\x02 = zero width markers for readline
+        # \e[...m     = ansi escape (32 = green, 1 = bright)
+        $prompt = "\x01\e[32;1m\x02>\x01\e[0m\x02 ";
+    }
+
+    my @matches;
+    $attribs->{completion_entry_function} = sub {
+        my ($word, $state) = @_;
+        return undef if $word eq "";
+        @matches = grep /^\Q$word\E/i, @$completions if $state == 0;
+        return shift @matches;
+    };
+
+    # Term::ReadLine::Gnu (1.37) does not expose rl_completion_case_fold,
+    # but it can be assigned through the corresponding .inputrc command.
+    $readline->parse_and_bind("set completion-ignore-case on");
+
+    my $begin = my $time = time;
+
+    $attribs->{event_hook} = sub {
+        if ($::ABORT_HACK) {
+            # Global variable that a signal handling plugin can set.
+            # Do not use, but "return ABORT" instead.
+            my $reason = $::ABORT_HACK;
+            $::ABORT_HACK = 0;
+            main::abort($reason);
+        }
+
+        state $last_pos = 0;
+        if ($attribs->{point} != $last_pos) {
+            $begin = time;
+            $last_pos = $attribs->{point};
+        }
+
+        if (time > $time) {
+            $time = time;
+            call_hooks(
+                "prompt_idle",
+                $cart,
+                (@$plugins > 1 ? undef : $plugins->[0]), # >1 plugin = main loop
+                $time - $begin,
+                $readline,
+            );
+        }
+    };
+
+    $attribs->{startup_hook} = sub {
+        $attribs->{point} = $pos;
+    };
+
+    $readline->ornaments(0);
+    my $input = $readline->readline($prompt, $default);
+
+    print "\e[0m";
+
+    return undef if not defined $input;
+
+    $input =~ s/^\s+//;  # trim leading whitespace
+    $input =~ s/\s+$//;  # trim trailing whitespace
+
+    return $input;
+}
+
+1;

lib/RevBank/TextEditor.pm

@@ -0,0 +1,198 @@
+package RevBank::TextEditor;
+
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+
+use autodie;
+use RevBank::Global;
+use Fcntl qw(:flock);
+use Carp qw(croak);
+use Time::HiRes qw(sleep);
+
+my $tab = 4;
+
+sub _require {
+    if (not eval { require Curses::UI }) {
+        my $install = -e "/etc/debian_version"
+            ? "apt install libcurses-ui-perl"
+            : "cpan Curses::UI";
+
+        die "Couldn't load the Perl module Curses::UI.\n" .
+            "Please install it! (sudo $install)\n";
+    }
+}
+
+sub _find_next($win, $textref) {
+    my $editor = $win->getobj('editor');
+    my $find = $win->getobj('find');
+    my $a = $find->getobj('answer');
+    my $b = $find->getobj('buttons');
+
+    my $q = $a->get;
+
+    pos($$textref) = $editor->pos;
+    my $status = "not found";
+    my $offset;
+    if ($$textref =~ /\Q$q/gi) {
+        $status = "found";
+        $offset = $+[0];
+    } else {
+        $editor->pos(0);
+        pos($$textref) = 0;
+        if ($$textref =~ /\Q$q/gi) {
+            $status = "wrapped";
+            $offset = $+[0];
+        }
+    }
+
+    $find->{-title} = ucfirst $status;
+    if ($status ne "not found") {
+        $editor->pos($offset);
+        $editor->{-search_highlight} = $editor->{-ypos};
+    } else {
+        $editor->{-search_highlight} = undef;
+    }
+    $win->draw;
+}
+
+sub _find($win) {
+    my $editor = $win->getobj('editor');
+    my $text = $editor->get;
+
+    my $find = $win->add(
+        'find', 'Dialog::Question',
+        -question => "Search for:",
+        -buttons  => [
+            { -label => '[Find next]', -onpress => sub {
+                _find_next($win, \$text);
+            } },
+            { -label => '[Cancel]', -onpress => sub {
+                $win->getobj('find')->loose_focus;
+                $editor->{-search_highlight} = undef;
+            } },
+        ]
+    );
+    my $a = $find->getobj('answer');
+    my $b = $find->getobj('buttons');
+
+    $a->onFocus( sub { shift->pos(999) } );
+
+    $a->set_binding(sub {
+        $b->{-selected} = 0;  # [Find next]
+        $b->focus;
+        $b->press_button;
+        $win->draw;
+    }, Curses::KEY_ENTER());
+
+    $find->set_binding(sub {
+        $b->{-selected} = 1;  # [Cancel]
+        $b->focus;
+        $b->press_button;
+        $win->draw;
+    }, "\cX", "\cC");
+    $b->set_routine('press-button' => sub { $b->press_button });
+
+    $find->modalfocus;
+    $win->delete('find');
+}
+
+sub _editor($title, $origdata, $readonly = 0) {
+    our $cui ||= Curses::UI->new;
+    my $win = $cui->add('main', 'Window');
+    $title = $readonly
+        ? "[$title]  Press q to quit"
+        : "[$title]  Ctrl+X: exit  Ctrl+F: find  Ctrl+C/K/V: copy/cut/paste";
+
+    my $editor = $win->add(
+        'editor', 'TextEditor',
+        -title      => $title,
+        -text       => $origdata,
+        -border     => 1,
+        -padbottom  => 1,  # ibm3151/screen lastline corner glitch workaround
+        -wrapping   => 0,
+        -hscrollbar => 0,
+        -vscrollbar => 0,
+        -pos        => ($readonly == 2 ? length($origdata) : 0),
+        #-readonly => !!$readonly  # does not support -pos
+    );
+
+    my $return;
+
+    if ($readonly) {
+        $editor->readonly(1);  # must be before bindings
+        $editor->set_binding(sub { $cui->mainloopExit }, "q") if $readonly;
+    } else {
+        my @keys = (
+            [ Curses::KEY_HOME() => 'cursor-scrlinestart' ],
+            [ Curses::KEY_END()  => 'cursor-scrlineend' ],
+            [ "\cK" => 'delete-line' ],  # nano (can't do meta/alt for M-m)
+            [ "\cU" => 'paste' ],        # nano
+            [ "\c[" => sub { } ],
+            [ "\cL" => sub { $cui->draw } ],
+            [ "\c^" => sub { $editor->pos(0) } ],
+            [ "\c_" => sub { $editor->pos(length($editor->get)) } ],
+            [ "\cG" => sub { $editor->pos(length($editor->get)) } ],
+            [ "\cI" => sub { $editor->add_string(" " x ($tab - ($editor->{-xpos} % $tab))) } ],
+            [ "\cS" => sub { $cui->dialog("Enable flow control :)") } ],
+            [ "\cQ" => sub {} ],
+            [ "\cC" => sub { $editor->{-pastebuffer} = $editor->getline_at_ypos($editor->{-ypos}) } ],
+            [ "\cF" => sub { _find($win) } ],
+            [ "\cX" => sub {
+                if ($editor->get ne $origdata) {
+                    my $answer = $cui->dialog(
+                        -message => "Save changes?",
+                        -buttons => [
+                            { -label => "[Save]",    -value => 1 },
+                            { -label => "[Discard]", -value => 0 },
+                            { -label => "[Cancel]",  -value => -1 },
+                        ],
+                        -values => [ 1, 0 ],
+                    );
+                    $return = $editor->get if $answer == 1;
+                    $cui->mainloopExit     if $answer >= 0;
+                } else {
+                    $cui->mainloopExit;
+                }
+            } ],
+        );
+
+        $editor->set_binding(reverse @$_) for @keys;
+    }
+    $editor->focus();
+
+    $cui->mainloop;
+    $cui->leave_curses;
+    $cui->delete('main');
+
+    return $return;
+}
+
+sub edit($filename) {
+    _require();
+
+    open my $fh, ">>", $filename;
+    flock $fh, LOCK_EX | LOCK_NB
+        or die "Someone else is alreading editing $filename.\n";
+
+    my $save = _editor($filename, scalar slurp $filename);
+
+    if (defined $save) {
+        spurt $filename, $save;
+        print "$filename updated.\n";
+    } else {
+        print "$filename not changed.\n";
+    }
+}
+
+sub pager($title, $data) {
+    _require();
+    _editor($title, $data, 1);
+}
+
+sub logpager($title, $data) {
+    _require();
+    _editor($title, $data, 2);
+}
+
+1;

lib/RevBank/TextEditor.pod

@@ -0,0 +1,37 @@
+=head1 NAME
+
+RevBank::TextEditor - Basic Lightweight User-friendly TextEditor
+
+=head1 SYNOPSIS
+
+	require RevBank::TextEditor;
+	RevBank::TextEditor::edit($filename);
+
+=head1 DESCRIPTION
+
+BLUT is a built-in text editor based on Curses::UI.
+
+It was made because vim is too hard for unprepared newbies, and nano too,
+really: not everyone knows that C<^X> means Ctrl+X, making nano almost as hard
+to exit as vim. And of course, none of the really user friendly editors out
+there would work well on our old IBM 3151 terminal. (For instance, C<^S> and
+C<^Q> are used for software flow control, or as the manual of said terminal
+calls it, "pacing".)
+
+And of course, all the editors out there will let you open other files, or even
+run shells...
+
+=head2 Functions
+
+=head3 edit($filename)
+
+Runs the editor.
+
+=head2 CAVEATS
+
+=over 2
+
+=item * It's a really dumb editor, and many unsupported presses will end up as
+garbage.
+
+=back

lib/RevBank/Users.pm

@@ -1,50 +1,81 @@
 package RevBank::Users;
-use strict;
+
+use v5.32;
+use warnings;
+use experimental 'signatures';  # stable since v5.36
+
 use RevBank::Global;
 use RevBank::Plugins;
+use Carp ();
+use List::Util ();
 
 my $filename = "revbank.accounts";
 
-sub _read {
+sub _read() {
     my @users;
-    open my $fh, $filename or die $!;
-    /\S/ and push @users, [split " "] while readline $fh;
-    close $fh;
-    return { map { lc($_->[0]) => $_ } @users };
+    for my $line (slurp $filename) {
+        $line =~ /\S/ or next;
+        # Not using RevBank::Prompt::split_input to keep parsing by external
+        # scripts simple, since so many such scripts exist.
+
+        my @split = split " ", $line;
+
+        if ($split[1] =~ /^!/) {
+            # Special case: use rest of the line (see POD).
+            @split = split " ", $line, 2;
+        }
+
+        push @users, \@split;
+    }
+
+    my %users;
+    for (@users) {
+        my $name = lc $_->[0];
+
+        exists $users{$name} and die "$filename: duplicate entry '$name'\n";
+        $users{$name} = $_;
+
+        if ($name =~ s/^\*//) {
+            # user-accessible special account: support without * prefix
+            exists $users{$name} and die "$filename: duplicate entry '$name'\n";
+            $users{$name} = $_;
+        }
+    }
+    return \%users;
 }
 
-sub names {
-    return map $_->[0], values %{ _read() };
+sub names() {
+    # uniq because *foo causes population of keys '*foo' and 'foo', with
+    # ->[0] both being 'foo'. However, the keys are lowercase, not canonical.
+    return List::Util::uniqstr map $_->[0], values %{ _read() };
 }
 
-sub balance {
-    my ($name) = @_;
-    return _read()->{ lc $name }->[1];
+sub balance($username) {
+    return RevBank::Amount->parse_string( _read()->{ lc $username }->[1] );
 }
 
-sub since {
-    my ($name) = @_;
-    return _read()->{ lc $name }->[3];
+sub since($username) {
+    return _read()->{ lc $username }->[3];
 }
 
-sub create {
-    my ($username) = @_;
-    open my $fh, '>>', $filename or die $!;
+sub create($username) {
+    die "Account already exists" if exists _read()->{ lc $username };
+
     my $now = now();
-    print {$fh} "$username 0.00 $now\n" or die $!;
-    close $fh or die $!;
+    append $filename, "$username 0.00 $now\n";
     RevBank::Plugins::call_hooks("user_created", $username);
+    return $username;
 }
 
-sub update {
-    my ($username, $delta, $transaction_id) = @_;
-    open my $in,  'revbank.accounts' or die $!;
-    open my $out, ">.revbank.$$" or die $!;
-    my $old;
-    my $new;
-    while (defined (my $line = readline $in)) {
+sub update($username, $delta, $transaction_id) {
+    my $account = assert_user($username) or die "No such user ($username)";
+
+    my $old = RevBank::Amount->new(0);
+    my $new = RevBank::Amount->new(0);
+
+    rewrite $filename, sub($line) {
         my @a = split " ", $line;
-        if (lc $a[0] eq lc $username) {
+        if (lc $a[0] eq lc $account) {
             $old = RevBank::Amount->parse_string($a[1]);
             die "Fatal error: invalid balance in revbank:accounts:$.\n"
                 if not defined $old;
@@ -52,31 +83,64 @@ sub update {
             $new = $old + $delta;
 
             my $since = $a[3] // "";
-            $since = "+\@" . now() if $new  > 0 and (!$since or $old <= 0);
-            $since = "-\@" . now() if $new  < 0 and (!$since or $old >= 0);
-            $since = "0\@" . now() if $new == 0 and (!$since or $old != 0);
 
-            printf {$out} "%-16s %9s %s %s\n", (
-                $username, $new, now(), $since
-            ) or die $!;
+            my $newc = $new->cents;
+            my $oldc = $old->cents;
+            $since = "+\@" . now() if $newc  > 0 and (!$since or $oldc <= 0);
+            $since = "-\@" . now() if $newc  < 0 and (!$since or $oldc >= 0);
+            $since = "0\@" . now() if $newc == 0 and (!$since or $oldc != 0);
+
+            return sprintf "%-16s %9s %s %s\n", (
+                $account, $new->string("+"), now(), $since
+            );
         } else {
-            print {$out} $line or die $!;
+            return $line;
         }
-    }
-    close $out or die $!;
-    close $in;
-    rename ".revbank.$$", "revbank.accounts" or die $!;
+    };
 
     RevBank::Plugins::call_hooks(
-        "user_balance", $username, $old, $delta, $new, $transaction_id
+        "user_balance", $account, $old, $delta, $new, $transaction_id
     );
 }
 
-sub parse_user {
-    my ($username) = @_;
+sub is_hidden($username) {
+    return $username =~ /^[-+]/;
+}
+
+sub is_special($username) {
+    return $username =~ /^[-+*]/;
+}
+
+sub parse_user($username, $allow_invalid = 0) {
+    return undef if is_hidden($username);
+
     my $users = _read();
-    return undef if not exists $users->{ lc $username };
-    return $users->{ lc $username }->[0];
+
+    my $user = $users->{ lc $username } or return undef;
+
+    if ($user->[1] =~ /^!(.*)/) {
+        warn "$username: Invalid account ($1).\n";
+    }
+
+    $allow_invalid or defined balance($username)
+        or return undef;
+
+    return $user->[0];
+}
+
+sub assert_user($username) {
+    my $users = _read();
+
+    my $user = $users->{ lc $username };
+
+    if ($user) {
+        Carp::croak("Account $username can't be used") if not defined balance $username;
+        return $user->[0];
+    }
+
+    return create $username if is_hidden $username;
+
+    Carp::croak("No such user ($username)")
 }
 
 1;

lib/RevBank/Users.pod

@@ -0,0 +1,162 @@
+=head1 NAME
+
+RevBank::Users - Banking and bookkeeping accounts
+
+=head1 DESCRIPTION
+
+This package handles all accounts in RevBank. Accounts are called "users" because originally, RevBank only had user accounts. Today, RevBank does doubly-entry bookkeeping and has multiple account types to accommodate that.
+
+This package is where manipulation of C<revbank.accounts> happens.
+
+=head2 Account types
+
+=over 4
+
+=item * User accounts
+
+User accounts are typically made with the C<adduser> command, and almost all interactions with RevBank will involve only user accounts, from the perspective of the user.
+
+=item * Hidden accounts
+
+The name of a hidden account begins with a C<-> or C<+> sign. These accounts are created automatically by plugins to provide the I<double> part in I<doubly-entry bookkeeping>.
+
+Hidden accounts are internal accounts in the sense that they are not displayed and can't be used in the CLI where user accounts can.
+
+There is no technical difference between C<+> and C<->, but it is suggested to use C<-> for accounts that will typically go negative and would be flipped to a positive number to make intuitive sense.
+
+For example, the C<-cash> account will go to C<-4.20> when someone deposits 4.20 into the cash box. It has to be a negative number, to balance the positive number added to the balance of the user. But the cash box will contain 4.20 more than before, even though the number is negative.
+
+Some plugins will use C</> to establish hierarchical account names in hidden accounts, like in C<+sales/products>. To RevBank, C</> is just a regular character, and it has no specific semantics for these hierarchies.
+
+=item * User-accessible special accounts
+
+The name of a user-accessible special account begins with a C<*> sign. A special account can only be created by editing the C<revbank.accounts> file manually. They can be used like user accounts, with or without the C<*> sign, but they do not count towards the grand total of user accounts.
+
+The suggested use for user-accessible special accounts is for creating accounts that are virtual jars. For example, if users pay towards a virtual jar for kitchen equipment when they use the kitchen (like in the C<dinnerbonus> plugin), but are also allowed to use those funds for buying kitchen equipment, a user-accessible special account might be more convenient than having separate revenue and expense accounts, especially because those would typically be hidden accounts.
+
+=back
+
+=head3 Bookkeeping
+
+While RevBank does double-entry bookeeping, it does not use the terms I<credit> and I<debit> anywhere. Everything is just plus or minus. To use the data in bookkeeping software, some translation is required.
+
+There are many systems for bookkeeping. In the accounting equation approach, RevBank's account types would translate as:
+
+=over 4
+
+=item * user accounts
+
+Liabilities accounts
+
+=item * hidden accounts (C<+>)
+
+Revenues/incomes accounts.
+
+=item * hidden accounts (C<->)
+
+Expenses/losses accounts, or assets accounts.
+
+=item * user-accessible special accounts (C<*>)
+
+This one is slightly more complicated, because this depends on your view on accounting. From a pure bookkeeping perspective, this would be a liabilities account because it is technically equivalent to a user account, but it would make sense to book additions as revenue and deductions as expenses.
+
+=back
+
+=head2 Data format
+
+The file C<revbank.accounts> is a text file with one record per line, and whitespace separated fields. The columns are:
+
+=over 4
+
+=item * Account name
+
+The account name can be anything, but cannot contain whitespace. Special accounts begin with C<+>, C<->, or C<*>.
+
+Account names are case preserving, but case insensitive.
+
+Every account name must be unique. A file with duplicate names is not valid and may lead to crashes or undefined behavior. Since C<*foo> can be used as either C<*foo> or C<foo>, it is not allowed to have both C<*foo> and C<foo> in the accounts file.
+
+=item * Balance
+
+The account balance is a number with two decimal digits. Positive numbers may have a C<+> sign. Negative number have a C<-> sign.
+
+If the value in this field is not a valid number, the account is treated as non-existent by most of RevBank, while still being unavailable for C<adduser>.
+
+If the value begins with a C<!> character, the I<rest of the line> is taken as a description of why the account name is not available and printed as a warning when the account name is used.
+
+=item * Last use timestamp
+
+Local datetime of the last update of this account.
+
+=item * Zero-crossing timestamp
+
+Local datetime of the last time the balance went through 0.00. The timestamp is preceded with C<-@>, C<+@>, or C<0@> to indicate the direction of the crossing: C<-@> can be read as "became negative at", etc.
+
+This field is empty for accounts that have not yet been used.
+
+=back
+
+Only the first two columns are mandatory. This makes migrating to RevBank very simple.
+
+=head2 Functions
+
+Usernames are case preserving, but case insensitive. Account name arguments to functions are case insensitive, but return values use the canonical capitalization.
+
+Anything that outputs a username should always run it through C<parse_user> or C<assert_user>.
+
+=head3 names
+
+Returns a list of all account names.
+
+=head3 balance($name)
+
+Returns a RevBank::Amount that represents the balance of the account.
+
+=head3 since($name)
+
+Returns the last used datetime of the account.
+
+=head3 create($name)
+
+Creates an account with that name and a balance of zero. The name must not already exist.
+
+After updating the file, calls the C<user_created> hook with the account name.
+
+=head3 update($name, $delta, $transaction_id)
+
+Given the relative change (C<$delta>), updates the user balance for an account.
+
+After updating the file, calls the C<user_balance> hook with the account name, the old balance, the given delta, the new balance, and the transaction_id.
+
+This function should not be used directly; instead, create a transaction via C<RevBank::Cart> and use C<checkout> to ensure a balanced booking for proper double-entry bookkeeping.
+
+=head3 is_hidden($name)
+
+Returns true if the account is hidden (begins with C<+> or C<->).
+
+=head3 is_special($name)
+
+Returns true if the account is hidden (begins with C<+> or C<->), or user-accessible but special (begins with C<*>).
+
+=head3 parse_user($username)
+
+Returns the canonical account name if the user account exists, or undef if it does not exist.
+
+=head3 assert_user($name)
+
+For a hidden account, returns the canonical account name, creating the account if it did not already exist.
+
+For a non-hidden account, works like parse_user.
+
+=head1 CAVEATS
+
+The identifiers can be confusing and most instances of C<user> should probably be renamed to C<account>.
+
+=head1 AUTHOR
+
+Juerd Waalboer <#####@juerd.nl>
+
+=head1 LICENSE
+
+Pick your favorite OSI license.
+

plugins/3dprint

@@ -0,0 +1,26 @@
+#!perl
+
+HELP "3dprint <gram>" => "3D-print filament afrekenen";
+
+use Scalar::Util qw(looks_like_number);
+
+sub command :Tab(3dprint) ($self, $cart, $command, @) {
+    return NEXT if $command ne '3dprint';
+
+    return "Gewicht in gram, inclusief supports en purges", \&gram;
+}
+
+sub gram($self, $cart, $input, @) {
+    looks_like_number($input) and $input == int($input) or return REJECT, "Invalid number!";
+    my $gram = int($input);
+    return REJECT, "$input: Invalid amount." if $gram <= 0;
+
+    my $beneficiary = "3dprinter";
+    my $amount = 0.10 + $gram * 0.03;
+
+    $cart
+        ->add(-$amount, "Given to $beneficiary ($gram g)")
+        ->add_contra($beneficiary, +$amount, "Received from \$you (${gram} g)");
+
+    return ACCEPT;
+}

plugins/adduser

@@ -1,10 +1,10 @@
 #!perl
 
-HELP "adduser <name>" => "Create an account";
+use List::Util qw(any);
 
-sub command :Tab(adduser) {
-    my ($self, $cart, $command) = @_;
+HELP1 "adduser <name>" => "Create an account";
 
+sub command :Tab(adduser) ($self, $cart, $command, @) {
     $command eq 'adduser' or return NEXT;
 
     if ($cart->size) {
@@ -14,17 +14,25 @@ sub command :Tab(adduser) {
     return "Name for the new account", \&username;
 }
 
-sub username {
-    my ($self, $cart, $name) = @_;
+sub username($self, $cart, $name, @) {
+    return REJECT, "Sorry, only A-Z a-z 0-9 _ - + / ^ * [] {} are allowed."
+        if $name !~ /^[A-Za-z0-9_\-+\/\^*\[\]{}-]+\z/;
 
-    return REJECT, "Sorry, whitespace is not allowed."
-        if $name =~ /\s/;
+    return REJECT, "Sorry, - + / ^ * are not allowed as the first character."
+        if $name =~ /^[-+*\/\^]/;
 
-    return REJECT, "That's too numeric to be a user name."
-        if defined parse_amount($name);
+    return REJECT, "Sorry, that's too numeric to be a user name."
+        if defined RevBank::Amount->parse_string($name);
 
-    return REJECT, "That name already exists."
-        if defined parse_user($name);
+    return REJECT, "That name is not available."
+        if defined parse_user($name, 1);
+
+    for my $plugin (RevBank::Plugins->new) {
+        my $id = $plugin->id;
+
+        return REJECT, "That name would clash with the '$id' plugin."
+            if any sub { $_ eq $name }, $plugin->Tab('command');
+    }
 
     RevBank::Users::create( $name );
 

plugins/adduser_note

@@ -0,0 +1,12 @@
+sub command($self, $cart, $command, @) {
+	if ($command eq 'adduser') {
+		print <<'END';
+NOTE: This system is insecure by design. Other users can see your transactions,
+or pay using your account. We trust each other not to abuse this power.
+
+END
+
+	}
+	return NEXT;
+}
+

plugins/beep

@@ -1,14 +1,11 @@
 #!perl
 
-sub command { NEXT }
-
 *hook_plugin_fail = *hook_retry = *hook_reject = *hook_invalid_input = sub {
     call_hooks('beep');
     undef;
 };
 
-sub hook_abort {
-    my ($self, $cart, $reason) = @_;
+sub hook_abort($class, $cart, $reason, @) {
     return if not $reason or not @$reason;
     return if "@$reason" eq '^C';
 

plugins/beep_terminal

@@ -1,14 +1,10 @@
 #!perl
 
-sub command { NEXT }
-
 # So you want a different beep mechanism...
 #
 # Don't just edit this plugin. Instead, COPY this file and add yours to
 # revbank.plugins
 
-sub hook_beep {
-    my ($class) = @_;
-
+sub hook_beep($class, @) {
     print "\a";
 }

plugins/bitlair_bigmoney

@@ -0,0 +1,17 @@
+#!perl
+
+sub command :Tab(bigmoney) {
+    my ($self, $cart, $command) = @_;
+
+    return NEXT if $command ne "bigmoney";
+
+    my @list = sort {
+        (split " ", $b)[1] <=> (split " ", $a)[1]
+    } grep {
+        not RevBank::Users::is_hidden($_)
+    } slurp("revbank.accounts");
+
+    print join "", @list[0..9];
+
+    return ACCEPT;
+}

plugins/bitlair_git

@@ -0,0 +1,19 @@
+#!perl
+
+use Cwd ();
+
+sub command { NEXT }
+
+sub hook_checkout_done {
+    my ($class, $cart, $username, $transaction_id) = @_;
+
+    my @cart_printed = map { "\n-> $_" } map { $_->as_printable } $cart->entries;
+
+    my $fn = "/tmp/revbank$$.commit";
+    open my $fh, ">", $fn or warn $!;
+    print $fh "$username ($transaction_id)\n@cart_printed";
+    close $fh or warn $!;
+
+    my $output = `(cp revbank.accounts revbank.market revbank.products ~/data.git/ && cd ~/data.git/ && git commit -a -F $fn) 2>&1`;
+    warn "Meh, gitfaal: $output" if $?;
+}

plugins/bitlair_mqtt

@@ -0,0 +1,19 @@
+#!perl
+
+use Cwd ();
+use Net::MQTT::Simple;
+
+my $mqtt = Net::MQTT::Simple->new("mqtt.bitlair.nl");
+
+sub command { NEXT }
+
+sub hook_checkout {
+    my ($class, $cart, $user, $transaction_id) = @_;
+
+    my @entries = $cart->entries('product_id') or return;
+
+    for my $entry (@entries) {
+        $mqtt->publish("bitlair/pos/product" => $entry->{description})
+            for 1..$entry->quantity;
+    }
+}

plugins/bitlair_nomunnie

@@ -0,0 +1,15 @@
+#!perl
+
+use IO::Socket::IP;
+use Net::MQTT::Simple "mqtt.bitlair.nl";
+
+sub command { NEXT }
+
+sub hook_user_balance {
+    my ($class, $user, $old, $delta, $new, $transaction_id) = @_;
+
+    return if $new >= -13.37;
+    return if RevBank::Users::is_hidden($user);
+
+    publish "bitlair/bank/shame" => "NO MUNNIE?";
+}

plugins/cash

@@ -0,0 +1,100 @@
+#!perl
+
+# Use this plugin for cashbox contents tracking. For it to make sense,
+# you will also need the "deposit_methods" plugin to let users distinguish
+# between cash deposits and other deposit methods.
+
+# This plugin should be loaded *before* the 'stock' plugin in
+# the 'revbank.plugins' configuration file.
+
+HELP1 "cash" => "Checkout without a user account";
+
+sub command :Tab(cash) ($self, $cart, $command, @) {
+    return NEXT if $command ne 'cash';
+
+    if ($cart->size) {
+        return REJECT, "Can't use cash checkout on a deposit transaction."
+            if $cart->entries('is_deposit');
+
+        return REJECT, "Can't use cash checkout on a withdraw transaction."
+            if $cart->entries('is_withdrawal');
+
+        $cart->checkout('-cash');
+    } else {
+        call_hooks 'cash';
+
+        return "Please count the money to verify. How much is there, exactly?", \✓
+    }
+
+    return ACCEPT;
+}
+
+sub hook_cash($class, @) {
+    printf "There should currently be (at least) %s in the cash box.\n",
+        -RevBank::Users::balance("-cash") || "0.00";
+}
+
+our $suppress = 0;
+
+sub hook_user_balance($class, $username, $old, $delta, $new, @) {
+    return if $username ne '-cash' or $delta->cents == 0;
+    return if $suppress;
+
+    # "-" accounts need to be inverted to display the intuitive value.
+    my $actual_delta = -$delta;
+    my $actual_new   = -$new;
+
+    printf "\nProceed to %s %s %s the cash box;\n  it should then have (at least) %s%s.\n",
+        ($actual_delta->cents < 0 ? "remove" : "put"),
+        abs($delta),
+        ($actual_delta->cents < 0 ? "from" : "into"),
+        $actual_new,
+        ($actual_delta->cents < 0 ? " remaining" : " in it");
+}
+
+my $confirm_prompt = "Type 'fix pls' to apply a permanent correction, or 'abort' to abort";
+
+sub check($self, $cart, $arg, @) {
+    my $should = -RevBank::Users::balance("-cash") || parse_amount(0);
+    my $have = parse_amount($arg);
+    return REJECT, "Invalid amount" if not defined $have;
+
+    if ($have == $should) {
+        print "Thank you for checking!\n";
+        return ACCEPT;
+    }
+
+    my $surplus = $have - $should;
+    $self->{surplus} = $surplus;
+
+    my $what = $surplus < 0 ? "shortage" : "overage";
+    $self->{what} = $what;
+
+    my $abs = abs $surplus;
+    my $suffix =
+        $surplus <= -100 ? "??!! WTF?! Really?!"
+        : $surplus <= -20 ? "! :("
+        : $surplus <= -10 ? "!"
+        : $surplus >= +20 ? "?!"
+        : ".";
+
+    my $an = $what =~ /^o/ ? "an" : "a";
+    print "\nThank you for checking! That's $an $what of $abs$suffix\n";
+    return $confirm_prompt, \&confirm;
+}
+
+sub confirm($self, $cart, $arg, @) {
+    return $confirm_prompt, \&confirm unless $arg eq "fix pls";
+
+    $cart
+        ->add($self->{surplus}, "Cash $self->{what}")
+        ->add_contra("-cash", -$self->{surplus}, "Cash $self->{what}");
+
+    local $suppress = 1;
+    $cart->checkout('-expenses/discrepancies');
+
+    printf "\nDiscrepancy recorded; corrected cash box amount is %s.\n",
+        -RevBank::Users::balance("-cash") || "0.00";
+
+    return ACCEPT;
+}

plugins/cash_drawer

@@ -0,0 +1,22 @@
+
+sub open_drawer {
+    warn "The cash_drawer plugin should be changed to actually implement the opening of a cash drawer; stub code executed";
+}
+
+sub hook_add_entry($class, $cart, $entry, @) {
+    $entry->attribute('is_deposit') and $entry->attribute('method') =~ /reimburse|cash/
+        or $entry->attribute('is_withdrawal')
+        or return;
+
+    open_drawer();
+}
+
+sub hook_cash {
+    open_drawer();
+}
+
+sub hook_checkout($class, $cart, $user, $transaction_id, @) {
+    $user eq '-cash' or return;
+
+    open_drawer();
+}

plugins/deduplicate

@@ -0,0 +1,31 @@
+#!perl
+
+# Deduplication merges duplicate entries in the cart, e.g.
+# 3x cola + 4x cola = 7x cola.
+#
+# Plugins that support this, set the "deduplicate" attribute to a string key
+# that is used to determine which entries are equal. It is the responsibility
+# of the plugin that sets this, to ensure that the entries are indeed exactly
+# the same, if their deduplicate keys are equal.
+#
+# The recommended value for the deduplicate attribute is join("/", $plugin_id,
+# $unique_id), where $plugin_id can be obtained from $self->id in interactive
+# methods or $class->id in hooks. Including the plugin id avoids deduplicating
+# across plugins, that are probably not aware of eachothers $unique_id's.
+
+use List::Util qw(sum any);
+
+sub hook_added_entry($class, $cart, $added_entry, @) {
+    my $key = $added_entry->attribute('deduplicate') or return;
+
+    my @dedupe = grep {
+        $_->attribute('deduplicate') eq $key
+    } $cart->entries('deduplicate');
+
+    @dedupe >= 2 or return;
+
+    $dedupe[0]->quantity(sum map { $_->quantity } @dedupe);
+    $cart->select($dedupe[0]);
+
+    $cart->delete($_) for @dedupe[1 .. $#dedupe];
+}

plugins/deposit

@@ -2,34 +2,39 @@
 
 # This plugin must at the end in the plugins file.
 
-HELP "deposit <amount>" => "Deposit into an account";
-
-sub command :Tab(deposit) {
-    my ($self, $cart, $command) = @_;
+HELP1 "deposit <amount>" => "Deposit into an account";
 
+sub command :Tab(deposit) ($self, $cart, $command, @) {
     $command eq 'deposit' or return NEXT;
 
-    return "Amount to deposit into your account", \&amount;
+    my $prompt = "Amount to deposit into your account";
+    call_hooks("deposit_command", \$prompt, $self->{alternatives} = []);
+
+    return $prompt, \&amount;
 }
 
-sub amount :Tab(13.37,42) {
-    my ($self, $cart, $amount) = @_;
+sub amount :Tab(13.37,42) ($self, $cart, $input, @) {
+    for my $sub (@{ $self->{alternatives} }) {
+        my @rv = $sub->(undef, $cart, $input);
+        return @rv if $rv[0] != NEXT;
+    }
 
-    $self->{amount} = parse_amount($amount)
-        or return REJECT, "Invalid amount";
+    $self->{amount} = my $amount = parse_amount($input)
+        or return REJECT, "Invalid input.";
 
     call_hooks("deposit_methods", \my $message, $self->{deposit_methods} = {});
 
     return $message . "How are we receiving this $amount?", \&how
         if keys %{ $self->{deposit_methods} };
 
-    $cart->add(+$self->{amount}, "Deposit", { is_deposit => 1 });
+    $cart
+        ->add(+$amount, "Deposit", { is_deposit => 1 })
+        ->add_contra("-deposits/other", -$amount, "Deposited by \$you");
+
     return ACCEPT;
 }
 
-sub how :Tab(&how_tab) {
-    my ($self, $cart, $input) = @_;
-
+sub how :Tab(&how_tab) ($self, $cart, $input, @) {
     my %methods = %{ $self->{deposit_methods} };
 
     my $how = $self->{how} = $methods{$input}
@@ -41,18 +46,27 @@ sub how :Tab(&how_tab) {
         return shift @{ $how->{prompts} }, \&how_prompt;
     }
 
-    $cart->add(+$self->{amount}, $how->{description}, { is_deposit => 1, method => $how->{_key} });
+    if ( ($input eq "iban") && ($self->{amount} < 10 || $self->{amount} == 25) ) {
+        return REJECT, "\n\e[31;1mPlease transfer at least 10 EUR and not 25 or 32 EUR when using iban\e[0m\n\n";
+    }
+
+    my $contra = 
+          $how->{_key} eq 'cash'      ? '-cash'
+        : $how->{_key} eq 'reimburse' ? '-expenses/reimbursed'
+        :                               "-deposits/$how->{_key}";
+
+    $cart
+        ->add(+$self->{amount}, $how->{description}, { is_deposit => 1, method => $how->{_key} })
+        ->add_contra($contra, -$self->{amount}, "$how->{description} by \$you");
+
     return ACCEPT;
 }
 
-sub how_tab {
-    my ($self) = @_;
+sub how_tab($self, @) {
     return keys %{ $self->{deposit_methods} };
 }
 
-sub how_prompt {
-    my ($self, $cart, $input) = @_;
-
+sub how_prompt($self, $cart, $input, @) {
     my $how = $self->{how};
 
     push @{ $how->{answers} }, $input;
@@ -62,7 +76,11 @@ sub how_prompt {
     }
 
     my $desc = sprintf $how->{description}, @{ $how->{answers} };
+    my $contra = $how->{_key} eq 'cash' ? '-cash' : "-deposits/$how->{_key}";
+
+    $cart
+        ->add(+$self->{amount}, $desc, { is_deposit => 1, method => $how->{_key} })
+        ->add_contra($contra, -$self->{amount}, "$desc by \$you");
 
-    $cart->add(+$self->{amount}, $desc, { is_deposit => 1, method => $how->{_key} });
     return ACCEPT;
 }

plugins/deposit_iban_qr

@@ -20,14 +20,10 @@
 use IPC::Open2 qw(open2);
 use List::Util qw(sum);
 
-my $iban = "NL99ABCD1234567890";
-my $beneficiary = "Account Name";
-
-sub command { NEXT }
-
-sub hook_checkout {
-    my ($class, $cart, $user, $transaction_id) = @_;
+my $iban = "NL89RABO0111741386";
+my $beneficiary = "Stichting Bitlair";
 
+sub hook_checkout($class, $cart, $user, $transaction_id, @) {
     my @entries = $cart->entries("is_deposit");
 
     my $amount = sum map $_->{amount}, grep $_->attribute('method') eq 'iban', @entries;
@@ -45,7 +41,7 @@ sub hook_checkout {
             "EUR" . $amount,      # Amount
             "",
             "",
-            "rb $user",
+            "Deposit $user (RB QR)",
             "",
         );
         close $in;
@@ -56,11 +52,13 @@ sub hook_checkout {
 
         waitpid($pid, 0);
 
-        $lines[1] =~ s/$/ Note: ASN, Bunq, ING, and SNS are/;
-        $lines[2] =~ s/$/ the only Dutch banks that support/;
-        $lines[3] =~ s/$/ these EPC QR codes./;
+        $lines[1] =~ s/$/ Note: Bunq and ING are the only/;
+        $lines[2] =~ s/$/ Dutch banks that support these/;
+        $lines[3] =~ s/$/ EPC QR codes. N26 also works./;
         $lines[5] =~ s/$/ For manual transfers, use this/;
         $lines[6] =~ s/$/ IBAN: $iban/;
+        $lines[7] =~ s/$/ Benificiary: $beneficiary/;
+        $lines[8] =~ s/$/ Description: Deposit $user/;
 
         print @lines;
     }

plugins/deposit_methods

@@ -1,18 +1,15 @@
 #!perl
 
-sub command { NEXT }
-
-sub hook_deposit_methods {
-    my ($class, $message, $hash) = @_;
-
+sub hook_deposit_methods($class, $message, $hash, @) {
     $$message =  <<"END";
 
 Please type one of the following:
 
-'iban':      IBAN transfer (NL 69 ABNA 0431 1582 07)
+'iban':      IBAN transfer (Min 10 EUR / NL89 RABO 0111 7413 86)
 'cash':      Cash in the cash box
 'reimburse': Reimbursement of expenses agreed upon in advance
-             Note: we require an invoice or receipt with this exact amount!
+             Note #1: we require an invoice or receipt with this exact amount!
+             Note #2: please do not use this plugin for amounts >20 EUR
 'other':     Provide a manual description
 END
 

plugins/deprecated_raw

@@ -0,0 +1,10 @@
+#!perl
+
+sub command :Tab(withdraw) ($self, $cart, $command, @) {
+    if (defined eval { parse_amount($command) }) {
+        warn "Note: raw amounts for withdrawal or unlisted products are no longer supported.\n\n";
+        warn "Please use the 'withdraw' command to take money out of your revbank account, or\n";
+        warn "the 'unlisted' command to pay for an unlisted product.\n\n";
+    }
+    return NEXT;
+}

plugins/dinnerbonus

@@ -4,9 +4,7 @@ HELP "dinnerbonus" => "Add fee for cooking supplies";
 
 my $bonus = 1.00;
 
-sub command :Tab(kookbonus,dinnerbonus) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(kookbonus,dinnerbonus) ($self, $cart, $command, @) {
     my @users = map $_->{user}, map $_->contras, $cart->entries('is_take');
 
     (@users and $command eq 'kookpotje')  # common mistake promoted to feature

plugins/edit

@@ -0,0 +1,13 @@
+#!perl
+
+HELP "edit" => "Edit product list";
+
+my $filename = 'revbank.products';
+
+sub command :Tab(edit) ($self, $cart, $command, @) {
+    $command eq 'edit' or return NEXT;
+
+    require RevBank::TextEditor;
+    RevBank::TextEditor::edit($filename);
+    return ACCEPT;
+}

plugins/give

@@ -2,46 +2,39 @@
 
 HELP "give <account> <amount> [<reason>]" => "Transfer money to user's account";
 
-sub command :Tab(give) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(give) ($self, $cart, $command, @) {
     return NEXT if $command ne 'give';
 
     return "Beneficiary", \&beneficiary;
 }
 
-sub beneficiary :Tab(USERS) {
-    my ($self, $cart, $input) = @_;
-
+sub beneficiary :Tab(USERS) ($self, $cart, $input, @) {
     $self->{beneficiary} = parse_user($input)
         or return REJECT, "$input: No such user.";
 
     return "Amount to give to $self->{beneficiary}", \&amount;
 }
 
-sub amount {
-    my ($self, $cart, $input) = @_;
-
+sub amount($self, $cart, $input, @) {
     $self->{amount} = parse_amount($input)
         or return REJECT, "$input: Invalid amount.";
 
-    return "Why are you giving $self->{amount} to $self->{beneficiary}, or enter your username to end", \&reason;
+    return "Short description ('x' for no message)", \&reason;
 }
 
-sub reason :Tab(whatevah) {
-    my ($self, $cart, $input) = @_;
+sub reason :Tab(whatevah) ($self, $cart, $input, @) {
+    return REJECT, "'$input' is a username, not a description :)."
+        if parse_user($input);
+    return REJECT, "'$input' is an amount, not a description :)."
+        if parse_amount($input);
 
     my $beneficiary = $self->{beneficiary};
     my $amount = $self->{amount};
-
-    my $user = parse_user($input);
-    my $reason = $user ? "" : " ($input)";
+    my $reason = $input =~ /^x?$/ ? "" : " ($input)";
 
     $cart
-        ->add(-$amount, "Given to $beneficiary" . $reason)
+        ->add(-$amount, "Give to $beneficiary" . $reason)
         ->add_contra($beneficiary, +$amount, "Received from \$you" . $reason);
 
-    $cart->checkout($user) if $user;
-
     return ACCEPT;
 }

plugins/grandtotal

@@ -2,24 +2,24 @@
 
 HELP "grandtotal" => "Summary of all accounts";
 
-sub command :Tab(grandtotal) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(grandtotal) ($self, $cart, $command, @) {
     return NEXT if $command ne 'grandtotal';
 
     my $pos = 0;
     my $neg = 0;
 
-    open my $fh, "<", "revbank.accounts";
-    while (defined(my $line = readline $fh)) {
-        my $credit = (split " ", $line)[1];
+    for my $line (slurp 'revbank.accounts') {
+        my ($username, $balance) = split " ", $line;
+        next if RevBank::Users::is_special($username);
+
+        my $credit = RevBank::Amount->parse_string($balance) or next;
         $neg += $credit if $credit < 0;
         $pos += $credit if $credit > 0;
     }
 
-    printf "Total positive: %8.2f\n", $pos;
-    printf "Total negative: \e[31;1m%8.2f\e[0m\n", $neg;
-    printf "GRAND TOTAL:    \e[1m%8.2f\e[0m\n", $pos + $neg;
+    printf "Total positive: %8s\n", $pos;
+    printf "Total negative: \e[31;1m%8s\e[0m\n", $neg;
+    printf "GRAND TOTAL:    \e[1m%8s\e[0m\n", $pos + $neg;
 
     return ACCEPT;
 }

plugins/help

@@ -1,6 +1,6 @@
 #!perl
 
-HELP "help" => "The stuff you're looking at right now :)";
+HELP1 "help2" => "Advanced usage instructions";
 
 use List::Util qw(max);
 
@@ -8,29 +8,17 @@ my $bold = "\e[1m";
 my $underline = "\e[4m";
 my $off = "\e[0m";
 
-sub command :Tab(help,wtf,omgwtfbbq) {
-    my ($self, $cart, $command) = @_;
+sub command :Tab(help,help2,wtf,omgwtfbbq) ($self, $cart, $command, @) {
+    return NEXT if $command !~ /^(?:help2?|wtf|omgwtfbbq)$/;
 
-    return NEXT if $command !~ /^(?:help|wtf|omgwtfbbq)$/;
-
-    # GNU less(1) and more(1) are a bad choice to present to total newbies who
-    # might have no interest in learning to use these surprisingly powerful
-    # tools, so I will not accepting patches to use either of those, or to use
-    # the PAGER environment variable (because that will typically be set to
-    # either one of those by default). For example, typing "v" will excute
-    # vi...
-    # On the other hand, busybox(1) has a "more" applet that gives the user
-    # clear instructions and seems mostly harmless too.
-    my $pipe;
-    if (open $pipe, "|-", "busybox", "more") {
-        select $pipe;
-    }
+    my $help2 = $command =~ /help2/;
+    my $hash = $help2 ? \%::HELP : \%::HELP1;
 
     say "\n${bold}Valid commands:${off}";
 
-    my $width = max(map length s/[<>]//rg, keys %::HELP);
+    my $width = max(map length s/[<>]//rg, keys %$hash);
 
-    for my $command (sort keys %::HELP) {
+    for my $command (sort keys %$hash) {
         my $display = $command;
 
         my $length = length $display =~ s/[<>]//rg;
@@ -41,18 +29,19 @@ sub command :Tab(help,wtf,omgwtfbbq) {
         # Because of markup codes, a simple %-42s doesn't work.
         $display .= " " x ($width - $length);
 
-        say sprintf "  %s %s", $display, $::HELP{$command};
+        say sprintf "  %s  %s", $display, $hash->{$command};
     }
 
+    my $advanced = $help2
+        ? "${bold}Advanced usage:${off} pass space separated arguments to parameters"
+        : "";  # Line intentionally left blank
+
     print <<"END";
 
 ${bold}Simple usage:  ${off} press <Enter> after a command for follow-up prompts
-${bold}Advanced usage:${off} pass space separated arguments to parameters
+$advanced
 Complete each transaction with ${underline}account${off} (i.e. enter your name).
 END
 
-    select STDOUT;
-    close $pipe;
-
     return ACCEPT;
 }

plugins/idle

@@ -1,31 +1,36 @@
 #!perl
 
 my $timeout = 10;
+my $text_displayed = 0;
 
-sub command { NEXT }
-
-sub hook_prompt_idle {
-    my ($class, $cart, $plugin, $seconds, $readline) = @_;
-    if ($seconds >= $timeout and $cart->size and not $plugin) {
-        call_hooks("beep");
-
-        return if $seconds > $timeout;  # text only once
-
-        my $text = $readline->copy_text;
-        my $point = $readline->{point};
-
-        $readline->save_prompt;
-        $readline->replace_line("");
-        $readline->redisplay;
-
-        my $help = $cart->entries('refuse_checkout')
-            ? "Enter 'abort' to abort."
-            : "Enter username to pay/finish or 'abort' to abort.";
-        print "\e[33;2;1mTransaction incomplete.\e[0m $help\n";
-
-        $readline->restore_prompt;
-        $readline->replace_line($text);
-        $readline->{point} = $point;
-        $readline->redisplay;
-    }
+sub hook_prompt($class, $cart, $prompt, @) {
+    $text_displayed = 0;
+}
+
+sub hook_prompt_idle($class, $cart, $plugin, $seconds, $readline, @) {
+    return unless $seconds >= $timeout and $cart->size and not $plugin;
+
+    call_hooks("beep");
+
+    return if $text_displayed;
+    $text_displayed = 1;
+
+    my $text = $readline->copy_text;
+    my $point = $readline->{point};
+
+    $readline->save_prompt;
+    $readline->replace_line("");
+    $readline->redisplay;
+
+    my $verb = $cart->sum < 0 ? "pay" : "finish";
+
+    my $help = $cart->entries('refuse_checkout')
+        ? "Enter 'abort' to abort."
+        : "Enter username to $verb or 'abort' to abort.";
+    print "\e[33;4;1mTransaction incomplete.\e[0m $help\n";
+
+    $readline->restore_prompt;
+    $readline->replace_line($text);
+    $readline->{point} = $point;
+    $readline->redisplay;
 }

plugins/json

@@ -0,0 +1,91 @@
+#!perl
+
+=head1 CAVEATS
+
+This module requires the Perl module "JSON" to be installed.
+
+Note that cent amounts are emitted as strings, not floats. This is on purpose.
+They are, however, in a format that is easy to parse and convert (e.g.
+JavaScript "parseFloat").
+
+Note that things may be happening that don't have any JSON output.
+
+Note that if plugins explicitly print to STDOUT, that will break the JSON
+output. Regular print (without specified filehandle) will be suppressed.
+
+Note that one command line may result in several separate transactions.
+
+Note that plugins don't know it's non-interactive, and will often emit
+RETRY instead of REJECT.
+
+Note that this plugin will always be highly experimental; re-evaluate your
+assumptions when upgrading. :)
+
+This plugin is intended to be used together with "revbank -c 'command line'",
+but you could try to use it interactively; if you do, please let me know about
+your use case.
+
+Set the environment variable REVBANK_JSON to either "array" or "lines" (see
+jsonlines.org).
+
+=cut
+
+use JSON;
+my $json = JSON->new->utf8->convert_blessed->canonical;
+
+BEGIN {
+    if ($ENV{REVBANK_JSON} and $ENV{REVBANK_JSON} =~ /^(?:array|lines)$/) {
+        my $array = $ENV{REVBANK_JSON} eq "array";
+
+        # Suppress normal print output
+        open my $null, ">", "/dev/null";
+        select $null;
+
+        print STDOUT "[\n" if $array;
+
+        my $count = 0;
+        *_log = sub($hash) {
+            # JSON does not allow trailing commas, argh
+            print STDOUT ",\n" if $array and $count++;
+            print STDOUT $json->encode($hash);
+            print STDOUT "\n" if not $array;
+        };
+
+        END { print STDOUT "\n]\n" if $array }
+
+        # Monkey patch
+        *RevBank::Amount::TO_JSON = sub($self, @) {
+            $self->string("+");
+        };
+    } else {
+        *_log = sub { };
+    }
+}
+
+
+sub hook_abort(@) {
+    _log({ _ => "ABORT" });
+}
+
+sub hook_reject($class, $plugin, $reason, $abort, @) {
+    _log({ _ => "REJECT", plugin => $plugin, reason => $reason, abort => $abort });
+}
+
+sub hook_retry($class, $plugin, $reason, $abort, @) {
+    _log({ _ => "RETRY", plugin => $plugin, reason => $reason, abort => $abort });
+}
+
+sub hook_user_created($class, $username, @) {
+    _log({ _ => "NEWUSER", account => $username });
+}
+
+# NB: stringify transaction_id because future ids might not be numeric.
+
+sub hook_user_balance($class, $user, $old, $delta, $new, $transaction_id, @) {
+    _log({ _ => "BALANCE", account => $user, old => $old, delta => $delta, new => $new, transaction_id => "$transaction_id" });
+}
+
+sub hook_checkout($class, $cart, $username, $transaction_id, @) {
+    _log({ _ => "CHECKOUT", account => $username, transaction_id => "$transaction_id" });
+}
+

plugins/log

@@ -1,58 +1,58 @@
 #!perl
 
-sub command { NEXT }
-
 my $filename = ".revbank.log";
 
-sub _log {
-    open my $fh, '>>', $filename or warn "$filename: $!";
-    print $fh now(), " ", @_, "\n";
-    close $fh or warn "$filename: $!";
+sub _log($tag, @message) {
+    @message = ("") if not @message;
+
+    append $filename, map(s/^/now() . " $tag "/rgme, @message), "\n";
 }
 
 my %buffer;
-sub hook_abort {
+sub hook_abort(@) {
     _log("ABORT");
 }
-sub hook_prompt {
-    my ($class, $cart, $prompt) = @_;
+sub hook_prompt($class, $cart, $prompt, @) {
     $buffer{prompt} = $prompt;
 }
-sub hook_input {
-    my ($class, $cart, $input, $split_input) = @_;
+
+sub hook_input($class, $cart, $input, $split_input, @) {
     $input //= "(UNDEF)";
-    _log("PROMPT $buffer{prompt} >> $input");
+    $input = "(EMPTY)" if not length $input;
+    _log(PROMPT => "$buffer{prompt} >> $input");
 }
 
-sub hook_reject {
-    my ($class, $plugin, $reason, $abort) = @_;
-    _log("REJECT [$plugin] $reason");
+sub hook_reject($class, $plugin, $reason, $abort, @) {
+    _log(REJECT => "[$plugin] $reason");
 }
 
-sub hook_retry {
-    my ($class, $plugin, $reason, $abort) = @_;
-    _log("RETRY [$plugin] $reason");
+sub hook_retry($class, $plugin, $reason, $abort, @) {
+    _log(RETRY => "[$plugin] $reason");
 }
 
-sub hook_user_created {
-    my ($class, $username) = @_;
-    _log("NEWUSER $username");
+sub hook_user_created($class, $username, @) {
+    _log(NEWUSER => "$username");
 }
 
-sub hook_user_balance {
-    my ($class, $user, $old, $delta, $new, $transaction_id) = @_;
+sub hook_user_balance($class, $user, $old, $delta, $new, $transaction_id, @) {
     my $lost = $delta < 0 ? "lost" : "got";
     $delta = $delta->abs;
     $_ = $_->string("+") for $old, $new;
-    _log("BALANCE $transaction_id $user had $old, $lost $delta, now has $new");
+    _log(BALANCE => "$transaction_id $user had $old, $lost $delta, now has $new");
 }
 
-sub hook_checkout {
-    my ($class, $cart, $username, $transaction_id) = @_;
-    _log("CHECKOUT $transaction_id $_") for map $_->as_loggable, $cart->entries;
+sub hook_checkout($class, $cart, $username, $transaction_id, @) {
+    _log(CHECKOUT => "$transaction_id $_") for map $_->as_loggable, $cart->entries;
 }
 
-sub hook_register {
-    my ($class, $plugin) = @_;
-    _log("REGISTER $plugin");
+sub hook_log_warning($class, $message, @) {
+    _log(WARNING => $message);
+}
+
+sub hook_log_error($class, $message, @) {
+    _log(ERROR => $message);
+}
+
+sub hook_log_info($class, $message, @) {
+    _log(INFO => $message);
 }

plugins/market

@@ -4,10 +4,9 @@ HELP "market" => "Edit market list";
 
 my $filename = 'revbank.market';
 
-sub _read_market {
-    open my $fh, '<', $filename or die "$filename: $!";
+sub _read_market() {
     my %market;
-    while (readline $fh) {
+    for (slurp $filename) {
         /^\s*#/ and next;
         /\S/ or next;
         chomp;
@@ -22,11 +21,10 @@ sub _read_market {
     return \%market;
 }
 
-sub command :Tab(market,&tab) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(market,&tab) ($self, $cart, $command, @) {
     if ($command eq 'market') {
-        system $ENV{EDITOR} || 'vi', $filename;
+        require RevBank::TextEditor;
+        RevBank::TextEditor::edit($filename);
         return ACCEPT;
     }
 
@@ -37,24 +35,22 @@ sub command :Tab(market,&tab) {
     my $space    = parse_amount($product->{ space })  or return NEXT;
     my $description = $product->{description};
 
-    my @existing = grep {
-        $_->attribute('plugin') eq $self->id and
-        $_->attribute('product_id') eq $command
-    } $cart->entries('plugin');
-
-    if (@existing) {
-        $existing[0]->quantity($existing[0]->quantity + 1);
-        return ACCEPT;
-    }
-
     $cart->add(
         -($seller + $space),
         "$description (sold by $username)",
-        { product_id => $command, plugin => $self->id }
+        {
+            product_id => $command,
+            plugin => $self->id,
+            deduplicate => join("/", $self->id, $command),
+        }
     )->add_contra(
         $username,
         $seller,
         "\$you bought $description"
+    )->add_contra(
+        "+sales/market",
+        $space,
+        "\$you bought $description from $username"
     );
 
     return ACCEPT;

plugins/nomoney

@@ -0,0 +1,157 @@
+#!perl
+
+use List::Util qw(none uniqstr);
+
+my @deny_plugins = (
+	"give",
+	#"market",
+	#"products",
+	"take",
+	#"unlisted",
+	"withdraw",
+);
+
+my $allow_multi_user = 1;
+
+sub _derive_plugin($symbol) {
+	return $1 if $symbol =~ /^RevBank::Plugin::(\w+)::/;
+	return;
+}
+
+sub _inform($unresolved, $username, $skip_print = 0) {
+	call_hooks("beep");
+
+	say "Not possible:";
+
+	for my $entry ($unresolved->entries) {
+		unless ($skip_print) {
+			my $line = ($entry->as_printable)[0];
+			say $line;
+
+			$line =~ s/^\s+//;
+			call_hooks("log_info", "nomoney: $line");
+		}
+
+		my $broke_users = $entry->attribute('nomoney_users');
+
+		for my $account (sort keys %$broke_users) {
+			my $balance = RevBank::Users::balance($account);
+			
+			my $m = sprintf(
+				"%s have %s",
+				($account eq $username ? "You don't" : "$account doesn't"),
+				abs($broke_users->{$account}),
+			);
+
+			call_hooks("log_info", "nomoney: $m (balance: $balance)");
+			my $b = ($balance < 0 ? "\e[31;1m$balance\e[m" : $balance);
+			say "\e[31;1m$m\e[m (balance: $b)";
+		}
+	}
+}
+
+my %unresolved;  # to share state between hooks, keyed per real cart
+
+sub hook_checkout_prepare($class, $cart, $username, $transaction_id, @) {
+	my $unresolved = $unresolved{$cart} = RevBank::Cart->new;
+
+	my $deltas = $cart->deltas($username);
+	my %balances;
+
+	for my $account (keys %$deltas) {
+		next if $deltas->{$account} > 0;
+		next if RevBank::Users::is_special($account);
+
+		my $old = $balances{$account} = RevBank::Users::balance($account);
+		my $new = $old + $deltas->{$account};
+
+		next if $new >= 0 or $new > $old;
+
+		for my $entry ($cart->entries) {
+			my $plugin = $entry->attribute('plugin') // _derive_plugin($entry->{caller});
+			next if not $plugin;
+			next if none { $plugin eq $_ } @deny_plugins;
+
+			my @contra_users = uniqstr sort grep {
+				not RevBank::Users::is_special($_)
+				and $_ ne $username
+			} map {
+				$_->{user}
+			} $entry->contras;
+
+			next if $allow_multi_user and @contra_users > 1;
+			next if none { $account eq $_ } $entry->user // $username, @contra_users;
+
+			$unresolved->add_entry($entry);
+		}
+	}
+
+	return if not $unresolved->size;  # allow transaction as is
+
+	my $newline = 0;
+	if ($cart->changed) {
+		# Show original cart before changing it, if it hasn't been shown before
+		say "Pending:";
+		$cart->display;
+		$newline = 1;
+	}
+	$cart->delete($_) for @{ $unresolved->{entries} };
+
+	# Find entries that can be done, by brute force, and add them back.
+	RESOLVE: {
+		my $resolved_deltas = $cart->deltas($username);
+		my %resolved_balances = %balances;
+		$resolved_balances{$_} += $resolved_deltas->{$_} for keys %$resolved_deltas;
+
+		for my $entry ($unresolved->entries) {
+			my $single = RevBank::Cart->new;
+			$single->add_entry($entry);
+			my $trial_deltas = $single->deltas($username);
+
+			my %broke_users;
+			$entry->attribute('nomoney_users', \%broke_users);
+
+			for my $account (keys %$trial_deltas) {
+				next if RevBank::Users::is_special($account);
+				next if $trial_deltas->{$account} > 0;
+
+				my $trial_balance = $resolved_balances{$account} + $trial_deltas->{$account};
+				
+				if ($trial_balance < 0) {
+					$broke_users{$account} += $trial_deltas->{$account};
+				}
+			}
+
+			if (not %broke_users) {
+				$cart->add_entry($entry);
+				$unresolved->delete($entry);
+				redo RESOLVE;
+			}
+		}
+	}
+
+	if (not $cart->size) {
+		print "\n" if $newline;
+		_inform($unresolved, $username, 1);
+		return ABORT;
+	}
+
+	return;
+}
+
+sub hook_abort($class, $cart, @) {
+	delete $unresolved{$cart};
+	return;
+}
+
+sub hook_checkout_done($class, $cart, $username, $transaction_id, @) {
+	my $n = $unresolved{$cart}->size or return;
+	print "\n";
+
+	_inform($unresolved{$cart}, $username);
+	delete $unresolved{$cart};
+
+	my $message = $n == 1 ? "THIS ENTRY WAS IGNORED" : "THESE ENTRIES WERE IGNORED";
+	say "\e[1;4m$message.\e[0m" if $n;
+	return;
+}

plugins/openepaperlink

@@ -0,0 +1,91 @@
+#!perl
+use RevBank::Products qw(read_products);
+use FindBin qw($Bin);
+
+my $fn = ".revbank.oepl";
+my $hex = '[0-9A-F]';
+my $mac_regex = qr/^(?:$hex {12}|$hex {14}|$hex {16})$/x;
+
+sub _create() {
+	open my $fh, '>>', $fn;
+}
+
+sub _run(@args) {
+	local $ENV{REVBANK_SKIP_LOCK} = 1;
+	system perl => "$Bin/contrib/openepaperlink.pl", @args;
+}
+
+sub _read_oepl() {
+	return { map { (split " ")[0, 1] } slurp $fn };
+}
+
+sub _touch() {
+	utime undef, undef, $fn;
+}
+
+sub command :Tab(openepaperlink) ($self, $cart, $command, @) {
+	if ($command =~ $mac_regex) {
+		my $mac2product = _read_oepl;
+		return REDO, $mac2product->{$command} if exists $mac2product->{$command};
+	}
+
+	$command eq 'openepaperlink' or return NEXT;
+
+	return "Product ID (or 'unlink')", sub ($self, $cart, $product_id, @) {
+		my $product;
+
+		if ($product_id ne 'unlink') {
+			$product = read_products->{$product_id} or return REJECT, "No such product.";
+			$product_id = $product->{id};  # don't use alias
+		}
+
+		return "Tag MAC", sub ($self, $cart, $mac, @) {
+			$mac =~ $mac_regex or return REJECT, "Malformed MAC.";
+
+			_run erase => $mac if $product_id eq 'unlink';  # while it's still in the .oepl
+
+			_create;
+			my $found = 0;
+			rewrite $fn, sub($line) {
+				my ($m) = split " ", $line;
+				return $line if $m ne $mac;
+				$found++;
+				return undef if $product_id eq 'unlink';
+				return "$mac $product_id\n" if $m eq $mac;
+			};
+			if (!$found and $product_id ne 'unlink') {
+				append $fn, "$mac $product_id\n";
+			}
+			_run $mac unless $product_id eq 'unlink';
+
+			return ACCEPT;
+		};
+	};
+}
+
+sub hook_products_changed($class, $changes, $mtime, @) {
+	-f $fn or return;
+
+	return with_lock {
+		$mtime >= (stat $fn)[9] or return;
+
+		my @macs;
+		my %deleted;
+		my %product2mac = reverse %{ _read_oepl() };
+
+		for my $pair (@$changes) {
+			my ($old, $new) = @$pair;
+
+			my $id = defined($new) ? $new->{id} : $old->{id};
+			$product2mac{$id} or next;
+
+			push @macs, $product2mac{$id};
+		}
+		
+		@macs or return;
+		_run @macs;
+
+		sleep 1 if $mtime == time;
+		_touch;
+	};
+}

plugins/pfand

@@ -1,55 +0,0 @@
-#!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) {
-    my ($self, $cart, $command) = @_;
-
-    return NEXT if $command ne 'pfand';
-
-    return "Pfand zurueck fuer", \&product;
-}
-
-sub product :Tab(&tab) {
-    my ($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 {
-    my ($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;
-}
-

plugins/plus

@@ -1,45 +0,0 @@
-#!perl
-
-HELP "+<N>" => "Add N more items of the previous thing";
-
-my $limit = 200;
-my $err_limit = "Repetition is limited at $limit items.";
-my $err_pfand = "Plugins 'pfand' and 'repeat' cannot be combined.";
-
-sub command {
-    my ($self, $cart, $command) = @_;
-
-    return ABORT, $err_pfand if $cart->entries('is_pfand');
-
-    my ($post) = $command =~ /^\+(\d+)?$/
-        or return NEXT;
-
-    return ABORT, "Can't modify an empty transaction." if not $cart->size;
-
-    my $last = ($cart->entries)[-1];
-
-    return REJECT, "Addition only works on products." if not $last->has_attribute('product_id');
-
-    if ($post) {
-        return REJECT, $err_limit if $last->quantity + $post > $limit;
-
-        $last->quantity($last->quantity + $post);
-        return ACCEPT;
-    }
-
-    return "Add to previous product", \&add;
-}
-
-sub add {
-    my ($self, $cart, $arg) = @_;
-
-    $arg =~ /^\d+$/ and $arg > 0
-        or return REJECT, "Invalid value.";
-
-    my $last = ($cart->entries)[-1];
-    return REJECT, $err_limit if $last->quantity + $arg > $limit;
-
-    $last->quantity($last->quantity + $arg);
-    return ACCEPT;
-}
-

plugins/products

@@ -1,57 +1,53 @@
 #!perl
+use RevBank::Products qw(read_products);
 
-HELP "<productID>" => "Look up products from database";
-HELP "edit" => "Edit product list";
+HELP1 "<productID>" => "Add a product to pending transaction";
 
-my $filename = 'revbank.products';
+sub command :Tab(&tab) ($self, $cart, $command, @) {
+    $command =~ /\S/ or return NEXT;
+    $command =~ /^\+/ and return NEXT;
 
-sub _read_products {
-    open my $fh, '<', $filename or die "$filename: $!";
-    my %products;
-    while (readline $fh) {
-        /^\s*#/ and next;
-        /\S/ or next;
-        chomp;
-        my ($ids, $p, $d) = split " ", $_, 3;
-        my @ids = split /,/, $ids;
+    my $products = read_products;
 
-        $products{ $_ } = { id => $ids[0], price => $p, description => $d}
-            for @ids;
-    }
+    my $product = $products->{ $command } or return NEXT;
+    my $price = $product->{price};
 
-    return \%products;
-}
-
-sub command :Tab(edit,&tab) {
-    my ($self, $cart, $command) = @_;
-
-    if ($command eq 'edit') {
-        system $ENV{EDITOR} || 'vi', $filename;
-        return ACCEPT;
-    }
-
-    my $product = _read_products->{ $command } or return NEXT;
-
-    my $price = parse_amount( $product->{price} ) or return NEXT;
-
-    my @existing = grep {
-        $_->attribute('plugin') eq $self->id and
-        $_->attribute('product_id') eq $product->{id}
-    } $cart->entries('plugin');
-
-    if (@existing) {
-        $existing[0]->quantity($existing[0]->quantity + 1);
-        return ACCEPT;
-    }
-
-    $cart->add(
-        -$price,
+    my $entry = $cart->add(
+        -$product->{total_price},
         $product->{description},
-        { product_id => $product->{id}, plugin => $self->id }
+        {
+            product_id => $product->{id},
+            plugin => $self->id,
+            product => $product,
+            deduplicate => join("/", $self->id, $product->{id}),
+        }
     );
+
+    my $contra_desc = "\$you bought $product->{description}";
+    my @addons = @{ $product->{addons} // [] };
+    my $display = undef;
+    $display = "Product"       if @addons and $price->cents > 0;
+    $display = "Reimbursement" if @addons and $price->cents < 0;
+
+    $entry->add_contra(
+        $product->{contra},
+        +$price,
+        $contra_desc,
+        $display
+    );
+
+    for my $addon (@addons) {
+        $entry->add_contra(
+            $addon->{contra},
+            $addon->{price},
+            "$addon->{description} ($contra_desc)",
+            $addon->{description}
+        );
+    }
+
     return ACCEPT;
 }
 
 sub tab {
-    return grep /\D/, keys %{ _read_products() };
+    return grep !/^\+/, grep /\D/, keys %{ read_products() };
 }

plugins/products.pod

@@ -0,0 +1,17 @@
+=head1 NAME
+
+products - RevBank plugin for selling products
+
+=head1 DESCRIPTION
+
+This plugin turns products from the product list into RevBank commands,
+that add the respective products as Entries to the current Cart.
+
+Note that by design, RevBank does not depend on this plugin or the products
+list that is shared between some of the plugins. It is possible to use a
+different source of products (e.g. an external database) in addition to, or
+instead of, this plugin.
+
+=head1 CONFIGURATION
+
+See the documentation for C<RevBank::Products> (hint: in C<lib/>).

plugins/regex_angel

@@ -0,0 +1,4 @@
+sub command($self, $cart, $command, @) {
+	return REDO, $1 if $command =~ /^angel-(.*)/;
+	return NEXT;
+}

plugins/regex_gtin

@@ -0,0 +1,45 @@
+use List::Util qw(sum);
+
+my @regexes = (
+	qr[^https?://.*?/01/(\d{14})\b],     # GS1 Digital Link with GTIN-14
+	qr[^https?://.*?/01/0(\d{13})\b],    # GS1 Digital Link with GTIN-13
+	qr[^https?://.*?/01/00(\d{12})\b],   # GS1 Digital Link with GTIN-12
+	qr[^https?://.*?/01/0{6}(\d{8})\b],  # GS1 Digital Link with GTIN-8
+
+	# "Compressed" GS1 Digital Links are not supported, as the current draft
+	# specification is insanely complex: it involves base64 and hexadecimal
+	# strings, binary data that isn't octet-aligned, and a vast number of
+	# lookup tables, all of which are needed just to extract the GTIN. One can
+	# only hope that this scheme to save a few bytes will never catch on.
+
+	qr[^\(01\)(\d{14})\b],     # GS1 Element String with GTIN-14
+	qr[^\(01\)0(\d{13})\b],    # GS1 Element String with GTIN-13
+	qr[^\(01\)00(\d{12})\b],   # GS1 Element String with GTIN-12
+	qr[^\(01\)0{6}(\d{8})\b],  # GS1 Element String with GTIN-8
+
+	qr[^01(\d{14})(?=\d|$)],     # GS1-128 (without FNC) with GTIN-14
+	qr[^010(\d{13})(?=\d|$)],    # GS1-128 (without FNC) with GTIN-13
+	qr[^0100(\d{12})(?=\d|$)],   # GS1-128 (without FNC) with GTIN-12
+	qr[^010{6}(\d{8})(?=\d|$)],  # GS1-128 (without FNC) with GTIN-8
+
+	qr[^https://\w+url\.com/(?:q/|q/srn|srn)(\d{13})]i,  # spam with GTIN-13
+);
+
+sub command ($self, $cart, $command, @) {
+	$self->{orig_command} //= $command;
+	$self->{regexes} //= [ @regexes ];
+
+	while (my $regex = shift @{ $self->{regexes} }) {
+		if ($self->{orig_command} =~ $regex) {
+			my $gtin = $1;
+
+			my @digits = reverse split //, $gtin;
+			my $checksum = (10 - sum(map $digits[$_] * ($_ % 2 ? 3 : 1), 1..$#digits) % 10) % 10;
+			$digits[0] == $checksum or next;
+
+			return REDO, $gtin;
+		}
+	}
+
+	return NEXT;
+}

plugins/repeat

@@ -1,6 +1,7 @@
 #!perl
 
-HELP "*<N>, x<N>, <N>x, <N>*" => "Repeat previous/next product N times";
+HELP "<N>x, <N>*" => "Set quantity of previous/next product";
+HELP "-<N>, +<N>, *<N>, x<N>" => "Change quantity of previous product";
 
 my $err_stacked = "Stacked repetition is not supported.";
 my $err_pfand = "Plugins 'pfand' and 'repeat' cannot be combined.";
@@ -10,21 +11,32 @@ my $err_postfix = "Addition/substraction is only supported the other way around.
 my $limit = 200;
 my $err_limit = "Repetition is limited at $limit items.";
 
-sub command {
-    my ($self, $cart, $command) = @_;
-
-    return ABORT, $err_pfand if $cart->entries('is_pfand');
-
+sub command($self, $cart, $command, @) {
     my ($lhs, $op, $rhs) = $command =~ /^(\d+)?([x*+-])(\d+)?$/
         or return NEXT;
 
-    my $last = ($cart->entries)[-1];
+    return ABORT, $err_pfand if $cart->entries('is_pfand');
 
-    return NEXT if $lhs and $rhs;  # 123x123 -> invalid syntax
+    my $last = $cart->selected;
+
+    return NEXT if $lhs and $rhs;  # 123x123 -> invalid, likely user or product
+
+    if ($lhs) {
+        return REJECT, $err_postfix if $op eq '+' or $op eq '-';
+
+        $lhs = abs $lhs;  # withdrawal is negative
+
+        return REJECT, $err_limit if $lhs > $limit;
+        $cart
+            ->add(0, "?  (The next thing you add will be multiplied.)", { _repeat => 1, refuse_checkout => 1 })
+            ->quantity($lhs);
+        return ACCEPT;
+    }
+
+    return ABORT, "Can't modify an empty transaction." if not $cart->size;
+    return REJECT, $err_nope if $last->attribute('no_repeat');
 
     if ($rhs) {
-        return ABORT, "Can't modify an empty transaction." if not $cart->size;
-        return REJECT, $err_nope if $last->attribute('no_repeat');
         return REJECT, $err_limit if $rhs > $limit;
 
         if ($op eq '+') {
@@ -44,67 +56,38 @@ sub command {
             }
             return ACCEPT;
         }
+
         # $op is not + or -, so it must be * (or x).
-
         return REJECT, $err_stacked if $last->multiplied;
-
         $last->quantity($rhs);
         return ACCEPT;
     }
 
-    if (not $lhs and not $rhs) {
-        # Lone operator. Convert withdrawal into repetition.
-
-        return ABORT, "Can't modify an empty transaction." if not $cart->size;
-
-        if ($op eq '+' or $op eq '-') {
-            $self->{op} = $op;
-            return "$op how many?",  \&plusminus;
-        }
-
-        if ($last->has_attribute('is_withdrawal')) {
-            $lhs = $last->{amount}->abs->float;
-            $lhs == int $lhs or return REJECT, "Repeat only works on integers.";
-            $cart->delete($last);
-        }
-    }
-
-    if ($lhs) {
-        return REJECT, $err_postfix if $op eq '+' or $op eq '-';
-
-        $lhs = abs $lhs;  # withdrawal is negative
-
-        return REJECT, $err_limit if $lhs > $limit;
-        $cart
-            ->add(0, "?  (The next thing you add will be multiplied.)", { _repeat => 1, refuse_checkout => 1 })
-            ->quantity($lhs);
-        return ACCEPT;
+    if ($op eq '+' or $op eq '-') {
+        $self->{op} = $op;
+        return "$op how many?", \&plusminus;
     }
 
+    # $op is not + or -, so it must be * (or x).
     return REJECT, $err_stacked if $last->multiplied;
-    return REJECT, $err_nope if $last->attribute('no_repeat');
     return "Multiply previous product by", \&repeat;
 }
 
-sub repeat {
-    my ($self, $cart, $arg) = @_;
-
+sub repeat($self, $cart, $arg, @) {
     $arg =~ /^\d+$/ and $arg > 0
         or return REJECT, "Invalid value.";
 
     return REJECT, $err_limit if $arg > $limit;
 
-    ($cart->entries)[-1]->quantity($arg);
+    $cart->selected->quantity($arg);
     return ACCEPT;
 }
 
-sub plusminus {
-    my ($self, $cart, $arg) = @_;
-
+sub plusminus($self, $cart, $arg, @) {
     $arg =~ /^\d+$/ and $arg > 0
         or return REJECT, "Invalid value.";
 
-    my $last = ($cart->entries)[-1];
+    my $last = $cart->selected;
     my $new = $last->quantity;
     $new += $arg if $self->{op} eq '+';
     $new -= $arg if $self->{op} eq '-';
@@ -114,13 +97,12 @@ sub plusminus {
         $cart->delete($last);
         print "Deleted.\n";
     } else {
-        ($cart->entries)[-1]->quantity($new);
+        $cart->selected->quantity($new);
     }
     return ACCEPT;
 }
 
-sub hook_added_entry {
-    my ($self, $cart, $entry) = @_;
+sub hook_added_entry($class, $cart, $entry, @) {
     $cart->size >= 2 or return;
 
     my @entries = $cart->entries;

plugins/restart

@@ -1,27 +1,15 @@
 #!perl
 
+
 HELP "restart" => "Attempt to restart the RevBank shell";
 
-sub command :Tab(restart) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(restart) ($self, $cart, $command, @) {
     return NEXT if $command ne 'restart';
 
-    no warnings;
     call_hooks("restart_exec");
+    no warnings qw(exec);
     exec $0;
     call_hooks("restart_survived");
 
     return ABORT, "exec() failed. You'll have to restart revbank yourself :P";
 }
-
-sub hook_input {
-    my ($self, $cart, $input, $split_input) = @_;
-
-    return if defined $input;
-
-    no warnings;
-    call_hooks("restart_restart");
-    exec $0;
-    call_hooks("restart_survived");
-}

plugins/revspace_barcode

@@ -7,29 +7,35 @@
 
 
 
-sub command :Tab(barcode) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(barcode) ($self, $cart, $command, @) {
     return NEXT if $command ne "barcode";
 
     return "Barcode data", \&data;
 }
 
-sub data {
-    my ($self, $cart, $input) = @_;
+sub data($self, $cart, $input, @) {
+    my $price = 0.07;
 
-    $cart->add(
-        -0.07,
-        "Barcode <$input>",
-        { is_barcode => 1, barcode_data => $input }
-    );
+    $cart
+        ->add(
+            -$price,
+            "Barcode <$input>",
+            {
+                is_barcode => 1,
+                barcode_data => $input,
+                deduplicate => join("/", $self->id, $input),
+            }
+        )
+        ->add_contra(
+            "+sales/barcodes",
+            +$price,
+            "\$you bought barcode <$input>"
+        );
 
     return ACCEPT;
 }
 
-sub hook_checkout {
-    my ($class, $cart, $username, $transaction_id) = @_;
-
+sub hook_checkout($class, $cart, $username, $transaction_id, @) {
     my @barcodes;
     for my $entry ($cart->entries('is_barcode')) {
         push @barcodes, ($entry->attribute('barcode_data')) x $entry->quantity;

plugins/revspace_bounties

@@ -1,20 +0,0 @@
-#!perl
-
-my %bounties = (
-    1 => [ 10, "Bedankt voor het vegen/stofzuigen" ],
-    2 => [ 10, "Bedankt voor het afvoeren van het afval" ],
-    3 => [ 25, "Bedankt voor het dweilen" ],
-    4 => [ 15, "Bedankt voor 't poetsen van alle tafels" ],
-);
-
-sub command :Tab(BOUNTY1,BOUNTY2,BOUNTY3,BOUNTY4) {
-    my ($self, $cart, $command) = @_;
-
-    if ($command =~ /BOUNTY(\d+)/) {
-        $cart->add(+$bounties{$1}[0], $bounties{$1}[1]);
-        return ACCEPT;
-    }
-
-    return NEXT;
-}
-

plugins/revspace_cokeurl

@@ -0,0 +1,8 @@
+# Accept the odd QR-codes on Coke (and Fanta, etc.) cans, as they also contain the EAN.
+
+# For this plugin to be useful, it needs to be BEFORE "users" in "revbank.plugins".
+
+sub command {
+    $_[2] =~ s@^https?://(coke|fanta)url.com/q/srn@@gi;  # input is actually a mutable string
+    return NEXT;
+}

plugins/revspace_git

@@ -1,9 +1,6 @@
 #!perl
 
-sub command { NEXT }
-
-sub hook_user_balance {
-    my ($class, $username, $old, $delta, $new, $transaction_id) = @_;
+sub hook_user_balance($class, $username, $old, $delta, $new, $transaction_id, @) {
     my $msg = "$transaction_id ($username)";
     $msg =~ s/[^\x20-\x7E]//g;
     $msg =~ s/'//g;

plugins/revspace_lasercutter

@@ -0,0 +1,30 @@
+#!perl
+
+my $cost = 2.50;
+
+sub command :Tab(lasercutter) ($self, $cart, $command, @) {
+    $command eq 'lasercutter' or return NEXT;
+
+    return "How long did you use the machine? (h:mm)", \&time
+}
+
+sub time ($self, $cart, $time, @) {
+    my ($h, $m) = $time =~ /^\s*([0-9]*)(?:[:.]([0-9]+))?\s*$/;
+
+    $h ||= 0;
+    $m ||= 0;
+
+    $h or $m or return REJECT, "Invalid time.";
+
+    print "Note: rounding up to next multiple of 0:15.\n" if $m % 15;
+    my $q = $h * 4 + int($m / 15) + ($m % 15 ? 1 : 0);
+
+    # reformat rounded time
+    $time = int($q / 4) . ":" . sprintf("%02d", ($q % 4) * 15);
+
+    $cart
+        ->add(-$q * $cost, "Lasercutter usage ($time)")
+        ->add_contra("+sales/lasercutter", $q * $cost, "\$you used lasercutter ($time)");
+
+    return ACCEPT;
+}

plugins/revspace_mollie

@@ -5,8 +5,7 @@ use JSON;
 my $ua = LWP::UserAgent->new(agent => "revbank");
 my $backend_url = "https://deposit.revspace.nl/mollie.php";
 
-sub backend_call {
-    my ($hash) = @_;
+sub backend_call($hash) {
     #$hash->{test} = 1;  # use mollie test environment
 
     my $response = $ua->post($backend_url, $hash);
@@ -20,9 +19,7 @@ sub backend_call {
     return $result;
 }
 
-sub command {
-    my ($self, $cart, $command) = @_;
-
+sub command($self, $cart, $command, @) {
     # currently 10 characters after the underscore, but it's not documented.
     my ($id) = $command =~ /^(tr_[A-Za-z0-9]{10,12})$/ or return NEXT;
 
@@ -38,16 +35,21 @@ sub command {
         $description .= " TEST MODE ($result->{test_amount})";
     }
 
-    $cart->add(
-        +$amount,
-        $description,
-        { is_deposit => 1, method => 'online', mollie_id => $id, no_repeat => 1 }
-    );
+    $cart
+        ->add(
+            +$amount,
+            $description,
+            { is_deposit => 1, method => 'online', mollie_id => $id, no_repeat => 1 }
+        )
+        ->add_contra(
+            "-deposits/online",
+            -$amount,
+            "$description by \$you"
+        );
     return ACCEPT;
 }
 
-sub hook_abort {
-    my ($class, $cart, $reason) = @_;
+sub hook_abort($class, $cart, $reason, @) {
     # Opportunistic; ignore failures. Can't do anything about it anyway.
 
     my @ids = map $_->attribute('mollie_id'), $cart->entries('mollie_id');
@@ -55,8 +57,7 @@ sub hook_abort {
         for @ids;
 }
 
-sub hook_checkout {
-    my ($class, $cart, $user, $transaction_id) = @_;
+sub hook_checkout($class, $cart, $user, $transaction_id, @) {
     # Opportunistic; ignore failures. Can't do anything about it anyway.
 
     my @ids = map $_->attribute('mollie_id'), $cart->entries('mollie_id');

plugins/revspace_mqtt

@@ -2,20 +2,14 @@
 
 use Net::MQTT::Simple "mosquitto.space.revspace.nl";
 
-sub command { NEXT }
-
-sub hook_checkout {
-    my ($class, $cart, $user, $transaction_id) = @_;
+sub hook_checkout($class, $cart, $user, $transaction_id, @) {
     my $filename = "revbank.sales";
     my @entries = $cart->entries('product_id') or return;
     my %already_retained;
 
-    my %stats = do {
-        my $in;
-        open($in, '<', $filename)
-        ? map { split " ", $_, 2 } readline $in
-        : ()
-    };
+    # XXX: hook_checkout is called while the global lock is held, and the
+    # potentially slow network traffic could make that take quite long.
+    my %stats = eval { map { split " ", $_, 2 } slurp $filename };
 
     $stats{ $_->attribute('product_id') } += $_->quantity for @entries;
 
@@ -29,8 +23,7 @@ sub hook_checkout {
         $already_retained{ $product } = 1;
     }
 
-    open my $out, '>', "$filename.$$" or warn "$filename.$$: $!";
-    printf {$out} "%-16s %9d\n", $_, $stats{$_} for sort keys %stats;
-    close $out or die "$filename.$$: $!";
-    rename "$filename.$$", $filename or die $!;
+    spurt $filename, map {
+        sprintf "%-16s %9d\n", $_, $stats{$_}
+    } sort keys %stats;
 }

plugins/revspace_saldo

@@ -2,20 +2,17 @@
 
 use POSIX qw(strftime);
 
-sub command { NEXT }
-
-sub _box {
+sub _box(@lines) {
     print(
         "#" x 79, "\n",
-        (map { sprintf("## %-73s ##\n", $_) } @_),
+        (map { sprintf("## %-73s ##\n", $_) } @lines),
         "#" x 79, "\n"
     );
 }
 
-sub hook_checkout_done {
-    my ($class, $cart, $user, $transaction_id) = @_;
-
+sub hook_checkout_done($class, $cart, $user, $transaction_id, @) {
     defined $user or return;  # hacks like 'undo' don't have an acting user
+    RevBank::Users::is_hidden($user) and return;
 
     my $balance = RevBank::Users::balance($user) or return;
     my $since   = RevBank::Users::since($user);

plugins/revspace_terminal

@@ -1,5 +1,3 @@
-sub command { NEXT }
-
 # Terminal hacks
 
 # Reset terminal on startup

plugins/sighup

@@ -0,0 +1,8 @@
+# Attempt to restart on SIGHUP
+
+$SIG{HUP} = sub {
+    call_hooks("restart_exec");
+    no warnings qw(exec);
+    exec $0;
+    call_hooks("restart_survived");
+};

plugins/sigint

@@ -1,7 +1,5 @@
 #!perl
 
-sub command { NEXT }
-
 $SIG{INT} = sub {
     $::ABORT_HACK = "^C";
 

plugins/skim

@@ -0,0 +1,34 @@
+#!perl
+
+# Note: this plugin only makes sense if you have proper cashbox tracking,
+# which requires the "deposit_methods" plugin for differentiating between
+# bank transfers and cash deposits.
+#
+# If you ONLY allow cash deposits, and are not using the "deposit_methods"
+# plugin, you could alternatively hack the "deposit" plugin to use the "-cash"
+# contra instead of the "-deposits/other" contra.
+
+sub command :Tab(skim,unskim) ($self, $cart, $command, @) {
+    $command eq 'skim' or $command eq 'unskim' or return NEXT;
+
+    $self->{command} = $command;
+
+    call_hooks("cash");
+
+    return "Amount to $command", \&amount;
+}
+
+sub amount($self, $cart, $arg, @) { 
+    warn "Use 'unskim' to return (part of) a previously skimmed amount.\n"
+        if $arg =~ /^-/;
+
+    my $amount = parse_amount($arg) or return REJECT, "Invalid amount";
+    $amount = -$amount if $self->{command} eq 'unskim';
+
+    my $entry = $cart
+        ->add(0, "Skimmed $amount", { is_withdrawal => 1 })
+        ->add_contra("-cash", +$amount, "Skimmed by \$you")
+        ->add_contra("-cash/skimmed", -$amount, "Skimmed by \$you");
+
+    return ACCEPT;
+}

plugins/split

@@ -4,19 +4,16 @@ use List::Util ();
 
 HELP "split <account>..." => "Split the bill with others";
 
-sub _select_split {
-    my ($cart) = @_;
+sub _select_split($cart) {
     grep $_->{amount} < 0, $cart->entries
 }
 
-sub command :Tab(take,steal,split) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(split) ($self, $cart, $command, @) {
     $command eq 'split' or return NEXT;
 
     $self->{users} = [];
 
-    my $sum = List::Util::sum(map -$_->{amount}, _select_split($cart));
+    my $sum = List::Util::sum(map -$_->{amount} * $_->{quantity}, _select_split($cart));
     $self->{split_amount} = $sum;
 
     return REJECT, "Nothing to split. Add products first." if not $sum;
@@ -25,9 +22,7 @@ sub command :Tab(take,steal,split) {
     return "User to take from (not yourself)", \&arg;
 }
 
-sub arg :Tab(USERS) {
-    my ($self, $cart, $arg) = @_;
-
+sub arg :Tab(USERS) ($self, $cart, $arg, @) {
     my $users = $self->{users};
 
     if (@$users and $arg eq $self->{split_finish}) {

plugins/statiegeld

@@ -0,0 +1,153 @@
+#!perl
+use List::Util;
+use RevBank::Products;
+
+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
+		$product = read_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},
+			product_id  => $product->{id},
+			deduplicate => join("/", $invocant->id, $product->{id}),
+		})
+		->add_contra($addon->{contra}, -$addon->{price}, "$d for \$you");
+	}
+
+	return ACCEPT;
+}
+
+sub hook_added_entry ($class, $cart, $entry, @) {
+	$S or return;
+	delete $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 $message = "Scan empty container for deposit return.";
+
+	# The message is prepended to the prompt, so it is printed after
+	# clear-screen (^L). The color is repeated on the second line because
+	# readline redraws only the last line of a multiline prompt.
+	my $yellow = "\x01\e[33;1m\x02";
+	my $reset  = "\x01\e[m\x02";
+	my $statiegeld_prompt = "$yellow$message$reset\n$yellow+>$reset";
+
+	$_[2] =~ s/^$/$statiegeld_prompt/;
+}
+
+sub hook_input { # args via @_ for mutable alias
+	my ($class, $cart, $input, $split_input) = @_;
+
+	$S or return;
+	defined $input or return;
+
+	# Extra newline before new "Scan products for ..." line.
+	print "\n" if defined $input and $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 phenomenally vile :)
+	}
+
+	$_[2] = "help" if $split_input and $input eq "\\help";
+}

plugins/statiegeld.pod

@@ -0,0 +1,65 @@
+=head1 NAME
+
+statiegeld - RevBank plugin for return deposits
+
+=head1 SYNOPISIS
+
+revbank.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"
+	matecrate    1.50@+statiegeld       "Mate crate (empty)"
+
+=head1 DESCRIPTION
+
+This plugin allows users to get refunds for empty container deposits.
+In a typical setup, there would be a separate terminal where RevBank runs in
+statiegeld mode. In statiegeld mode, you scan products to get your deposit
+money back in the same way you would normally buy them.
+
+Alternatively, on a regular RevBank terminal, the C<deposit> command (which is
+provided by the C<deposit> plugin) is extended to support product id's where
+you would normally enter an amount.
+
+=head2 Usage
+
+If RevBank was run with the environment variable C<REVBANK_STATIEGELD> set to
+C<1>, the user just scans the products.
+
+Alternatively, a product can be scanned after entering the C<deposit> command.
+
+The product_id (barcode) is used to look up the stategield addon. In case of a
+non-hidden addon (does not begin with C<+>), the name of the addon can also be
+used.
+
+=head2 Configuration
+
+The statiegeld plugin recognises products from C<revbank.products> by matching
+the contra accounts (the C<+statiegeld> in C<0.15@+statiegeld>) of the
+product's addons against a list of known accounts.
+
+That list is hard coded in the plugin, but could be changed if you want to use
+a different account than the default C<+statiegeld>. The contra account can be
+a hidden account or a regular account.
+
+Don't remove statiegeld addons because that means customers can no longer get
+their deposits back. Also, consider the consequences of changing the price
+before doing so.
+
+=head2 "statiegeld"?!
+
+"Statiegeld" is the Dutch word for container deposits. Because the English word
+"deposit" is also the verb for adding money to your account, and used
+extensively in RevBank, it was useful to distinguish between the two features.
+
+In the user interface, the terms "deposit" and "deposit return" are used.
+
+=head2 Limits
+
+By itself, the C<statiegeld> plugin only supports refunding deposits for known
+products that are configured as such. There is no limit to how many containers
+the user can return to get refunds. There's another plugin,
+C<statiegeld_tokens>, that can be used to limit the refunds to what the same
+user has actually purchased.

plugins/statiegeld_tokens

@@ -0,0 +1,303 @@
+#!perl
+use List::Util;
+use RevBank::Products;
+
+HELP void => "Destroy deposit tokens";
+
+my $ttl = 100 * 86400;  # expiry time in seconds
+my $filename = "revbank.statiegeld";
+
+# Token format: token_type,time,expiry_time,product_id,transaction_id,seq
+# - token_type (also just "type") is the id of the product addon.
+# - expiry_time < 0 means the token does not expire.
+# - time and product_id is recorded but only used for debugging.
+# - seq is a 0 based counter per transaction to make tokens unique,
+#   although the uniqueness of tokens is currently neither used nor enforced.
+#
+# Tokens are spent in FIFO order, by type rather than product_id. This
+# effectively extends the TTL for active consumers. The product_ids of
+# a user's remaining tokens may not correspond to those of the empty containers
+# in their possession.
+
+sub _addon_accounts {
+	my @accounts = @RevBank::Plugin::statiegeld::addon_accounts
+		or die "statiegeld_tokens plugin requires statiegeld plugin";
+	return @accounts;
+}
+
+sub _time_is_reliable() {
+	state $cache;
+	state $cached_at;
+	undef $cache if defined $cached_at and $cached_at <= (time() - 10);
+
+	return $cache if defined $cache;
+
+	$cache = sub {
+		return 1 if system('ntpstat >/dev/null 2>/dev/null') == 0;
+		return 1 if `timedatectl show -p NTPSynchronized 2>/dev/null` =~ /=yes/;
+
+		warn "Time/NTP status unknown or bad; deposit tokens will not expire.\n";
+		return 0;
+	}->();
+	$cached_at = time;
+
+	return $cache;
+}
+
+sub _read {
+	spurt $filename if not -e $filename;
+
+	my %users_tokens;
+	for (slurp $filename) {
+		/\S/ or next;
+
+		my ($username, @tokens) = split " ", $_;
+		if (exists $users_tokens{lc $username}) {
+			die "Corrupt data file $filename, $username listed twice";
+		}
+
+		my %by_type;
+		for my $token (@tokens) {
+			my ($token_type) = (split /,/, $token)[0];
+			push @{ $by_type{$token_type} }, $token;
+		}
+
+		$users_tokens{lc $username} = \%by_type;
+	}
+	return \%users_tokens;
+}
+
+sub _expire_tokens($line, $time) {
+	$time > 0     or return $line;
+	defined $line or return $line;
+	$line =~ / /  or return $line;
+
+	my ($username, @tokens) = split " ", $line;
+
+	# Rewrite line with only non-tokens, invalid tokens, and non-expired tokens
+	my @keep;
+	my @expired;
+	for my $token (@tokens) {
+		my ($type, undef, $expiry) = split /,/, $token;
+
+		my $expired = defined($expiry) && $expiry > 0 && $expiry < $time;
+		push @{ $expired ? \@expired : \@keep }, $token;
+	}
+
+	call_hooks(
+		"log_info",
+		"statiegeld_tokens: ${\scalar @expired} expired for $username: @expired"
+	) if @expired;
+
+	return join(" ", $username, @keep) . "\n";
+}
+
+sub _write($username, $tokens_by_type, $create) {
+	my @tokens = map @{ $tokens_by_type->{$_} }, sort keys %$tokens_by_type;
+	my $new_line = @tokens == 0 ? undef : join(" ", $username, @tokens) . "\n";
+
+	my $time = _time_is_reliable ? time() : -1;
+	
+	if ($create) {
+		append $filename, $new_line if defined $new_line;
+	} else {
+		rewrite $filename, sub ($old_line) {
+			$old_line =~ /\S/ or return $old_line;  # keep whitespace-only lines
+
+			# removes line from file if $new_line is undef
+			my $line = /(\S+)/ && lc($1) eq lc($username) ? $new_line : $old_line;
+			return _expire_tokens($line, $time);
+		};
+	}
+}
+
+sub _warn($message) {
+	warn "\e[31;1mSorry,\e[0m $message\n";
+}
+
+sub hook_undo($class, $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;
+
+			return ABORT, "Sorry, deposit refunds cannot be undone.";
+		}
+	}
+}
+
+sub _handle_undo($cart) {
+	for my $entry ($cart->entries) {
+		# 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 ($token_type, undef, undef, undef, $tid) = split /,/, $_;
+
+				$tid ne $undo_tid
+			} @tokens;
+
+			return @tokens ? join(" ", $username, @tokens) . "\n" : undef;
+		};
+	}
+}
+
+sub hook_checkout_prepare($class, $cart, $username, $transaction_id, @) {
+	if ($username eq '-undo') {
+		_handle_undo($cart);
+		return;
+	}
+
+	# Read data
+	my $tokens_by_type = _read->{lc $username};
+	my $is_new = !defined $tokens_by_type;
+	$tokens_by_type = {} if $is_new;
+	my $time_is_reliable = _time_is_reliable;
+
+	my $tokens_changed = 0;
+	my @created;
+	my @used;
+
+	# Products bought: add tokens
+	my $seq = 0;
+	for my $entry ($cart->entries('product')) {
+		my $sg = RevBank::Plugin::statiegeld::statiegeld_product($entry->attribute('product'))
+			or next;
+
+		for my $addon (@{ $sg->{statiegeld_addons} }) {
+			# These should never contain spaces or commas in vanilla revbank,
+			# but custom plugins may be less well behaved.
+			/[\s,]/ and die "Internal error"
+				for $addon->{id}, $entry->attribute('product_id'), $transaction_id;
+
+			for (1 .. $entry->quantity) {
+				my $token = join(",",
+					$addon->{id},  # token_type
+					time(),
+					($time_is_reliable ? time() + $ttl : -1),
+					$entry->attribute('product_id'),
+					$transaction_id,
+					$seq++,
+				);
+				push @created, $token;
+				push @{ $tokens_by_type->{$addon->{id}} }, $token;
+			}
+			$tokens_changed++;
+		}
+	}
+
+	# Products (containers) returned: void tokens in FIFO order
+	my $cart_changed = 0;
+	my %warnings_by_type;
+	my %had_num_tokens_by_type = map { $_ => scalar @{ $tokens_by_type->{$_} } } keys %$tokens_by_type;
+
+	ENTRY: for my $entry ($cart->entries('plugin')) {
+		$entry->attribute('plugin') eq 'statiegeld' or next;
+
+		my $type = $entry->attribute('addon_id');
+		my $available = @{ $tokens_by_type->{$type} // [] };
+
+		if ($available < $entry->quantity) {
+			if ($available == 0) {
+				$cart->delete($entry);
+				$warnings_by_type{$type}++;
+				next ENTRY;
+			}
+			$entry->quantity($available);
+			$warnings_by_type{$type}++;
+		}
+
+		push @used, splice @{ $tokens_by_type->{$type} }, 0, $entry->quantity;
+		$tokens_changed++;
+	}
+	for my $type (keys %warnings_by_type) {
+		my $products = read_products;
+		my $addon = $products->{"+$type"} // $products->{$type};
+		my $avail = $had_num_tokens_by_type{$type} // 0;
+		my $only =
+			+ $avail == 0 ? "0 deposit tokens"
+			: $avail == 1 ? "only 1 deposit token"
+			:               "only $avail deposit tokens";
+
+		_warn qq[you have $only of type $type.\n]
+			. qq[($type = "$addon->{description}")];
+	}
+
+	# Store data
+	call_hooks(
+		"log_info",
+		"statiegeld_tokens: ${\scalar @created } created for $username: @created"
+	) if @created;
+
+	call_hooks(
+		"log_info",
+		"statiegeld_tokens: ${\scalar @used } used by $username: @used"
+	) if @used;
+
+	_write $username, $tokens_by_type, $is_new if $tokens_changed;
+
+	return ABORT if %warnings_by_type and not $cart->size;
+
+	if (%warnings_by_type and $cart->changed(1)) {
+		print "\n";  # Between warnings and transaction overview
+	}
+
+	return;
+}
+
+sub hook_user_info ($class, $username, @) {
+	my $tokens_by_type = _read->{lc $username};
+	my @info;
+	for my $type (sort keys %$tokens_by_type) {
+		my @tokens = @{ $tokens_by_type->{$type} // [] };
+		push @info, sprintf("%dx %s", scalar @tokens, $type);
+	}
+	@info = ("none") if not @info;
+	print "Deposit tokens: ", join(", ", @info), "\n";
+}
+
+sub command($self, $cart, $command, @) {
+	$command eq 'void' or return NEXT;
+
+	my $found =0;
+	for my $entry ($cart->entries('plugin')) {
+		next if $entry->attribute('plugin') ne 'statiegeld';
+		$found++;
+	}
+	$found or return REJECT, "Add deposit returns first.";
+
+	return "The tokens will be deleted irrevokably and you will NOT RECEIVE THE MONEY.\n"
+		. "Type 'yes' if you are sure", \&void;
+}
+
+sub void :Tab(yes,no) ($self, $cart, $input, @) {
+	if (lc $input eq 'y') {
+		return REJECT, "y is not yes...";
+	}
+	if (lc $input ne 'yes') {
+		print "Destruction cancelled.\n";
+		return ACCEPT;
+	}
+
+	for my $entry ($cart->entries('plugin')) {
+		next if $entry->attribute('plugin') ne 'statiegeld';
+		$entry->{description} = "Void: $entry->{description}";
+		$entry->amount(0);
+		$entry->delete_contras;
+
+		# Change key so subsequently added things aren't also void;
+		# deduplication of tokens to be voided doesn't actually work yet.
+		$entry->attribute(deduplicate => join("/", $self->id, $entry->attribute('addon_id')));
+	}
+
+	return ACCEPT;
+}

plugins/statiegeld_tokens.pod

@@ -0,0 +1,31 @@
+=head1 NAME
+
+statiegeld_tokens - RevBank plugin for limiting return deposits
+
+=head1 DESCRIPTION
+
+When using this plugin together with C<statiegeld>, return deposits are limited
+to what users have previously paid. This is done by keeping track of I<tokens>:
+when you buy something with a deposit, you receive a token, and when you return
+the empty container, you spend the token when getting your deposit back.
+
+Tokens expire and are (currently) spent in FIFO order per type. The token type
+corresponds to the product_id of the matched addon.
+
+The tokens are stored in a file called C<revbank.statiegeld> which is not
+intended to be edited externally.
+
+=head2 User interaction
+
+When checking out, return deposits are removed from the cart if the user does
+not have enough tokens for the transaction.
+
+Users can choose to delete tokens by entering the C<void> command before
+checking out. At the moment of writing, it is unclear whether this is actually
+useful for any practical use case.
+
+=head2 NTP
+
+Tokens expire only if C<ntpdate> or systemd's C<datetimectl> says the system
+time is synchronized. Else, new tokens made will never expire and existing
+tokens won't be processed for expiry.

plugins/stock

@@ -1,21 +1,27 @@
 #!perl
 
-HELP "cash" => "Checkout without a user account";
+{
+    # If you want to keep track of stock, you need a way for people to
+    # register cash payments. The 'cash' plugin takes care of that, but
+    # that also assumes deposit_methods. So here's a minimal fallback
+    # implementation for the 'cash' command.
 
-sub command :Tab(cash) {
-    my ($self, $cart, $command) = @_;
+    # If you use the 'cash' plugin, make sure it is loaded *before*
+    # the 'stock' plugin in 'revbank.plugins'.
 
-    return NEXT if $command ne 'cash';
+    HELP1 "cash" => "Checkout without a user account";
 
-    call_hooks("checkout", $cart, 'cash', 0);  # Fake checkout
-    $cart->empty;
+    sub command :Tab(cash) ($self, $cart, $command, @) {
+        return NEXT if $command ne 'cash';
+        return NEXT if not $cart->size;
 
-    return ACCEPT;
+        $cart->checkout('-cash');
+
+        return ACCEPT;
+    }
 }
 
-sub hook_checkout {
-    my ($class, $cart, $user, $transaction_id) = @_;
-
+sub hook_checkout($class, $cart, $user, $transaction_id, @) {
     # Hack42 for some reason used the dutch word in their revbank1 hack.
     my $filename = -e("revbank.voorraad")
         ? "revbank.voorraad"
@@ -23,17 +29,11 @@ sub hook_checkout {
 
     my @entries = $cart->entries('product_id') or return;
 
-    my %stock = do {
-        my $in;
-        open($in, '<', $filename)
-        ? map { split " ", $_, 2 } readline $in
-        : ()
-    };
+    my %stock = eval { map { split " ", $_, 2 } slurp $filename };
 
     $stock{ $_->attribute('product_id') } -= $_->quantity for @entries;
 
-    open my $out, '>', "$filename.$$" or warn "$filename.$$: $!";
-    printf {$out} "%-16s %+9d\n", $_, $stock{$_} for sort keys %stock;
-    close $out or die "$filename.$$: $!";
-    rename "$filename.$$", $filename or die $!;
+    spurt $filename, map {
+        sprintf "%-16s %+9d\n", $_, $stock{$_}
+    } sort keys %stock;
 }

plugins/tail

@@ -1,15 +1,40 @@
 #!perl
 
-sub command :Tab(tail) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(tail) ($self, $cart, $command, @) {
     return NEXT if $command ne 'tail';
 
     my $n = (`tput lines 2>/dev/null` || 13) - 3;
     my $c = (`tput cols 2>/dev/null` || 80) + 0;
 
-    # ew :)
-    system "perl -lane's/CHECKOUT\\s+\\S+\\s+// or next; s/  #// or next; s/_/ /; print' .revbank.log | tail -n$n | perl -ple'\$_ = substr \$_, 0, $c'";
+    open my $fh, "<", ".revbank.log" or die $!;
+    my @lines;
+
+    while (defined($_ = readline $fh)) {
+        length($_) > 28 or next;
+        substr($_, 20, 8) eq 'CHECKOUT' or next;  # fast check
+
+        my ($dt, $c, $t_id, $u, $dir, $qty, $amount, undef, $desc) = split " ", $_, 9;
+        $c eq 'CHECKOUT' or next;  # real check after expensive split
+        RevBank::Users::is_hidden($u) and next;
+
+        shift @lines if @lines == $n;
+
+        $qty = 1 if $qty eq 'EUR';  # log files before commit 63f81e37 (2019-11-05)
+        push @lines, [$dt, $u, ($dir eq 'GAIN' ? "+ $amount" : $amount), $desc, $qty];
+    }
+    close $fh;
+
+    my $usercol = 1;
+    length($_->[1]) > $usercol and $usercol = length($_->[1]) for @lines;
+
+    for my $line (@lines) {
+        my $qty = pop @$line;
+        $line->[0] =~ s/_/ /;
+        $line->[1] = sprintf "%-${usercol}s", $line->[1];
+        $line->[2] = sprintf "%8s", $line->[2];
+        $line->[3] = "${qty}x $line->[3]" if $qty > 1;
+        print substr "@$line", 0, $c;
+    }
 
     return ACCEPT;
 }

plugins/take

@@ -2,9 +2,7 @@
 
 HELP "take <account>... <amount> <reason>" => "Transfer money from them to you";
 
-sub command :Tab(take,steal) {
-    my ($self, $cart, $command) = @_;
-
+sub command :Tab(take,steal) ($self, $cart, $command, @) {
     $command eq 'take' or $command eq 'steal'
         or return NEXT;
 
@@ -13,9 +11,7 @@ sub command :Tab(take,steal) {
     return "User to take from", \&arg;
 }
 
-sub arg :Tab(USERS) {
-    my ($self, $cart, $arg) = @_;
-
+sub arg :Tab(USERS) ($self, $cart, $arg, @) {
     my @users = @{ $self->{users} };
     my $amount = parse_amount($arg);
 
@@ -40,15 +36,14 @@ sub arg :Tab(USERS) {
         push @{ $self->{users} }, $user;
     } else {
         return REJECT, "$arg: No such user" .
-            ($amount ? "." : ", and not a valid amount.");
+            ($amount || !@{ $self->{users} } ? "." : ", and not a valid amount.");
     }
 
     return "User to take from, or total amount to finish", \&arg;
 }
 
-sub reason :Tab(bbq,NOABORT) {  # finish
-    my ($self, $cart, $reason) = @_;
-
+# finish
+sub reason :Tab(bbq) ($self, $cart, $reason, @) { 
     return REJECT, "'$reason' is a username, not a description :)."
         if parse_user($reason);
     return REJECT, "'$reason' is an amount, not a description :)."
@@ -59,7 +54,7 @@ sub reason :Tab(bbq,NOABORT) {  # finish
     my $total = $self->{total};
 
     my $users = join '/', @users;
-    my $entry = $cart->add($total, "Taken from $users ($reason)", { is_take => 1 });
+    my $entry = $cart->add($total, "Take from $users ($reason)", { is_take => 1 });
     for my $user (@users) {
         $entry->add_contra( $user, -$each, "Taken by \$you ($reason)" );
     }

plugins/undeposit

@@ -0,0 +1,41 @@
+#!perl
+
+# This is basically like 'withdraw', but for non-cash (e.g. iban)
+
+my @TAB;
+
+sub command :Tab(undeposit) ($self, $cart, $command, @) {
+    $command eq 'undeposit' or return NEXT;
+
+    warn "\n\n\n";
+    warn "\e[1mNote: this function is for internal use by board members ONLY.\e[0m\n";
+    warn "\n\n\n";
+    warn "Enter 'abort' to abort.\n";
+
+    @TAB = grep /^[-+]deposit/, RevBank::Users::names
+        or return REJECT, "No contras available.";
+    print "Available contras:\n", map "  $_\n", sort(@TAB);
+
+    return "Contra", \&contra;
+}
+
+sub tab { @TAB }
+
+sub contra :Tab(&tab) ($self, $cart, $arg, @) { 
+    return REJECT, "Invalid contra." unless grep $_ eq $arg, @TAB;
+
+    $self->{contra} = $arg;
+
+    return "Amount to withdraw", \&amount;
+}
+
+sub amount($self, $cart, $arg, @) { 
+    my $amount = parse_amount($arg);
+    defined $amount or return REJECT, "Invalid amount";
+
+    $cart
+        ->add(-$amount, "Undeposit", { is_withdrawal => 1 })
+        ->add_contra($self->{contra}, +$amount, "Undeposited by \$you");
+
+    return ACCEPT;
+}

plugins/undo

@@ -1,56 +1,92 @@
 #!perl
 
-HELP "undo <transactionID>" => "Undo a transaction";
+HELP1 "undo <transactionID>" => "Undo a transaction";
 
 my $filename = ".revbank.undo";
 
-sub command :Tab(undo) {
-    my ($self, $cart, $command) = @_;
+my @TAB;
 
+sub command :Tab(undo) ($self, $cart, $command, @) {
     $command eq 'undo' or return NEXT;
 
-    $cart->size and return ABORT, "Undo is not available mid-transaction.";
+    $cart->size and return REJECT, "Undo is not available mid-transaction.";
 
-    return "Transaction ID", \&undo;
-}
-
-sub undo {
-    my ($self, $cart, $tid) = @_;
-
-    open my $in,  '<', $filename or die "$filename: $!";
-    open my $out, '>', "$filename.$$" or die "$filename.$$: $!";
-    my $description = "Undo $tid";
-
-    my $entry;
-
-    while (defined(my $line = readline $in)) {
-        if ($line =~ /^\Q$tid\E\s/) {
-            my (undef, $user, $delta) = split " ", $line;
-
-            $entry ||= $cart->add(0, $description);
-            $entry->{FORCE} = 1;
-
-            $entry->add_contra($user, $delta, "Undo $tid");
+    my @log;
+    for my $line (slurp $filename) {
+        my ($tid, $user, $delta, $dt) = split " ", $line;
+        if (@log and $log[-1]{tid} eq $tid) {
+            push @{ $log[-1]{deltas} }, [ $user, $delta ];
         } else {
-            print {$out} $line;
+            push @log, { tid => $tid, dt => $dt, deltas => [ [ $user, $delta ] ] };
         }
     }
-    close $in;
-    close $out or die $!;
-    if ($cart->size) {
-        rename "$filename.$$", $filename or die $!;
-        $cart->checkout('**UNDO**');
-    } else {
-        return ABORT, "Transaction ID '$tid' not found in undo log.";
+
+    @TAB = ();
+
+    my $menu = "";
+    my $max = @log < 15 ? @log : 15;
+    for my $txn (@log[-$max .. -1]) {
+        $menu .= "ID: $txn->{tid}  $txn->{dt} " . join(", ", 
+            map { sprintf "%s:%+.2f", @$_ } @{ $txn->{deltas} }
+        ) . "\n";
+
+        push @TAB, $txn->{tid};
     }
 
-    return ACCEPT;
+    return $menu . "Transaction ID", \&undo;
 }
 
-sub hook_user_balance {
-    my ($class, $username, $old, $delta, $new, $transaction_id) = @_;
+sub tab { @TAB }
 
-    open my $fh, '>>', $filename or die "$filename: $!";
-    print {$fh} join " ", $transaction_id, $username, -$delta, now(), "\n";
-    close $fh or die "$filename: $!";
+our $doing_undo = 0;  # Ugly but works, just like the rest of this plugin
+
+sub undo :Tab(&tab) ($self, $cart, $tid, @) {
+    my $description = "Undo $tid";
+    my $entry;
+    my $found = 0;
+    my $aborted = 0;
+
+    return with_lock {
+        for my $line (slurp $filename) {
+            if ($line =~ /^\Q$tid\E\s/) {
+                my (undef, $user, $delta) = split " ", $line;
+
+                $entry ||= $cart->add(0, $description, { undo_transaction_id => $tid });
+
+                $entry->add_contra($user, $delta, "Undo $tid");
+            }
+        }
+
+        $cart->size or return ABORT, "Transaction ID '$tid' not found in undo log.";
+
+        call_hooks("undo", $cart) or return ABORT;
+
+        local $doing_undo = 1;  # don't allow undoing undos
+        $cart->checkout('-undo');
+
+        return ACCEPT;
+    };
+}
+
+sub hook_checkout_prepare($class, $cart, $username, $transaction_id, @) {
+    $username eq '-undo' or return;
+
+    for my $entry ($cart->entries) {
+        my $undo_tid = $entry->attribute('undo_transaction_id')
+            or die "Plugin error: broken '-undo' transaction";
+
+        rewrite $filename, sub($line) {
+            if ($line =~ /^\Q$undo_tid\E\s/) {
+                return undef;  # remove line
+            } else {
+                return $line;
+            }
+        };
+    }
+}
+
+sub hook_user_balance($class, $username, $old, $delta, $new, $transaction_id, @) {
+    return if $doing_undo;  # don't allow undoing undos
+
+    append $filename, join(" ", $transaction_id, $username, -$delta, now()), "\n";
 }

plugins/unlisted

@@ -1,30 +1,34 @@
 #!perl
 
-HELP "unlisted" => "Buy unlisted product (manual entry)";
+HELP1 "unlisted" => "Buy unlisted product (manual entry)";
 
-sub command :Tab(unlisted,donate) {
-    my ($self, $cart, $command) = @_;
+sub command :Tab(unlisted,donate) ($self, $cart, $command, @) {
     $command eq 'unlisted' or $command eq 'donate' or return NEXT;
     $self->{command} = $command;
 
-    return "Amount to deduct from your account", \&amount;
+    my $prompt = $command eq 'donate' ? 'Amount' : 'Price';
+    return $prompt, \&amount;
 }
 
-sub amount {
-    my ($self, $cart, $arg) = @_;
+sub amount($self, $cart, $arg, @) {
     $self->{amount} = parse_amount($arg) or return REJECT, "Invalid amount.";
 
     if ($self->{command} eq 'donate') {
-        $cart->add(-$self->{amount}, "Donation (THANK YOU!)");
-        return ACCEPT;
+        return "Message ('x' for no message)", sub($self, $cart, $desc, @) {
+            $desc = $desc eq 'x' ? "" : " ($desc)";
+            $cart
+                ->add(-$self->{amount}, "Donation$desc - THANK YOU!")
+                ->add_contra("+donations", +$self->{amount}, "Donation by \$you");
+
+            return ACCEPT;
+        }
     }
 
-    return "Please provide a short description", \&description;
-}
+    return "Please provide a short description", sub($self, $cart, $desc, @) { 
+        $cart
+            ->add(-$self->{amount}, "Unlisted: $desc")
+            ->add_contra("+sales/unlisted", +$self->{amount}, "Unlisted: $desc by \$you");
 
-sub description {
-    my ($self, $cart, $desc) = @_;
-    $cart->add(-$self->{amount}, $desc);
-    return ACCEPT;
+        return ACCEPT;
+    };
 }
-

plugins/url

@@ -1,10 +1,8 @@
 #!perl
 
-sub command {
-    my ($self, $cart, $command) = @_;
+sub command($self, $cart, $command, @) {
     if ($command =~ m[^https?://]) {
-        print "This is not a browser...";
-        return ACCEPT;
+        print "This is not a browser...\n";
     }
     return NEXT;
 }

plugins/users

@@ -1,57 +1,99 @@
 #!perl
 
-HELP "<account>" => "[Pay with your account and] show balance";
-HELP "list" => "List accounts and balances";
-HELP "shame" => "Display Hall of Shame (negative balances)";
-
-sub command :Tab(list,ls,shame,USERS) {
-    my ($self, $cart, $command) = @_;
+HELP1 "<account>" => "[Pay with your account and] show balance";
+HELP  "list" => "List accounts and balances";
+HELP  "log" => "View transaction log";
+HELP  "shame" => "Display Hall of Shame (negative balances)";
 
+sub command :Tab(list,ls,shame,log,USERS) ($self, $cart, $command, @) {
     return $self->list  if $command eq 'list';
     return $self->list  if $command eq 'ls';
     return $self->shame if $command eq 'shame';
 
+    return "Username", \&log_for if $command eq 'log';
+
     my $user = parse_user($command)
         or return NEXT;
 
     return $self->balance($user) if not $cart->size;
 
-    $cart->checkout($user) or return REJECT, "Checkout failed.";
+    $cart->checkout($user);
 
     return ACCEPT;
 }
 
-sub hook_checkout {
-    my ($class, $cart, $user, $transaction_id) = @_;
+sub list($self) {
+    require RevBank::TextEditor;
 
-    if ($cart->changed) {
-        say "Done:";
-        $cart->display;
+    my $list = join "", sort {
+        lc($a) cmp lc($b)
+    } grep {
+        !/^[-+]/
+    } slurp("revbank.accounts");
+
+    RevBank::TextEditor::pager("RevBank account list", $list);
+    return ACCEPT;
+}
+
+sub shame($self) {
+    my $list = join "", sort {
+        (split " ", $a)[1] <=> (split " ", $b)[1]
+    } grep {
+        / -/ && !/^[-+]/
+    } slurp("revbank.accounts");
+
+    $list =~ s/( -[\d.]+)/\e[31;1m$1\e[0m/g;
+    print $list;
+    return ACCEPT;
+}
+
+sub _grep($user) {
+    $user = lc $user;
+    my @lines;
+    open my $fh, "<", ".revbank.log" or die $!;
+
+    while (defined($_ = readline $fh)) {
+        length($_) > 28 or next;
+        substr($_, 20, 8) eq 'CHECKOUT' or next;  # fast check
+
+        my ($dt, $c, $t_id, $u, $dir, $qty, $amount, undef, $desc) = split " ", $_, 9;
+        $c eq 'CHECKOUT' or next;  # real check after expensive split
+        lc($u) eq $user or next;
+
+        $qty = 1 if $qty eq 'EUR';  # log files before commit 63f81e37 (2019-11-05)
+
+        push @lines, sprintf "%s %8s %s%-s", (
+            $dt =~ s/_/ /r,
+            $dir eq 'GAIN' ? "+ $amount" : $amount,  # like R::A->string_flipped
+            $qty > 1 ? $qty . "x " : "",
+            $desc
+        );
     }
-    say "Transaction ID: $transaction_id";
+
+    return @lines;
 }
 
-sub list {
-    system "sort -f revbank.accounts | grep -v ^# | perl -pe's/( -[\\d.]+)/\\e[31;1m\$1\\e[0m/' | more";
+sub log_for :Tab(USERS) ($self, $cart, $input, @) {
+    my $user = parse_user($input) or return REJECT, "Unknown user";
+    my @lines = _grep($user);
+
+    require RevBank::TextEditor;
+    RevBank::TextEditor::logpager("RevBank log for $user", join("", @lines, "(end)"));
     return ACCEPT;
 }
 
-sub shame {
-    system "sort -k2 -n revbank.accounts | grep -v ^# | grep -- ' -' | perl -pe's/( -[\\d.]+)/\\e[31;1m\$1\\e[0m/' | more";
-    return ACCEPT;
-}
-
-sub recent {
-    my ($n, $u) = @_;
+sub _recent($n, $u) {
     $n += 0;
     print "Last $n transactions for $u:\n";
-    system "perl -lane'lc(\$F[3]) eq lc(qq[\Q$u\E]) or next; s/CHECKOUT\\s+\\S+\\s+\\S+\\s+// or next; s/  #// or next; s/_/ /; print' .revbank.log | tail -n$n";
+    print grep defined, +(_grep($u))[-$n .. -1];
 }
 
-sub balance {
-    my ($self, $u) = @_;
-    recent(10, $u);
-    printf "Balance for $u is \e[1m%+.2f\e[0m\n", RevBank::Users::balance($u);
+sub balance($self, $u) {
+    _recent(10, $u);
+    call_hooks("user_info", $u);
+    my $balance = RevBank::Users::balance($u);
+    my $red = $balance->cents < 0 ? "31;" : "";
+    printf "Balance for $u is \e[%s1m%s\e[0m\n", $red, $balance->string("+");
     say "NB: Products/amounts/commands FIRST, username LAST.";
     return ABORT;
 }

plugins/vat

@@ -0,0 +1,27 @@
+sub _read_vat {
+	my %vat;
+	for my $line (slurp "revbank.vat") {
+		my ($match, $vataccount, $pct) = split " ", $line;
+		$vat{lc $match} = { user => $vataccount, pct => $pct };
+	}
+	return \%vat;
+}
+
+sub hook_checkout_prepare($class, $cart, $username, $transaction_id, @) {
+	my $config = _read_vat;
+
+	for my $entry ($cart->entries) {
+		for my $contra ($entry->contras) {
+			my $vat = $config->{ lc $contra->{user} } or next;
+
+			my $amount = RevBank::Amount->new(
+				$contra->{amount}->cents * $vat->{pct} / (100 + $vat->{pct})
+			);
+
+			my $desc = "VAT ($vat->{pct}% * $contra->{amount})";
+			my $display = RevBank::Users::is_hidden($contra->{user}) ? undef : $desc;
+			$entry->add_contra($contra->{user}, -$amount, $desc, $display);
+			$entry->add_contra($vat->{user},    +$amount, $desc);
+		}
+	}
+}

plugins/vat.pod

@@ -0,0 +1,61 @@
+=head1 NAME
+
+vat - RevBank plugin for keeping a VAT administration
+
+=head1 SYNOPSIS
+
+C<revbank.vat>
+
+	+sales/products         +btw/laag 9
+	+sales/products/hoogbtw +btw/hoog 21
+	+sales/market           +btw/hoog 21
+	lasercutter             +btw/hoog 21
+
+C<revbank.products>
+
+	123123123   1.00      "Example product that gets the default contra"
+	42424242    1.00@+sales/products/hoogbtw  "Example with high VAT rate"
+
+=head1 DESCRIPTION
+
+With this plugin, and a properly configured C<revbank.vat> file, RevBank will
+subtract the appropriate VAT amount from the revenue account and collect that
+in the indicated VAT accounts.
+
+C<revbank.vat> is a whitespace separated file with three columns. The first
+column is the account to match, the second column is the account to collect VAT
+in, the third is the VAT rate (percentage).
+
+VAT is hidden from the user interface, and only recorded internally, except
+when the matched account is a regular account (does not begin with C<-> or
+C<+>).
+
+Note that in The Netherlands, hackerspaces will generally be able to use the
+I<vrijstelling voor kantines> and I<vrijstelling voor fondsenwervende
+activiteiten>. If you pick what you sell carefully, you may not need a BTW/VAT
+administration at all.
+
+=head1 CAVEATS
+
+You should test extensively before using this plugin in production. Please let
+me know how well it works, because you are probably the first to actually use
+this plugin.
+
+There is no configuration for a default VAT rate, so you have to carefully look
+for every sales account that requires it and list each one.
+
+Only the contras are matched, e.g. in the example from the synopsis, a C<give>
+to C<lasercutter> will incur VAT, but when someone impersonates C<lasercutter>
+and does a C<take> from a user from the perspective from C<lasercutter>, no VAT
+is counted. This is a feature, and no regular actual user should ever use it
+like that, but you should be aware of this subtlety and monitor the log file
+for mistakes.
+
+Negative amounts will get negative VAT (e.g. a C<take> from C<lasercutter> in
+the example from the synopsis).
+
+=head1 DISCLAIMER
+
+RevBank is not certified or audited tax administration software. You need to
+configure it according to local tax laws; don't just copy the example
+configuration. Use at your own risk.

plugins/voorbeeld

@@ -1,16 +0,0 @@
-#!perl
-
-sub command { print "@_\n"; NEXT }
-
-
-sub hook_user_balance {
-    my ($class, $username, $old, $delta, $new) = @_;
-
-    print "c: $class\n";
-    print "u: $username\n";
-    print "o: $old\n";
-    print "d: $delta\n";
-    print "n: $new\n";
-}
-
-

plugins/warnings

@@ -5,8 +5,7 @@
 
 use Time::HiRes qw(sleep);
 
-sub _read_warnings {
-    open my $fh, 'revbank.warnings' or die $!;
+sub _read_warnings() {
     return map {
         my ($regex, $products, $text) = m[^
             (?:
@@ -26,13 +25,10 @@ sub _read_warnings {
             my ($id, $desc) = @_;
             (grep { $_ eq $id } split /,/, $products) ? $text : ();
         }
-    } grep /\S/, grep !/^\s*#/, readline $fh;
+    } grep /\S/, grep !/^\s*#/, slurp 'revbank.warnings';
 }
 
-sub command { NEXT }
-
-sub hook_add_entry {
-    my ($class, $cart, $entry) = @_;
+sub hook_add_entry($class, $cart, $entry, @) {
     return if not $entry->has_attribute('product_id');  # skip unlisted, deposit, give, take
 
     my @warnings = map {

plugins/window_title

@@ -0,0 +1,14 @@
+sub _set_title($title) {
+	my $term = $ENV{TERM} or return;
+	print "\e]2;$title\a"   if $term =~ /^xterm|^rxvt/;
+	print "\e]2;$title\e\\" if $term =~ /^screen/;  # includes tmux
+}
+
+sub hook_prompt($class, $cart, $prompt, @) {
+	_set_title($cart->size ? "*RevBank" : "RevBank");
+}
+
+END {
+	_set_title("-");
+}
+

plugins/withdraw

@@ -1,15 +1,20 @@
 #!perl
 
-HELP "<amount>" => "Withdraw or enter price manually";
+HELP1 "withdraw <amount>" => "Withdraw from your account";
 
-sub command {
-    my ($self, $cart, $command) = @_;
+sub command :Tab(withdraw) ($self, $cart, $command, @) {
+    $command eq 'withdraw' or return NEXT;
 
-    my $amount = parse_amount($command);
-    defined $amount or return NEXT;
+    return "Amount to withdraw from your account", \&amount;
+}
 
-    $cart->add(-$amount, "Withdrawal or unlisted product",
-        { is_withdrawal => 1 });
+sub amount($self, $cart, $arg, @) { 
+    my $amount = parse_amount($arg);
+    defined $amount or return REJECT, "Invalid amount";
+
+    $cart
+        ->add(-$amount, "Withdrawal", { is_withdrawal => 1 })
+        ->add_contra("-cash", +$amount, "Withdrawn by \$you");
 
     return ACCEPT;
 }

revbank

@@ -1,11 +1,13 @@
-#!/usr/bin/perl -w
+#!/usr/bin/env perl
 
-use strict;
-use attributes;
-use IO::Select;
-use List::Util ();
-use Term::ReadLine;
-require Term::ReadLine::Gnu;  # The other one sucks.
+use v5.32;
+use warnings;
+use experimental 'isa';         # stable since v5.36
+use experimental 'signatures';  # stable since v5.36
+
+use List::Util qw(uniq);
+use Sub::Util qw(subname);
+use POSIX qw(ttyname);
 
 use FindBin qw($RealBin);
 use lib "$RealBin/lib";
@@ -13,15 +15,15 @@ use RevBank::Plugins;
 use RevBank::Global;
 use RevBank::Messages;
 use RevBank::Cart;
+use RevBank::Prompt;
 
-our $VERSION = "3.2";
-our %HELP = (
+our $VERSION = "8.3.1";
+
+our %HELP1 = (
     "abort" => "Abort the current transaction",
 );
 
-my @words;
-my $retry;
-my @retry;
+my @words;  # input
 
 my $one_off = 0;
 
@@ -31,119 +33,61 @@ if (@ARGV) {
 
     $one_off = 1;
 
-    @words = split " ", $ARGV[1];
+    @words = RevBank::Prompt::split_input($ARGV[1]);
+    @words and not ref $words[0] or die "Syntax error.\n";
     push @words, @ARGV[3 .. $#ARGV] if @ARGV > 3;
     push @words, "help" if not @words;
+} elsif (not ttyname fileno STDIN) {
+    warn "\e[31;1mNo controlling terminal, things will be borken!\n";
+    warn "Use ssh -t (or RequestTTY in .ssh/config) for interactive sessions.\e[m\n";
 }
 
+
 $| = 1;
 
-my $readline = Term::ReadLine->new($0);
-
-my $select = IO::Select->new;
-$select->add(\*STDIN);
-
 my $cart = RevBank::Cart->new;
 
-sub prompt {
-    my ($prompt, $plugins, $completions) = @_;
-
-    if ($prompt) {
-        $prompt =~ s/$/:/ if $prompt !~ /[?>]$/;
-        $prompt .= " ";
-    } else {
-        # \x01...\x02 = zero width markers for readline
-        # \e[...m     = ansi escape (32 = green, 1 = bright)
-        $prompt = "\x01\e[32;1m\x02>\x01\e[0m\x02 ";
-    }
-
-    my @matches;
-    $readline->Attribs->{completion_entry_function} = sub {
-        my ($word, $state) = @_;
-        return undef if $word eq "";
-        @matches = grep /^\Q$word\E/i, @$completions if $state == 0;
-        return shift @matches;
-    };
-
-    my $done;
-    my $input;
-
-    print "$retry\n" if $retry;
-    $readline->callback_handler_install($prompt, sub {
-        $done = 1;
-        $input = shift;
-        $readline->callback_handler_remove;
-    });
-
-    if ($retry) {
-        my $preset = join " ", @retry[0 .. $#retry - 1];
-        my $cursor = length $preset;
-        $preset .= " " . join " ", @{ $retry[-1] };
-        $readline->insert_text($preset);
-        $readline->Attribs->{point} = $cursor;
-        @retry = ();
-        $retry = 0;
-    }
-    $readline->redisplay();
-
-    my $begin = my $time = time;
-    while (not $done) {
-        if ($::ABORT_HACK) {
-            # Global variable that a signal handling plugin can set.
-            # Do not use, but "return ABORT" instead.
-            my $reason = $::ABORT_HACK;
-            $::ABORT_HACK = 0;
-            abort($reason);
-        }
-        if ($select->can_read(.05)) {
-            $readline->callback_read_char;
-            $begin = $time;
-        }
-        if (time > $time) {
-            $time = time;
-            call_hooks(
-                "prompt_idle",
-                $cart,
-                (@$plugins > 1 ? undef : $plugins->[0]), # >1 plugin = main loop
-                $time - $begin,
-                $readline,
-            );
-        }
-    }
-
-    print "\e[0m";
-    defined $input or return;
-    $readline->addhistory($input);
-
-    $input =~ s/^\s+//;  # trim leading whitespace
-    $input =~ s/\s+$//;  # trim trailing whitespace
-
-    return $input;
-}
-
 RevBank::Plugins->load;
 
 call_hooks("startup");
 
+my $retry;  # reason (text)
+my @retry;  # (@accepted, $rejected, [@trailing])
+
+my $prompt;
+my @plugins;
+my $method;
+
+sub abort {
+    @words = ();
+    @retry = ();
+
+    my $is_interrupt = @_ && $_[0] eq "^C";
+    print "\n" if $is_interrupt;
+
+    if ($is_interrupt and $cart->size and ref $method) {
+        call_hooks "interrupt", $cart, \@_;
+        call_hooks "cart_changed", $cart;  # XXX ugly; refactor redisplay with instructions
+        print "Pressing ^C again will also abort.\n";
+    } else {
+        print @_, " " unless $is_interrupt;
+        call_hooks "abort", $cart, \@_;
+        $cart->empty;
+        RevBank::FileIO::release_all_locks;
+    }
+    no warnings qw(exiting);
+    redo OUTER;
+}
+
 OUTER: for (;;) {
     if (not @words) {
         call_hooks("cart_changed", $cart) if $cart->changed;
         print "\n";
     }
 
-    my $split_input = 1;
-    my $prompt = "";
-    my @plugins = RevBank::Plugins->new;
-    my $method = "command";
-
-    sub abort {
-        print @_, " " if @_;
-        @words = ();
-        @retry = ();
-        call_hooks "abort", $cart, \@_;
-        $cart->empty;
-        { no warnings; redo OUTER; }
-    }
+    $prompt = "";
+    @plugins = RevBank::Plugins->new;
+    $method = "command";
 
     PROMPT: {
         if (not @words) {
@@ -155,73 +99,157 @@ OUTER: for (;;) {
             }
 
             call_hooks "prompt", $cart, $prompt;
+            my $split_input = !ref($method) && $method eq 'command';
 
-            my %completions = qw(abort 1);
-            for my $plugin (@plugins) {
-                my $attr = attributes::get(
-                    ref $method ? $method : $plugin->can($method)
-                ) or next;
-                my ($tab) = $attr =~ /Tab \( (.*?) \)/x;
-                for my $keyword (split /\s*,\s*/, $tab) {
-                    if ($keyword =~ /^&(.*)/) {
-                        my $method = $1;
-                        @completions{ $plugin->$method } = ();
-                    } else {
-                        $completions{ $keyword }++;
+            my @completions = uniq 'abort', map $_->Tab($method), @plugins;
+
+            my $default = "";
+            my $pos = 0;
+
+            if ($retry) {
+                print "$retry\n";
+
+                my $word_based = ref($retry[-1]);
+                my @trailing = $word_based ? @{ pop @retry } : ();
+                my @rejected = pop @retry;
+                my @accepted = @retry;
+
+                if ($word_based) {
+                    for (@accepted, @rejected, @trailing) {
+                        $_ = RevBank::Prompt::reconstruct($_);
                     }
                 }
-            }
-            if (delete $completions{USERS}) {
-                $completions{$_}++ for RevBank::Users::names;
-            }
-            if (delete $completions{NOABORT}) {
-                delete $completions{abort};
+
+                my $sep = $word_based ? " " : "";
+                $default = join($sep, @accepted, @rejected, @trailing);
+                $pos = @accepted ? length "@accepted$sep" : 0;
+
+                @retry = ();
+                $retry = 0;
             }
 
-            my $input = prompt $prompt, \@plugins, [ keys %completions ];
+            my $input = RevBank::Prompt::prompt(
+                $prompt, \@completions, $default, $pos, $cart, \@plugins
+            );
+            if (not defined $input) {
+                exit if not ttyname fileno STDIN;  # Controlling terminal gone
+            }
 
             call_hooks "input", $cart, $input, $split_input;
 
             length $input or redo PROMPT;
 
-            @words = ($split_input ? split(" ", $input) : $input);
+            if ($split_input) {
+                @words = RevBank::Prompt::split_input($input);
+                if (ref $words[0]) {
+                    my $pos = ${ $words[0] };
+
+                    @retry = @words = ();
+                    $retry = "Syntax error.";
+
+                    if ($input =~ /['"]/) {
+                        $retry .= " (Quotes must match and (only) be at both ends of a term.)";
+                        if (($input =~ tr/'//) == 1 and $input !~ /"/) {
+                            $retry .= "\nDid you mean: " . $input =~ s/'/\\'/r;
+                        }
+                    }
+
+                    push @retry, substr($input, 0, $pos) if $pos > 0;
+                    push @retry, substr($input, $pos);
+                    redo PROMPT;
+                }
+            } else {
+                $input = "\0ABORT" if $input =~ /^\s*abort\s*$/;
+                @words = $input;
+            }
         }
 
         WORD: for (;;) {
             redo PROMPT if not @words;
-            abort if grep $_ eq 'abort', @words;
+            abort if grep $_ eq "\0ABORT", @words;
+
+            my $origword = my $word = shift @words;
+            my @allwords = ($origword);
+
+            next WORD if $word eq "\0SEPARATOR";
+
+            abort if $method eq "command" and $word eq "abort";  # here, even when quoted
+
 
-            my $word = shift @words;
             push @retry, $word;
-            $split_input = 0;  # Only split 'outer' input.
 
-            PLUGIN: for my $plugin (@plugins) {
-                my ($rv, @rvargs) = eval { $plugin->$method($cart, $word) };
-                if ($@) {
-                    call_hooks "plugin_fail", $plugin->id, $@;
+            ALL_PLUGINS: { PLUGIN: for my $plugin (@plugins) {
+
+                $cart->prohibit_checkout(
+                    @words && $words[0] ne "\0SEPARATOR",
+                    "unexpected trailing input (use ';' to separate transactions)."
+                );
+
+                my $coderef = ref($method) ? $method : $plugin->can($method);
+                my ($mname) = $coderef
+                    ? (subname($coderef) eq "__ANON__" ? "" : subname($coderef) . ": ")
+                    : (ref($method) ? "" : "$method: ");
+
+                my ($rv, @rvargs) =
+
+                    ($word =~ /[^\x20-\x7f]/ and $method eq 'command' || !$plugin->AllChars($method))
+
+                    ? (REJECT, "Unexpected control character in input.")
+                    : eval { $plugin->$method($cart, $word) };
+
+                if ($@ isa 'RevBank::Cart::CheckoutProhibited') {
+                    @words or die "Internal inconsistency";  # other cause than trailing input
+
+                    push @retry, shift @words;  # reject next word (first of trailing)
+                    push @retry, [@words];
+                    @words = ();
+                    $retry = $@->reason;
+                    redo OUTER;
+                } elsif ($@ isa 'RevBank::Exception::RejectInput') {
+                    $rv = REJECT;
+                    @rvargs = $@->reason;
+                } elsif ($@) {
+                    call_hooks "plugin_fail", $plugin->id, "$mname$@";
                     abort;
                 }
+
                 if (not defined $rv) {
-                    call_hooks "plugin_fail", $plugin->id, "No return code";
+                    call_hooks "plugin_fail", $plugin->id, $mname . "No return code";
                     abort;
                 }
                 if (not ref $rv) {
+                    abort "Incomplete command." if $one_off and not @words;
+
+                    if (@words and $words[0] eq "\0SEPARATOR") {
+                        push @retry, shift @words;  # reject the ';'
+                        push @retry, [@words];
+                        @words = ();
+                        $retry = "Incomplete command (expected: $rv)";
+                        redo OUTER;
+                    }
+
                     $prompt = $rv;
                     @plugins = $plugin;
                     ($method) = @rvargs;
-                    call_hooks "plugin_fail", $plugin->id, "No method supplied"
-                        if not ref $method;
+                    if (not ref $method) {
+                        call_hooks "plugin_fail", $plugin->id, $mname . "No method supplied";
+                        abort;
+                    }
 
-                    abort "Incomplete command." if $one_off and not @words;
                     next WORD;
                 }
                 if ($rv == ABORT) {
                     abort(@rvargs);
                 }
+                if ($rv == REDO) {
+                    $word = $rvargs[0];
+                    call_hooks "redo", $plugin->id, $origword, $word;
+                    push @allwords, $word;
+
+                    redo ALL_PLUGINS;
+                }
                 if ($rv == REJECT) {
                     my ($reason) = @rvargs;
-                    #abort if @words;
-
                     if (@words) {
                         call_hooks "retry", $plugin->id, $reason, @words ? 1 : 0;
                         push @retry, [@words];
@@ -235,23 +263,31 @@ OUTER: for (;;) {
                     }
                 }
                 if ($rv == ACCEPT) {
+                    if ($method ne 'command' and @words and $words[0] ne "\0SEPARATOR") {
+                        @retry = ();  # remove what's already done
+                        push @retry, shift @words;  # reject first
+                        push @retry, [@words];
+                        @words = ();
+                        $retry = "Confirm trailing input to execute. (Hint: use ';' after command arguments.)";
+                        redo OUTER;
+                    }
                     @retry = ();
                     next OUTER;
                 }
                 if ($rv == NEXT) {
                     next PLUGIN if $method eq 'command';
-                    call_hooks "plugin_fail", $plugin->id, "Only 'command' "
-                        . "should ever return NEXT.";
+                    call_hooks "plugin_fail", $plugin->id, $mname
+                        . "Only 'command' should ever return NEXT.";
                     abort;
                 }
-                call_hooks "plugin_fail", $plugin->id, "Invalid return value";
+                call_hooks "plugin_fail", $plugin->id, $mname . "Invalid return value";
                 abort;
             }
-            call_hooks "invalid_input", $cart, $word;
+            call_hooks "invalid_input", $cart, $origword, $word, \@allwords;
             @retry = ();
             abort if @words;
             redo OUTER;
-        }
+        } }
     }
 }