Cleanup: use subroutine signatures, remove deprecated methods.
The signatures feature has been "experimental" since Perl 5.20 (May 2014), but expected to stay. After 8 years I'm ready to take the risk :) Have added Perl v5.28 (June 2018) as the minimum requirement, even though the current revbank should work with 5.20, to see if this bothers any users. Perl v5.28 is in Debian "buster", which is now oldstable.
This commit is contained in:
Juerd Waalboer
parent
1661661ffd
commit
eed0db7897
45 changed files with 233 additions and 444 deletions
|
|
@ -1,7 +1,10 @@
|
|||
package RevBank::Amount;
|
||||
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use experimental qw(signatures);
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
use Carp qw(carp croak);
|
||||
use Scalar::Util;
|
||||
use POSIX qw(lround);
|
||||
|
|
|
|||
|
|
@ -1,50 +1,41 @@
|
|||
package RevBank::Cart;
|
||||
use strict;
|
||||
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
use Carp ();
|
||||
use List::Util ();
|
||||
use RevBank::Global;
|
||||
use RevBank::Cart::Entry;
|
||||
|
||||
sub new {
|
||||
my ($class) = @_;
|
||||
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);
|
||||
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 = {}) {
|
||||
Carp::croak "Unitialized amount; possibly a deprecated call style (\$cart->add(undef, ...))"
|
||||
if not defined $amount;
|
||||
Carp::croak "Non-hash data argument; possibly a deprecated call style (\$cart->add(\$user, ...)"
|
||||
if @_ == 4 and not ref $data;
|
||||
Carp::croak "Missing description; possibly a deprecated call style (\$cart->add(\$entry); use add_entry instead)"
|
||||
if not defined $description;
|
||||
|
||||
# ->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;
|
||||
|
||||
my ($self, $entry) = @_;
|
||||
sub delete($self, $entry) {
|
||||
my $entries = $self->{entries};
|
||||
|
||||
my $oldnum = @$entries;
|
||||
|
|
@ -54,27 +45,20 @@ 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) = @_;
|
||||
|
||||
sub checkout($self, $user) {
|
||||
if ($self->entries('refuse_checkout')) {
|
||||
warn "Refusing to finalize deficient transaction.\n";
|
||||
$self->display;
|
||||
|
|
@ -108,17 +92,13 @@ sub checkout {
|
|||
return 1;
|
||||
}
|
||||
|
||||
sub entries {
|
||||
my ($self, $attribute) = @_;
|
||||
|
||||
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) {
|
||||
my $changed = 0;
|
||||
for my $entry ($self->entries('changed')) {
|
||||
$entry->attribute('changed', undef);
|
||||
|
|
@ -128,78 +108,8 @@ sub changed {
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1,16 +1,14 @@
|
|||
use strict;
|
||||
|
||||
package RevBank::Cart::Entry;
|
||||
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
use Carp qw(carp croak);
|
||||
use List::Util ();
|
||||
|
||||
sub new {
|
||||
my ($class, $amount, $description, $attributes) = @_;
|
||||
|
||||
@_ >= 3 or croak "Not enough arguments for RevBank::Cart::Entry->new";
|
||||
$attributes //= {};
|
||||
|
||||
sub new($class, $amount, $description, $attributes = {}) {
|
||||
$amount = RevBank::Amount->parse_string($amount) if not ref $amount;
|
||||
|
||||
my $self = {
|
||||
|
|
@ -26,9 +24,7 @@ sub new {
|
|||
return bless $self, $class;
|
||||
}
|
||||
|
||||
sub add_contra {
|
||||
my ($self, $user, $amount, $description) = @_;
|
||||
|
||||
sub add_contra($self, $user, $amount, $description) {
|
||||
$amount = RevBank::Amount->parse_string($amount) if not ref $amount;
|
||||
|
||||
$description =~ s/\$you/$self->{user}/g if defined $self->{user};
|
||||
|
|
@ -42,26 +38,20 @@ sub add_contra {
|
|||
$self->attribute('changed', 1);
|
||||
}
|
||||
|
||||
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 = undef) {
|
||||
my $ref = \$self->{attributes}->{$key};
|
||||
$$ref = $new if @_ > 2;
|
||||
return $$ref;
|
||||
}
|
||||
|
||||
sub quantity {
|
||||
my ($self, $new) = @_;
|
||||
|
||||
sub quantity($self, $new = undef) {
|
||||
my $ref = \$self->{quantity};
|
||||
if (defined $new) {
|
||||
$new >= 0 or croak "Quantity must be positive";
|
||||
|
|
@ -72,22 +62,16 @@ sub quantity {
|
|||
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 as_printable($self) {
|
||||
$self->sanity_check;
|
||||
|
||||
my @s;
|
||||
|
|
@ -113,9 +97,7 @@ sub as_printable {
|
|||
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;
|
||||
|
||||
|
|
@ -143,9 +125,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,9 +136,7 @@ sub user {
|
|||
return $self->{user};
|
||||
}
|
||||
|
||||
sub sanity_check {
|
||||
my ($self) = @_;
|
||||
|
||||
sub sanity_check($self) {
|
||||
# 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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,10 @@
|
|||
package RevBank::Global;
|
||||
use strict;
|
||||
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
use POSIX qw(strftime);
|
||||
use RevBank::Amount;
|
||||
|
||||
|
|
@ -14,8 +19,7 @@ sub import {
|
|||
*{"$caller\::NEXT"} = sub () { \4 };
|
||||
*{"$caller\::DONE"} = sub () { \5 };
|
||||
*{"$caller\::parse_user"} = \&RevBank::Users::parse_user;
|
||||
*{"$caller\::parse_amount"} = sub {
|
||||
my ($amount) = @_;
|
||||
*{"$caller\::parse_amount"} = sub ($amount) {
|
||||
defined $amount or return undef;
|
||||
length $amount or return undef;
|
||||
|
||||
|
|
@ -32,7 +36,7 @@ sub import {
|
|||
*{"$caller\::say"} = sub {
|
||||
print @_, "\n";
|
||||
};
|
||||
*{"$caller\::now"} = sub {
|
||||
*{"$caller\::now"} = sub () {
|
||||
return strftime '%Y-%m-%d_%H:%M:%S', localtime;
|
||||
};
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,10 @@
|
|||
package RevBank::Messages;
|
||||
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
use RevBank::Global;
|
||||
use base 'RevBank::Plugin';
|
||||
|
||||
|
|
@ -16,13 +22,11 @@ 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;
|
||||
|
|
@ -35,23 +39,19 @@ sub hook_cart_changed {
|
|||
}
|
||||
}
|
||||
|
||||
sub hook_abort {
|
||||
my ($class, $cart) = @_;
|
||||
sub hook_abort($class, $cart, @) {
|
||||
say "\e[1;4mABORTING TRANSACTION.\e[0m";
|
||||
}
|
||||
|
||||
sub hook_invalid_input {
|
||||
my ($class, $cart, $word) = @_;
|
||||
sub hook_invalid_input($class, $cart, $word, @) {
|
||||
say "$word: No such product, user, or command.";
|
||||
}
|
||||
|
||||
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) = @_;
|
||||
sub hook_user_balance($class, $username, $old, $delta, $new, @) {
|
||||
my $sign = $delta->cents >= 0 ? '+' : '-';
|
||||
my $rood = $new->cents < 0 ? '31;' : '';
|
||||
my $abs = $delta->abs;
|
||||
|
|
@ -61,8 +61,7 @@ sub hook_user_balance {
|
|||
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, @) {
|
||||
say "New account '$username' created.";
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,12 +1,16 @@
|
|||
package RevBank::Plugin;
|
||||
use strict;
|
||||
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
require RevBank::Global;
|
||||
|
||||
sub new {
|
||||
my ($class) = @_;
|
||||
sub new($class) {
|
||||
return bless { }, $class;
|
||||
}
|
||||
sub command {
|
||||
sub command($self, $cart, $command, @) {
|
||||
return RevBank::Global::NEXT();
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,10 @@
|
|||
package RevBank::Plugins;
|
||||
use strict;
|
||||
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
use RevBank::Eval;
|
||||
use RevBank::Plugin;
|
||||
use RevBank::Global;
|
||||
|
|
@ -8,17 +13,16 @@ 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;
|
||||
sub call_hooks($hook, @args) {
|
||||
my $method = "hook_$hook";
|
||||
for my $class (@plugins) {
|
||||
if ($class->can($method)) {
|
||||
my ($rv, $message) = $class->$method(@_);
|
||||
my ($rv, $message) = $class->$method(@args);
|
||||
|
||||
if (defined $rv and ref $rv) {
|
||||
main::abort($message) if $rv == ABORT;
|
||||
|
|
@ -28,12 +32,12 @@ sub call_hooks {
|
|||
}
|
||||
};
|
||||
|
||||
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,12 +52,13 @@ sub load {
|
|||
}
|
||||
RevBank::Eval::clean_eval(qq[
|
||||
use strict;
|
||||
use feature qw(signatures);
|
||||
no warnings 'experimental::signatures';
|
||||
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;
|
||||
}
|
||||
|
|
@ -79,7 +84,7 @@ sub load {
|
|||
}
|
||||
}
|
||||
|
||||
sub new {
|
||||
sub new($class) {
|
||||
return map $_->new, @plugins;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -45,12 +45,12 @@ 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 may
|
||||
define one C<command> input method, and can have any number of hooks.
|
||||
|
|
@ -118,31 +118,34 @@ 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.
|
||||
|
||||
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.
|
||||
|
|
@ -153,32 +156,32 @@ 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($class, $cart, $user, $transaction_id, @)
|
||||
|
||||
Called when the transaction is finalized, before accounts are updated.
|
||||
|
||||
=item hook_checkout_done $class, $cart, $user, $transaction_id
|
||||
=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.
|
||||
|
||||
|
|
@ -189,7 +192,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"
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,16 @@
|
|||
package RevBank::Users;
|
||||
use strict;
|
||||
|
||||
use v5.28;
|
||||
use warnings;
|
||||
use feature qw(signatures);
|
||||
no warnings qw(experimental::signatures);
|
||||
|
||||
use RevBank::Global;
|
||||
use RevBank::Plugins;
|
||||
|
||||
my $filename = "revbank.accounts";
|
||||
|
||||
sub _read {
|
||||
sub _read() {
|
||||
my @users;
|
||||
open my $fh, $filename or die $!;
|
||||
/\S/ and push @users, [split " "] while readline $fh;
|
||||
|
|
@ -13,22 +18,19 @@ sub _read {
|
|||
return { map { lc($_->[0]) => $_ } @users };
|
||||
}
|
||||
|
||||
sub names {
|
||||
sub names() {
|
||||
return map $_->[0], values %{ _read() };
|
||||
}
|
||||
|
||||
sub balance {
|
||||
my ($name) = @_;
|
||||
return _read()->{ lc $name }->[1];
|
||||
sub balance($username) {
|
||||
return _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) = @_;
|
||||
sub create($username) {
|
||||
open my $fh, '>>', $filename or die $!;
|
||||
my $now = now();
|
||||
print {$fh} "$username 0.00 $now\n" or die $!;
|
||||
|
|
@ -36,8 +38,7 @@ sub create {
|
|||
RevBank::Plugins::call_hooks("user_created", $username);
|
||||
}
|
||||
|
||||
sub update {
|
||||
my ($username, $delta, $transaction_id) = @_;
|
||||
sub update($username, $delta, $transaction_id) {
|
||||
open my $in, 'revbank.accounts' or die $!;
|
||||
open my $out, ">.revbank.$$" or die $!;
|
||||
my $old;
|
||||
|
|
@ -75,8 +76,7 @@ sub update {
|
|||
);
|
||||
}
|
||||
|
||||
sub parse_user {
|
||||
my ($username) = @_;
|
||||
sub parse_user($username) {
|
||||
my $users = _read();
|
||||
return undef if not exists $users->{ lc $username };
|
||||
return $users->{ lc $username }->[0];
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue