New plugin: repeat (undocumented), new hook: "added"
This commit is contained in:
parent
b0ee7e88bf
commit
add3100401
7 changed files with 171 additions and 27 deletions
|
@ -10,7 +10,7 @@ use RevBank::Global;
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my ($class) = @_;
|
my ($class) = @_;
|
||||||
return bless { }, $class;
|
return bless { items => {} }, $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub add {
|
sub add {
|
||||||
|
@ -22,18 +22,21 @@ sub add {
|
||||||
description => $description,
|
description => $description,
|
||||||
};
|
};
|
||||||
RevBank::Plugins::call_hooks("add", $self, $user, $item);
|
RevBank::Plugins::call_hooks("add", $self, $user, $item);
|
||||||
$user ||= '$you';
|
push @{ $self->{items}{ $user || '$you' } }, $item;
|
||||||
push @{ $self->{ $user } }, $item;
|
$self->{changed}++;
|
||||||
|
RevBank::Plugins::call_hooks("added", $self, $user, $item);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub delete {
|
sub delete {
|
||||||
my ($self, $user, $index) = @_;
|
my ($self, $user, $index) = @_;
|
||||||
splice @{ $self->{ $user } }, $index, 1, ();
|
splice @{ $self->{items}{ $user } }, $index, 1, ();
|
||||||
|
$self->{changed}++;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub empty {
|
sub empty {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
%$self = ();
|
%$self = (items => {});
|
||||||
|
$self->{changed}++;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub _dump_item {
|
sub _dump_item {
|
||||||
|
@ -54,8 +57,9 @@ sub as_strings {
|
||||||
|
|
||||||
my @s;
|
my @s;
|
||||||
|
|
||||||
for my $user (sort keys %$self) {
|
my $items = $self->{items};
|
||||||
my @items = @{ $self->{$user} };
|
for my $user (sort keys %$items) {
|
||||||
|
my @items = @{ $items->{$user} };
|
||||||
my $sum = List::Util::sum(map $_->{amount}, @items);
|
my $sum = List::Util::sum(map $_->{amount}, @items);
|
||||||
|
|
||||||
push @s, _dump_item($prefix, $user, $_->{amount}, "# $_->{description}")
|
push @s, _dump_item($prefix, $user, $_->{amount}, "# $_->{description}")
|
||||||
|
@ -74,20 +78,22 @@ sub display {
|
||||||
|
|
||||||
sub size {
|
sub size {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return List::Util::sum(map scalar @{ $self->{$_} }, keys %$self) || 0;
|
my $items = $self->{items};
|
||||||
|
return List::Util::sum(map scalar @{ $items->{$_} }, keys %$items) || 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub _set_user {
|
sub _set_user {
|
||||||
my ($self, $user) = @_;
|
my ($self, $user) = @_;
|
||||||
|
my $items = $self->{items};
|
||||||
|
|
||||||
exists $self->{'$you'}
|
exists $items->{'$you'}
|
||||||
or Carp::croak("Error: no cart items for shell user");
|
or Carp::croak("Error: no cart items for shell user");
|
||||||
|
|
||||||
$self->{$user} ||= [];
|
$items->{$user} ||= [];
|
||||||
|
|
||||||
push @{ $self->{$user} }, @{ delete $self->{'$you'} };
|
push @{ $items->{$user} }, @{ delete $items->{'$you'} };
|
||||||
|
|
||||||
for (values %$self) {
|
for (values %$items) {
|
||||||
$_->{description} =~ s/\$you\b/$user/g for @$_;
|
$_->{description} =~ s/\$you\b/$user/g for @$_;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -96,14 +102,15 @@ sub checkout {
|
||||||
my ($self, $user) = @_;
|
my ($self, $user) = @_;
|
||||||
|
|
||||||
$self->_set_user($user) if $user;
|
$self->_set_user($user) if $user;
|
||||||
|
my $items = $self->{items};
|
||||||
|
|
||||||
exists $self->{'$you'} and die "Incomplete transaction; user not set.";
|
exists $items->{'$you'} and die "Incomplete transaction; user not set.";
|
||||||
|
|
||||||
my $transaction_id = time() - 1300000000;
|
my $transaction_id = time() - 1300000000;
|
||||||
RevBank::Plugins::call_hooks("checkout", $self, $user, $transaction_id);
|
RevBank::Plugins::call_hooks("checkout", $self, $user, $transaction_id);
|
||||||
|
|
||||||
for my $account (keys %$self) {
|
for my $account (keys %$items) {
|
||||||
my $sum = List::Util::sum(map $_->{amount}, @{ $self->{$account} });
|
my $sum = List::Util::sum(map $_->{amount}, @{ $items->{$account} });
|
||||||
RevBank::Users::update($account, $sum, $transaction_id);
|
RevBank::Users::update($account, $sum, $transaction_id);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -114,10 +121,11 @@ sub checkout {
|
||||||
|
|
||||||
sub select_items {
|
sub select_items {
|
||||||
my ($self, $key) = @_;
|
my ($self, $key) = @_;
|
||||||
|
my $items = $self->{items};
|
||||||
|
|
||||||
my @matches;
|
my @matches;
|
||||||
for my $user (keys %$self) {
|
for my $user (keys %$items) {
|
||||||
for my $item (@{ $self->{$user} }) {
|
for my $item (@{ $items->{$user} }) {
|
||||||
push @matches, { user => $user, %$item }
|
push @matches, { user => $user, %$item }
|
||||||
if @_ == 1 # No key or match given: match everything
|
if @_ == 1 # No key or match given: match everything
|
||||||
or @_ == 2 and exists $item->{ $key } # Just a key
|
or @_ == 2 and exists $item->{ $key } # Just a key
|
||||||
|
@ -129,7 +137,12 @@ sub select_items {
|
||||||
|
|
||||||
sub is_multi_user {
|
sub is_multi_user {
|
||||||
my ($self) = @_;
|
my ($self) = @_;
|
||||||
return keys(%$self) > 1;
|
return keys(%{ $self->{items} }) > 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub changed {
|
||||||
|
my ($self) = @_;
|
||||||
|
return delete $self->{changed};
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -2,6 +2,7 @@ package RevBank::Plugins;
|
||||||
use strict;
|
use strict;
|
||||||
use RevBank::Eval;
|
use RevBank::Eval;
|
||||||
use RevBank::Plugin;
|
use RevBank::Plugin;
|
||||||
|
use RevBank::Global;
|
||||||
use Exporter;
|
use Exporter;
|
||||||
our @EXPORT = qw(call_hooks load_plugins);
|
our @EXPORT = qw(call_hooks load_plugins);
|
||||||
|
|
||||||
|
@ -16,7 +17,14 @@ sub call_hooks {
|
||||||
my $hook = shift;
|
my $hook = shift;
|
||||||
my $method = "hook_$hook";
|
my $method = "hook_$hook";
|
||||||
for my $class (@plugins) {
|
for my $class (@plugins) {
|
||||||
$class->$method(@_) if $class->can($method);
|
if ($class->can($method)) {
|
||||||
|
my ($rv, $message) = $class->$method(@_);
|
||||||
|
|
||||||
|
if (defined $rv and ref $rv) {
|
||||||
|
main::abort($message) if $rv == ABORT;
|
||||||
|
warn "$class->$method returned an unsupported value.\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
|
@ -27,7 +27,7 @@ sub product :Tab(&tab) {
|
||||||
my $pfand = _read_pfand->{ $product };
|
my $pfand = _read_pfand->{ $product };
|
||||||
|
|
||||||
if ($pfand) {
|
if ($pfand) {
|
||||||
$cart->add(undef, +$pfand, "Pfand zurueck", { is_pfand => 1 });
|
$cart->add(undef, +$pfand, "Pfand zurueck", { is_return => 1 });
|
||||||
} else {
|
} else {
|
||||||
say "$product: Kein Pfand";
|
say "$product: Kein Pfand";
|
||||||
}
|
}
|
||||||
|
@ -41,11 +41,11 @@ sub tab {
|
||||||
sub hook_add {
|
sub hook_add {
|
||||||
my ($class, $cart, $user, $item) = @_;
|
my ($class, $cart, $user, $item) = @_;
|
||||||
return if defined $user;
|
return if defined $user;
|
||||||
return if exists $item->{is_pfand};
|
return if exists $item->{is_return};
|
||||||
return if not exists $item->{product_id};
|
return if not exists $item->{product_id};
|
||||||
|
|
||||||
my $pfand = _read_pfand->{ $item->{product_id} } or return;
|
my $pfand = _read_pfand->{ $item->{product_id} } or return;
|
||||||
|
|
||||||
$cart->add(undef, -$pfand, "Pfand");
|
$cart->add(undef, -$pfand, "Pfand", { is_pfand => 1 });
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
111
plugins/repeat
Normal file
111
plugins/repeat
Normal file
|
@ -0,0 +1,111 @@
|
||||||
|
my $err_stacked = "Stacked repetition is not supported.";
|
||||||
|
my $err_multi = "Repetition not supported in multi-user transactions.";
|
||||||
|
my $err_pfand = "Plugins 'pfand' and 'repeat' cannot be combined.";
|
||||||
|
|
||||||
|
my $limit = 24;
|
||||||
|
my $err_limit = "Repetition is limited at $limit items.";
|
||||||
|
|
||||||
|
sub _do_repeat {
|
||||||
|
my ($cart, $item, $num) = @_;
|
||||||
|
|
||||||
|
my $data = $item->{data};
|
||||||
|
$data->{_repeated} = 1;
|
||||||
|
|
||||||
|
$cart->add( @{ $item }{qw/user amount description/}, $data ) for 2..$num;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub command {
|
||||||
|
my ($self, $cart, $command) = @_;
|
||||||
|
|
||||||
|
my @items = $cart->select_items;
|
||||||
|
my $last = $items[-1];
|
||||||
|
|
||||||
|
return ABORT, $err_pfand if grep $_->{is_pfand}, @items;
|
||||||
|
|
||||||
|
my ($pre, $post) = $command =~ /^(\d+)?[x*](\d+)?$/
|
||||||
|
or return NEXT;
|
||||||
|
|
||||||
|
return NEXT if $pre and $post; # 123x123 -> invalid syntax
|
||||||
|
|
||||||
|
return REJECT, $err_multi if $cart->is_multi_user;
|
||||||
|
|
||||||
|
if ($post) {
|
||||||
|
return REJECT, $err_limit if $post > $limit;
|
||||||
|
return ABORT, "Can't repeat an empty transaction." if not $cart->size;
|
||||||
|
return REJECT, $err_stacked if $last->{_repeated};
|
||||||
|
|
||||||
|
_do_repeat($cart, $last, $post);
|
||||||
|
return ACCEPT;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $item_replaced;
|
||||||
|
|
||||||
|
if (not $pre and not $post) {
|
||||||
|
# Lone operator. Convert withdrawal into repetition.
|
||||||
|
|
||||||
|
if ($last->{is_withdrawal}) {
|
||||||
|
$pre = abs $last->{amount};
|
||||||
|
$pre == int $pre or return REJECT, "Repeat only works on integers.";
|
||||||
|
$cart->delete($last->{user}, -1);
|
||||||
|
$item_replaced = 1;
|
||||||
|
} elsif (not $cart->size) {
|
||||||
|
return ABORT, "Can't repeat an empty transaction.";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($pre) {
|
||||||
|
$pre = abs $pre; # withdrawal is negative
|
||||||
|
|
||||||
|
return REJECT, $err_limit if $pre > $limit;
|
||||||
|
$cart->add(undef, 0, "Next product repeated $pre times", { _repeat => abs $pre });
|
||||||
|
return ACCEPT;
|
||||||
|
}
|
||||||
|
|
||||||
|
return REJECT, $err_stacked if $last->{_repeated};
|
||||||
|
return "Multiply previous product by", \&repeat;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub repeat {
|
||||||
|
my ($self, $cart, $arg) = @_;
|
||||||
|
|
||||||
|
$arg =~ /^\d+$/ and $arg > 0
|
||||||
|
or return REJECT, "Invalid value.";
|
||||||
|
|
||||||
|
return REJECT, $err_limit if $arg > $limit;
|
||||||
|
|
||||||
|
my @items = $cart->select_items;
|
||||||
|
my $last = $items[-1];
|
||||||
|
|
||||||
|
_do_repeat($cart, $last, $arg);
|
||||||
|
return ACCEPT;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub hook_added {
|
||||||
|
my ($self, $cart, $user, $item) = @_;
|
||||||
|
$cart->size >= 2 or return;
|
||||||
|
|
||||||
|
return ABORT, $err_multi if $cart->is_multi_user;
|
||||||
|
|
||||||
|
my @repeats = $cart->select_items('_repeat');
|
||||||
|
return ABORT, "Multiple repeats queued; I'm confused." if @repeats > 1;
|
||||||
|
return if not @repeats;
|
||||||
|
|
||||||
|
my @items = $cart->select_items;
|
||||||
|
return ABORT, $err_pfand if grep $_->{is_pfand}, @items;
|
||||||
|
|
||||||
|
for my $i (0 .. $#items - 1) {
|
||||||
|
my $item = $items[$i];
|
||||||
|
$item->{_repeat} or next;
|
||||||
|
|
||||||
|
my $next = $items[$i + 1];
|
||||||
|
|
||||||
|
return ABORT, $err_stacked if $next->{_repeat};
|
||||||
|
|
||||||
|
my $num = $item->{_repeat};
|
||||||
|
$cart->delete($item->{user}, $i);
|
||||||
|
|
||||||
|
_do_repeat($cart, $next, $num);
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
14
plugins/voorbeeld
Normal file
14
plugins/voorbeeld
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
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";
|
||||||
|
}
|
||||||
|
|
||||||
|
|
|
@ -8,7 +8,8 @@ sub command {
|
||||||
my $amount = parse_amount($command);
|
my $amount = parse_amount($command);
|
||||||
defined $amount or return NEXT;
|
defined $amount or return NEXT;
|
||||||
|
|
||||||
$cart->add(undef, -$amount, "Withdrawal or unlisted product");
|
$cart->add(undef, -$amount, "Withdrawal or unlisted product",
|
||||||
|
{ is_withdrawal => 1 });
|
||||||
|
|
||||||
return ACCEPT;
|
return ACCEPT;
|
||||||
}
|
}
|
||||||
|
|
5
revbank
5
revbank
|
@ -79,16 +79,13 @@ RevBank::Plugins->load;
|
||||||
|
|
||||||
call_hooks("startup");
|
call_hooks("startup");
|
||||||
|
|
||||||
my $old_cart_size = 0;
|
|
||||||
|
|
||||||
my @words;
|
my @words;
|
||||||
|
|
||||||
OUTER: for (;;) {
|
OUTER: for (;;) {
|
||||||
print "\n" if not @words;
|
print "\n" if not @words;
|
||||||
|
|
||||||
if (not @words and $cart->size != $old_cart_size) {
|
if (not @words and $cart->changed) {
|
||||||
call_hooks("cart_changed", $cart);
|
call_hooks("cart_changed", $cart);
|
||||||
$old_cart_size = $cart->size;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
my $split_input = 1;
|
my $split_input = 1;
|
||||||
|
|
Loading…
Add table
Reference in a new issue