
There's a slight mismatch between what users experience as a command, and how commands are defined in RevBank. Specifically, the common input "<productid> <username>" is two separate commands: the first adds the product to the cart, the second finalizes the transaction. This also means that "<productid> <username> <productid> <username>" was four separate commands, resulting in TWO transactions. That's all fine and useful, but when using this advanced input method, where input is split on whitespace, it lead to unexpected results if there are insufficient arguments for the follow-up questions of a command. For example, "take jantje 10 take pietje 10" will interpret the second "take" as the description, then "pietje" als the first command of a new transaction, and finally, "10" which is typically not a valid command. It is much more likely that the user intended two separate "take" commands and just forgot to provide the description argument, but RevBank had no way of inferring that intent. From this commit on, whenever the user intends to enter further input words beyond the one that finalizes a transaction ($cart->checkout), a ';' is required. If trailing input is present, the checkout is refused and the user gets a retry prompt. Similarly, if the user indicates the intention of having finished a command by inserting a ';' while there are insufficient words in the command line to satisfy all follow-up prompts (command arguments), the rest of the command line is rejected with a retry prompt. There is, however, still no specific requirement for a ';' separator after a command that does not finalize a transaction (e.g. "<productid> <username>" or even "<productid> x2 <productid> <username>" remains valid), or for a command that precedes a ';' to finalize a transaction (e.g. "<productid>; <username>;" is also valid). This change catches many, but not all, mistakes.
180 lines
4.5 KiB
Perl
180 lines
4.5 KiB
Perl
package RevBank::Cart;
|
|
|
|
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;
|
|
|
|
{
|
|
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($self, $entry) {
|
|
RevBank::Plugins::call_hooks("add_entry", $self, $entry);
|
|
|
|
push @{ $self->{entries} }, $entry;
|
|
$self->{changed}++;
|
|
$self->select($entry);
|
|
|
|
RevBank::Plugins::call_hooks("added_entry", $self, $entry);
|
|
|
|
return $entry;
|
|
}
|
|
|
|
sub add($self, $amount, $description, $data = {}) {
|
|
ref $data or Carp::croak "Non-hash data argument";
|
|
|
|
return $self->add_entry(RevBank::Cart::Entry->new($amount, $description, $data));
|
|
}
|
|
|
|
sub select($self, $entry) {
|
|
return $self->{selected_entry} = $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;
|
|
@$entries = grep $_ != $entry, @$entries;
|
|
$self->{changed}++;
|
|
|
|
return $oldnum - @$entries;
|
|
}
|
|
|
|
sub empty($self) {
|
|
$self->{entries} = [];
|
|
$self->{changed}++;
|
|
}
|
|
|
|
sub display($self, $prefix = "") {
|
|
say "$prefix$_" for map $_->as_printable, @{ $self->{entries} };
|
|
}
|
|
|
|
sub size($self) {
|
|
return scalar @{ $self->{entries} };
|
|
}
|
|
|
|
sub prohibit_checkout($self, $bool, $reason) {
|
|
if ($bool) {
|
|
$self->{prohibited} = $reason;
|
|
} else {
|
|
delete $self->{prohibited};
|
|
}
|
|
}
|
|
|
|
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 = ($user => RevBank::Amount->new(0));
|
|
|
|
for my $entry (@$entries) {
|
|
$deltas{$_->{user}} += $_->{amount} * $entry->quantity
|
|
for $entry, $entry->contras;
|
|
}
|
|
|
|
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($self, $keep = 0) {
|
|
my $changed = 0;
|
|
for my $entry ($self->entries('changed')) {
|
|
$entry->attribute('changed', undef) unless $keep;
|
|
$changed = 1;
|
|
}
|
|
$changed = 1 if $self->{changed};
|
|
delete $self->{changed} unless $keep;
|
|
|
|
return $changed;
|
|
}
|
|
|
|
sub sum($self) {
|
|
return List::Util::sum(map $_->{amount} * $_->quantity, @{ $self->{entries} });
|
|
}
|
|
|
|
1;
|