From eed0db78979ad5c0cb78251320d5e70eb8a9c856 Mon Sep 17 00:00:00 2001 From: Juerd Waalboer Date: Fri, 3 Dec 2021 18:00:34 +0100 Subject: [PATCH] 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. --- lib/RevBank/Amount.pm | 5 +- lib/RevBank/Cart.pm | 136 +++++++------------------------------- lib/RevBank/Cart/Entry.pm | 54 +++++---------- lib/RevBank/Global.pm | 12 ++-- lib/RevBank/Messages.pm | 27 ++++---- lib/RevBank/Plugin.pm | 12 ++-- lib/RevBank/Plugins.pm | 31 +++++---- lib/RevBank/Plugins.pod | 33 ++++----- lib/RevBank/Users.pm | 30 ++++----- plugins/adduser | 8 +-- plugins/beep | 3 +- plugins/beep_terminal | 4 +- plugins/deposit | 19 ++---- plugins/deposit_iban_qr | 4 +- plugins/deposit_methods | 4 +- plugins/dinnerbonus | 4 +- plugins/give | 16 ++--- plugins/grandtotal | 4 +- plugins/help | 4 +- plugins/idle | 37 +++++------ plugins/log | 27 +++----- plugins/market | 6 +- plugins/pfand | 12 ++-- plugins/plus | 8 +-- plugins/products | 6 +- plugins/repeat | 15 ++--- plugins/restart | 8 +-- plugins/revspace_barcode | 12 +--- plugins/revspace_bounties | 4 +- plugins/revspace_git | 3 +- plugins/revspace_mollie | 13 ++-- plugins/revspace_mqtt | 3 +- plugins/revspace_saldo | 8 +-- plugins/split | 11 +-- plugins/stock | 8 +-- plugins/tail | 4 +- plugins/take | 13 ++-- plugins/undo | 12 +--- plugins/unlisted | 9 +-- plugins/url | 3 +- plugins/users | 20 ++---- plugins/voorbeeld | 4 +- plugins/warnings | 5 +- plugins/withdraw | 4 +- revbank | 12 ++-- 45 files changed, 233 insertions(+), 444 deletions(-) diff --git a/lib/RevBank/Amount.pm b/lib/RevBank/Amount.pm index f27c5a9..4aa42c7 100644 --- a/lib/RevBank/Amount.pm +++ b/lib/RevBank/Amount.pm @@ -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); diff --git a/lib/RevBank/Cart.pm b/lib/RevBank/Cart.pm index d965d5f..817bbf0 100644 --- a/lib/RevBank/Cart.pm +++ b/lib/RevBank/Cart.pm @@ -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; diff --git a/lib/RevBank/Cart/Entry.pm b/lib/RevBank/Cart/Entry.pm index 58724da..36129f4 100644 --- a/lib/RevBank/Cart/Entry.pm +++ b/lib/RevBank/Cart/Entry.pm @@ -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. diff --git a/lib/RevBank/Global.pm b/lib/RevBank/Global.pm index 6dc6f53..f637904 100644 --- a/lib/RevBank/Global.pm +++ b/lib/RevBank/Global.pm @@ -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; }; diff --git a/lib/RevBank/Messages.pm b/lib/RevBank/Messages.pm index 05b7b45..7baaf83 100644 --- a/lib/RevBank/Messages.pm +++ b/lib/RevBank/Messages.pm @@ -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."; } diff --git a/lib/RevBank/Plugin.pm b/lib/RevBank/Plugin.pm index dfffc4d..9fc3231 100644 --- a/lib/RevBank/Plugin.pm +++ b/lib/RevBank/Plugin.pm @@ -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(); } diff --git a/lib/RevBank/Plugins.pm b/lib/RevBank/Plugins.pm index ded9e11..5e9e1e9 100644 --- a/lib/RevBank/Plugins.pm +++ b/lib/RevBank/Plugins.pm @@ -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; } diff --git a/lib/RevBank/Plugins.pod b/lib/RevBank/Plugins.pod index 02e0ba5..6b7652a 100644 --- a/lib/RevBank/Plugins.pod +++ b/lib/RevBank/Plugins.pod @@ -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 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, 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. 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" } diff --git a/lib/RevBank/Users.pm b/lib/RevBank/Users.pm index 5623870..eb33f80 100644 --- a/lib/RevBank/Users.pm +++ b/lib/RevBank/Users.pm @@ -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]; diff --git a/plugins/adduser b/plugins/adduser index 5564d74..9da44a5 100644 --- a/plugins/adduser +++ b/plugins/adduser @@ -2,9 +2,7 @@ HELP "adduser " => "Create an account"; -sub command :Tab(adduser) { - my ($self, $cart, $command) = @_; - +sub command :Tab(adduser) ($self, $cart, $command, @) { $command eq 'adduser' or return NEXT; if ($cart->size) { @@ -14,9 +12,7 @@ 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, whitespace is not allowed." if $name =~ /\s/; diff --git a/plugins/beep b/plugins/beep index 94d20f5..664d06d 100644 --- a/plugins/beep +++ b/plugins/beep @@ -5,8 +5,7 @@ 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'; diff --git a/plugins/beep_terminal b/plugins/beep_terminal index b485f2c..9217766 100644 --- a/plugins/beep_terminal +++ b/plugins/beep_terminal @@ -5,8 +5,6 @@ # 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"; } diff --git a/plugins/deposit b/plugins/deposit index 560a35b..234e569 100644 --- a/plugins/deposit +++ b/plugins/deposit @@ -4,17 +4,13 @@ HELP "deposit " => "Deposit into an account"; -sub command :Tab(deposit) { - my ($self, $cart, $command) = @_; - +sub command :Tab(deposit) ($self, $cart, $command, @) { $command eq 'deposit' or return NEXT; return "Amount to deposit into your account", \&amount; } -sub amount :Tab(13.37,42) { - my ($self, $cart, $amount) = @_; - +sub amount :Tab(13.37,42) ($self, $cart, $amount, @) { $self->{amount} = parse_amount($amount) or return REJECT, "Invalid amount"; @@ -27,9 +23,7 @@ sub amount :Tab(13.37,42) { 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} @@ -45,14 +39,11 @@ sub how :Tab(&how_tab) { 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; diff --git a/plugins/deposit_iban_qr b/plugins/deposit_iban_qr index aa33272..0d062f0 100644 --- a/plugins/deposit_iban_qr +++ b/plugins/deposit_iban_qr @@ -23,9 +23,7 @@ use List::Util qw(sum); my $iban = "NL99ABCD1234567890"; my $beneficiary = "Account Name"; -sub hook_checkout { - my ($class, $cart, $user, $transaction_id) = @_; - +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; diff --git a/plugins/deposit_methods b/plugins/deposit_methods index 4818901..dca74fd 100644 --- a/plugins/deposit_methods +++ b/plugins/deposit_methods @@ -1,8 +1,6 @@ #!perl -sub hook_deposit_methods { - my ($class, $message, $hash) = @_; - +sub hook_deposit_methods($class, $message, $hash, @) { $$message = <<"END"; Please type one of the following: diff --git a/plugins/dinnerbonus b/plugins/dinnerbonus index 1be2299..88b2523 100644 --- a/plugins/dinnerbonus +++ b/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 diff --git a/plugins/give b/plugins/give index f63d30d..1de0150 100644 --- a/plugins/give +++ b/plugins/give @@ -2,35 +2,27 @@ HELP "give []" => "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; } -sub reason :Tab(whatevah) { - my ($self, $cart, $input) = @_; - +sub reason :Tab(whatevah) ($self, $cart, $input, @) { my $beneficiary = $self->{beneficiary}; my $amount = $self->{amount}; diff --git a/plugins/grandtotal b/plugins/grandtotal index f30116c..6c0857e 100644 --- a/plugins/grandtotal +++ b/plugins/grandtotal @@ -2,9 +2,7 @@ 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; diff --git a/plugins/help b/plugins/help index 0222014..38e0d45 100644 --- a/plugins/help +++ b/plugins/help @@ -8,9 +8,7 @@ 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,wtf,omgwtfbbq) ($self, $cart, $command, @) { return NEXT if $command !~ /^(?:help|wtf|omgwtfbbq)$/; # GNU less(1) and more(1) are a bad choice to present to total newbies who diff --git a/plugins/idle b/plugins/idle index e3b8756..4c1311b 100644 --- a/plugins/idle +++ b/plugins/idle @@ -2,28 +2,27 @@ my $timeout = 10; -sub hook_prompt_idle { - my ($class, $cart, $plugin, $seconds, $readline) = @_; - if ($seconds >= $timeout and $cart->size and not $plugin) { - call_hooks("beep"); +sub hook_prompt_idle($class, $cart, $plugin, $seconds, $readline, @) { + return unless $seconds >= $timeout and $cart->size and not $plugin; - return if $seconds > $timeout; # text only once + call_hooks("beep"); - my $text = $readline->copy_text; - my $point = $readline->{point}; + return if $seconds > $timeout; # text only once - $readline->save_prompt; - $readline->replace_line(""); - $readline->redisplay; + my $text = $readline->copy_text; + my $point = $readline->{point}; - 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->save_prompt; + $readline->replace_line(""); + $readline->redisplay; - $readline->restore_prompt; - $readline->replace_line($text); - $readline->{point} = $point; - $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; } diff --git a/plugins/log b/plugins/log index 1af65ec..a07e0fc 100644 --- a/plugins/log +++ b/plugins/log @@ -9,48 +9,41 @@ sub _log { } 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"); } -sub hook_reject { - my ($class, $plugin, $reason, $abort) = @_; +sub hook_reject($class, $plugin, $reason, $abort, @) { _log("REJECT [$plugin] $reason"); } -sub hook_retry { - my ($class, $plugin, $reason, $abort) = @_; +sub hook_retry($class, $plugin, $reason, $abort, @) { _log("RETRY [$plugin] $reason"); } -sub hook_user_created { - my ($class, $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"); } -sub hook_checkout { - my ($class, $cart, $username, $transaction_id) = @_; +sub hook_checkout($class, $cart, $username, $transaction_id, @) { _log("CHECKOUT $transaction_id $_") for map $_->as_loggable, $cart->entries; } -sub hook_register { - my ($class, $plugin) = @_; +sub hook_register($class, $plugin, @) { _log("REGISTER $plugin"); } diff --git a/plugins/market b/plugins/market index 3c4a0b8..8806794 100644 --- a/plugins/market +++ b/plugins/market @@ -4,7 +4,7 @@ HELP "market" => "Edit market list"; my $filename = 'revbank.market'; -sub _read_market { +sub _read_market() { open my $fh, '<', $filename or die "$filename: $!"; my %market; while (readline $fh) { @@ -22,9 +22,7 @@ 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; return ACCEPT; diff --git a/plugins/pfand b/plugins/pfand index bdd9303..e08dce9 100644 --- a/plugins/pfand +++ b/plugins/pfand @@ -9,23 +9,20 @@ HELP "pfand" => "Pfand zurueck"; # The file format for 'revbank.pfand' is simply two whitespace separated # columns: product id and pfand amount. -sub _read_pfand { +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) = @_; - +sub command :Tab(pfand) ($self, $cart, $command, @) { return NEXT if $command ne 'pfand'; return "Pfand zurueck fuer", \&product; } -sub product :Tab(&tab) { - my ($self, $cart, $product) = @_; +sub product :Tab(&tab) ($self, $cart, $product, @) { my $pfand = parse_amount(_read_pfand->{ $product }) or return REJECT, "Invalid pfand amount for $product"; @@ -41,8 +38,7 @@ sub tab { return keys %{ _read_pfand() }; } -sub hook_add_entry { - my ($class, $cart, $entry) = @_; +sub hook_add_entry ($class, $cart, $entry, @) { return if $entry->has_attribute('is_return'); return if not $entry->has_attribute('product_id'); diff --git a/plugins/plus b/plugins/plus index b85b3e8..6d43f46 100644 --- a/plugins/plus +++ b/plugins/plus @@ -6,9 +6,7 @@ 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) = @_; - +sub command($self, $cart, $command, @) { return ABORT, $err_pfand if $cart->entries('is_pfand'); my ($post) = $command =~ /^\+(\d+)?$/ @@ -30,9 +28,7 @@ sub command { return "Add to previous product", \&add; } -sub add { - my ($self, $cart, $arg) = @_; - +sub add($self, $cart, $arg, @) { $arg =~ /^\d+$/ and $arg > 0 or return REJECT, "Invalid value."; diff --git a/plugins/products b/plugins/products index bee1599..cb9228c 100644 --- a/plugins/products +++ b/plugins/products @@ -5,7 +5,7 @@ HELP "edit" => "Edit product list"; my $filename = 'revbank.products'; -sub _read_products { +sub _read_products() { open my $fh, '<', $filename or die "$filename: $!"; my %products; while (readline $fh) { @@ -22,9 +22,7 @@ sub _read_products { return \%products; } -sub command :Tab(edit,&tab) { - my ($self, $cart, $command) = @_; - +sub command :Tab(edit,&tab) ($self, $cart, $command, @) { if ($command eq 'edit') { system $ENV{EDITOR} || 'vi', $filename; return ACCEPT; diff --git a/plugins/repeat b/plugins/repeat index b3c806f..bb63905 100644 --- a/plugins/repeat +++ b/plugins/repeat @@ -10,9 +10,7 @@ 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) = @_; - +sub command($self, $cart, $command, @) { return ABORT, $err_pfand if $cart->entries('is_pfand'); my ($lhs, $op, $rhs) = $command =~ /^(\d+)?([x*+-])(\d+)?$/ @@ -86,9 +84,7 @@ sub command { 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."; @@ -98,9 +94,7 @@ sub repeat { return ACCEPT; } -sub plusminus { - my ($self, $cart, $arg) = @_; - +sub plusminus($self, $cart, $arg, @) { $arg =~ /^\d+$/ and $arg > 0 or return REJECT, "Invalid value."; @@ -119,8 +113,7 @@ sub plusminus { 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; diff --git a/plugins/restart b/plugins/restart index 63f0b72..faa59ca 100644 --- a/plugins/restart +++ b/plugins/restart @@ -2,9 +2,7 @@ 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; @@ -15,9 +13,7 @@ sub command :Tab(restart) { return ABORT, "exec() failed. You'll have to restart revbank yourself :P"; } -sub hook_input { - my ($self, $cart, $input, $split_input) = @_; - +sub hook_input($class, $cart, $input, $split_input, @) { return if defined $input; no warnings; diff --git a/plugins/revspace_barcode b/plugins/revspace_barcode index 2464205..231dfb1 100644 --- a/plugins/revspace_barcode +++ b/plugins/revspace_barcode @@ -7,17 +7,13 @@ -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, @) { $cart->add( -0.07, "Barcode <$input>", @@ -27,9 +23,7 @@ sub data { 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; diff --git a/plugins/revspace_bounties b/plugins/revspace_bounties index 94bc3e2..d0c7b24 100644 --- a/plugins/revspace_bounties +++ b/plugins/revspace_bounties @@ -7,9 +7,7 @@ my %bounties = ( 4 => [ 15, "Bedankt voor 't poetsen van alle tafels" ], ); -sub command :Tab(BOUNTY1,BOUNTY2,BOUNTY3,BOUNTY4) { - my ($self, $cart, $command) = @_; - +sub command :Tab(BOUNTY1,BOUNTY2,BOUNTY3,BOUNTY4) ($self, $cart, $command, @) { if ($command =~ /BOUNTY(\d+)/) { $cart->add(+$bounties{$1}[0], $bounties{$1}[1]); return ACCEPT; diff --git a/plugins/revspace_git b/plugins/revspace_git index 85c474f..327d503 100644 --- a/plugins/revspace_git +++ b/plugins/revspace_git @@ -1,7 +1,6 @@ #!perl -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; diff --git a/plugins/revspace_mollie b/plugins/revspace_mollie index 7d4c11c..e07d7cb 100644 --- a/plugins/revspace_mollie +++ b/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; @@ -46,8 +43,7 @@ sub command { 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 +51,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'); diff --git a/plugins/revspace_mqtt b/plugins/revspace_mqtt index 3cc2bdb..2c6004e 100644 --- a/plugins/revspace_mqtt +++ b/plugins/revspace_mqtt @@ -2,8 +2,7 @@ use Net::MQTT::Simple "mosquitto.space.revspace.nl"; -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; diff --git a/plugins/revspace_saldo b/plugins/revspace_saldo index 28d4ff0..17488cf 100644 --- a/plugins/revspace_saldo +++ b/plugins/revspace_saldo @@ -2,17 +2,15 @@ use POSIX qw(strftime); -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 my $balance = RevBank::Users::balance($user) or return; diff --git a/plugins/split b/plugins/split index dbb2e84..2641924 100644 --- a/plugins/split +++ b/plugins/split @@ -4,14 +4,11 @@ use List::Util (); HELP "split ..." => "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(take,steal,split) ($self, $cart, $command, @) { $command eq 'split' or return NEXT; $self->{users} = []; @@ -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}) { diff --git a/plugins/stock b/plugins/stock index 8e5a9c1..6933076 100644 --- a/plugins/stock +++ b/plugins/stock @@ -2,9 +2,7 @@ HELP "cash" => "Checkout without a user account"; -sub command :Tab(cash) { - my ($self, $cart, $command) = @_; - +sub command :Tab(cash) ($self, $cart, $command, @) { return NEXT if $command ne 'cash'; call_hooks("checkout", $cart, 'cash', 0); # Fake checkout @@ -13,9 +11,7 @@ sub command :Tab(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" diff --git a/plugins/tail b/plugins/tail index d80c225..0a04689 100644 --- a/plugins/tail +++ b/plugins/tail @@ -1,8 +1,6 @@ #!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; diff --git a/plugins/take b/plugins/take index 70dad93..d01eb19 100644 --- a/plugins/take +++ b/plugins/take @@ -2,9 +2,7 @@ HELP "take ... " => "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); @@ -46,9 +42,8 @@ sub arg :Tab(USERS) { 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,NOABORT) ($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 :)." diff --git a/plugins/undo b/plugins/undo index ea42627..fbc9b98 100644 --- a/plugins/undo +++ b/plugins/undo @@ -4,9 +4,7 @@ HELP "undo " => "Undo a transaction"; my $filename = ".revbank.undo"; -sub command :Tab(undo) { - my ($self, $cart, $command) = @_; - +sub command :Tab(undo) ($self, $cart, $command, @) { $command eq 'undo' or return NEXT; $cart->size and return ABORT, "Undo is not available mid-transaction."; @@ -14,9 +12,7 @@ sub command :Tab(undo) { return "Transaction ID", \&undo; } -sub undo { - my ($self, $cart, $tid) = @_; - +sub undo($self, $cart, $tid, @) { open my $in, '<', $filename or die "$filename: $!"; open my $out, '>', "$filename.$$" or die "$filename.$$: $!"; my $description = "Undo $tid"; @@ -47,9 +43,7 @@ sub undo { return ACCEPT; } -sub hook_user_balance { - my ($class, $username, $old, $delta, $new, $transaction_id) = @_; - +sub hook_user_balance($class, $username, $old, $delta, $new, $transaction_id, @) { open my $fh, '>>', $filename or die "$filename: $!"; print {$fh} join " ", $transaction_id, $username, -$delta, now(), "\n"; close $fh or die "$filename: $!"; diff --git a/plugins/unlisted b/plugins/unlisted index 62ea0ef..24b4873 100644 --- a/plugins/unlisted +++ b/plugins/unlisted @@ -2,16 +2,14 @@ HELP "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; } -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') { @@ -22,8 +20,7 @@ sub amount { return "Please provide a short description", \&description; } -sub description { - my ($self, $cart, $desc) = @_; +sub description($self, $cart, $desc, @) { $cart->add(-$self->{amount}, $desc); return ACCEPT; } diff --git a/plugins/url b/plugins/url index 463f66e..486d4e4 100644 --- a/plugins/url +++ b/plugins/url @@ -1,7 +1,6 @@ #!perl -sub command { - my ($self, $cart, $command) = @_; +sub command($self, $cart, $command, @) { if ($command =~ m[^https?://]) { print "This is not a browser..."; return ACCEPT; diff --git a/plugins/users b/plugins/users index 2ff752a..2796e91 100644 --- a/plugins/users +++ b/plugins/users @@ -4,9 +4,7 @@ HELP "" => "[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) = @_; - +sub command :Tab(list,ls,shame,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'; @@ -21,9 +19,7 @@ sub command :Tab(list,ls,shame,USERS) { return ACCEPT; } -sub hook_checkout { - my ($class, $cart, $user, $transaction_id) = @_; - +sub hook_checkout($class, $cart, $user, $transaction_id, @) { if ($cart->changed) { say "Done:"; $cart->display; @@ -31,26 +27,24 @@ sub hook_checkout { say "Transaction ID: $transaction_id"; } -sub list { +sub list($self) { system "sort -f revbank.accounts | grep -v ^# | perl -pe's/( -[\\d.]+)/\\e[31;1m\$1\\e[0m/' | more"; return ACCEPT; } -sub shame { +sub shame($self) { 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"; } -sub balance { - my ($self, $u) = @_; - recent(10, $u); +sub balance($self, $u) { + _recent(10, $u); printf "Balance for $u is \e[1m%+.2f\e[0m\n", RevBank::Users::balance($u); say "NB: Products/amounts/commands FIRST, username LAST."; return ABORT; diff --git a/plugins/voorbeeld b/plugins/voorbeeld index 1e82e40..0168c57 100644 --- a/plugins/voorbeeld +++ b/plugins/voorbeeld @@ -3,9 +3,7 @@ sub command { print "@_\n"; NEXT } -sub hook_user_balance { - my ($class, $username, $old, $delta, $new) = @_; - +sub hook_user_balance($class, $username, $old, $delta, $new, @) { print "c: $class\n"; print "u: $username\n"; print "o: $old\n"; diff --git a/plugins/warnings b/plugins/warnings index 44eb2f3..7009af8 100644 --- a/plugins/warnings +++ b/plugins/warnings @@ -5,7 +5,7 @@ use Time::HiRes qw(sleep); -sub _read_warnings { +sub _read_warnings() { open my $fh, 'revbank.warnings' or die $!; return map { my ($regex, $products, $text) = m[^ @@ -29,8 +29,7 @@ sub _read_warnings { } grep /\S/, grep !/^\s*#/, readline $fh; } -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 { diff --git a/plugins/withdraw b/plugins/withdraw index 489ca07..af791b3 100644 --- a/plugins/withdraw +++ b/plugins/withdraw @@ -2,9 +2,7 @@ HELP "" => "Withdraw or enter price manually"; -sub command { - my ($self, $cart, $command) = @_; - +sub command($self, $cart, $command, @) { my $amount = parse_amount($command); defined $amount or return NEXT; diff --git a/revbank b/revbank index 5a2fe73..b591116 100755 --- a/revbank +++ b/revbank @@ -1,6 +1,10 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl + +use v5.28; +use warnings; +use feature qw(signatures); +no warnings "experimental::signatures"; -use strict; use attributes; use IO::Select; use List::Util (); @@ -45,9 +49,7 @@ $select->add(\*STDIN); my $cart = RevBank::Cart->new; -sub prompt { - my ($prompt, $plugins, $completions) = @_; - +sub prompt($prompt, $plugins, $completions) { if ($prompt) { $prompt =~ s/$/:/ if $prompt !~ /[?>]$/; $prompt .= " ";