diff --git a/RevBank/Cart.pm b/RevBank/Cart.pm new file mode 100644 index 0000000..3e83024 --- /dev/null +++ b/RevBank/Cart.pm @@ -0,0 +1,122 @@ +package RevBank::Cart; +use strict; +use Carp (); +use List::Util (); +use RevBank::Global; + +# Some code is written with the assumption that the card will only grow or +# be emptied. Changing existing stuff or removing items is probably not a +# good idea, and may lead to inconsistency. + +sub new { + my ($class) = @_; + return bless { }, $class; +} + +sub add { + my ($self, $user, $amount, $description) = @_; + $user ||= '$you'; + push @{ $self->{ $user } }, { + amount => $amount, + description => $description, + }; +} + +sub empty { + my ($self) = @_; + %$self = (); +} + +sub _dump_item { + my ($prefix, $user, $amount, $description) = @_; + return sprintf( + "%s%-17s %4s EUR %5.2f %s", + $prefix, + $user, + ($amount > 0 ? 'GAIN' : $amount < 0 ? 'LOSE' : ''), + abs($amount), + $description + ); +} + +sub as_strings { + my ($self, $prefix) = @_; + $prefix ||= ' '; + + my @s; + + for my $user (sort keys %$self) { + my @items = @{ $self->{$user} }; + my $sum = List::Util::sum(map $_->{amount}, @items); + + push @s, _dump_item($prefix, $user, $_->{amount}, "# $_->{description}") + for @items; + push @s, _dump_item($prefix, $user, $sum, "TOTAL") + if @items > 1; + } + + return @s; +} + +sub display { + my ($self, $prefix) = @_; + say $_ for $self->as_strings($prefix); +} + +sub size { + my ($self) = @_; + return List::Util::sum(map scalar @{ $self->{$_} }, keys %$self) || 0; +} + +sub _set_user { + my ($self, $user) = @_; + + exists $self->{'$you'} + or Carp::croak("Error: no cart items for shell user"); + + $self->{$user} ||= []; + + push @{ $self->{$user} }, @{ delete $self->{'$you'} }; + + for (values %$self) { + $_->{description} =~ s/\$you\b/$user/g for @$_; + } +} + +sub checkout { + my ($self, $user) = @_; + + $self->_set_user($user) if $user; + + exists $self->{'$you'} and die "Incomplete transaction; user not set."; + + my $transaction_id = time() - 1300000000; + RevBank::Plugins::call_hooks("checkout", $self, $user, $transaction_id); + + for my $account (keys %$self) { + my $sum = List::Util::sum(map $_->{amount}, @{ $self->{$account} }); + RevBank::Users::update($account, $sum, $transaction_id); + } + + $self->empty; + + sleep 1; # Ensure new timestamp/id for new transaction +} + +sub select_items { + my ($self, $regex) = @_; + $regex ||= qr/(?:)/; # Match everything if no regex is given + + my @matches; + for my $user (keys %$self) { + for my $item (@{ $self->{$user} }) { + push @matches, { user => $user, %$item } + if $item->{description} =~ /$regex/; + } + } + + return @matches; +} + +1; + diff --git a/RevBank/Eval.pm b/RevBank/Eval.pm new file mode 100644 index 0000000..6dbe2a1 --- /dev/null +++ b/RevBank/Eval.pm @@ -0,0 +1,13 @@ +package RevBank::Eval; + +# This function is used so strings can be eval'ed in a clean lexical +# environment. + +sub clean_eval { eval shift } + +# No, it's not scary. We're using string eval to load plugins, just as it would +# be used to load modules. As we're not executing user input, this is really +# NOT a security bug. + +1; + diff --git a/RevBank/Global.pm b/RevBank/Global.pm new file mode 100644 index 0000000..776a518 --- /dev/null +++ b/RevBank/Global.pm @@ -0,0 +1,87 @@ +package RevBank::Global; +use strict; +use POSIX qw(strftime); + +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) = @_; + defined $amount or return undef; + length $amount or return undef; + $amount =~ /^(-)?[0-9]*(?:[,.][0-9]{1,2})?$/ or return undef; + if ($1) { + die "For our sanity, no negative amounts, please :).\n"; + } + $amount =~ s/,/./g; + if ($amount > 999) { + die "That's way too much money, or an unknown barcode.\n"; + } + return 0 + $amount; + }; + *{"$caller\::call_hooks"} = \&RevBank::Plugins::call_hooks; + *{"$caller\::say"} = sub { + print @_, "\n"; + }; + *{"$caller\::now"} = sub { + return strftime '%Y-%m-%d_%H:%M:%S', localtime; + }; + +} + +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. + +=head2 say + +Print with newline, in case your Perl version doesn't already have a C. + +=head2 call_hooks($hook, @arguments) + +See C in L. + +=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 in L. + +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. diff --git a/RevBank/Messages.pm b/RevBank/Messages.pm new file mode 100644 index 0000000..1d9ba0a --- /dev/null +++ b/RevBank/Messages.pm @@ -0,0 +1,58 @@ +package RevBank::Messages; +use RevBank::Global; +use base 'RevBank::Plugin'; + +# Don't edit this file just to change the messages. Instead, RTFM and define +# your own hooks. + +BEGIN { + RevBank::Plugins::register("RevBank::Messages"); +} + +sub command { return NEXT; } +sub id { 'built in messages' } + +sub hook_startup { + say "\e[0m\n\n\nWelcome to the RevBank Shell, version $::VERSION\n"; +} + +sub hook_plugin_fail { + my ($class, $plugin, $error) = @_; + warn "Plugin '$plugin' failed: $error\n"; +} + +sub hook_cart_changed { + my ($class, $cart) = @_; + $cart->display(" "); + say "Enter username to pay/finish or 'abort' to abort.\n"; +} + +sub hook_abort { + my ($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_reject { + my ($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 ? '+' : '-'; + printf "New balance for %s: %+.2f %s %.2f = \e[1m%+.2f\e[0m %s\n", + $username, $old, $sign, abs($delta), $new, + ($new < -13.37 ? "\e[5;1m(!!)\e[0m" : ""); +} + +sub hook_user_created { + my ($class, $username) = @_; + say "New account '$username' created."; +} + +1; diff --git a/RevBank/Plugin.pm b/RevBank/Plugin.pm new file mode 100644 index 0000000..ab3e2ec --- /dev/null +++ b/RevBank/Plugin.pm @@ -0,0 +1,20 @@ +package RevBank::Plugin; +use strict; + +sub new { + my ($class) = @_; + return bless { }, $class; +} + + +1; + +__END__ + +=head1 NAME + +RevBank::Plugin - Base class for RevBank plugins + +=head1 DESCRIPTION + +Documentation on writing plugins is at L. diff --git a/RevBank/Plugins.pm b/RevBank/Plugins.pm new file mode 100644 index 0000000..2b4bcb9 --- /dev/null +++ b/RevBank/Plugins.pm @@ -0,0 +1,278 @@ +package RevBank::Plugins; +use strict; +use RevBank::Eval; +use RevBank::Plugin; +use Exporter; +our @EXPORT = qw(call_hooks load_plugins); + +my @plugins; + +sub _read_file { + local (@ARGV) = @_; + readline *ARGV; +} + +sub call_hooks { + my $hook = shift; + my $method = "hook_$hook"; + for my $class (@plugins) { + $class->$method(@_) if $class->can($method); + } +}; + +sub register { + call_hooks("register", $_) for @_; + push @plugins, @_; +} + +sub load { + my @config = _read_file('revbank.plugins'); + chomp @config; + s/#.*//g for @config; + @config = map /(\S+)/, grep /\S/, @config; + + for my $name (@config) { + my $fn = "plugins/$name"; + my $package = "RevBank::Plugin::$name"; + if (not -e $fn) { + warn "$fn does not exist; skipping plugin.\n"; + next; + } + RevBank::Eval::clean_eval(qq[ + use strict; + package $package; + BEGIN { RevBank::Global->import; } + our \@ISA = qw(RevBank::Plugin); + our \%ATTR; + sub MODIFY_CODE_ATTRIBUTES { + my (\$class, \$sub, \@attrs) = \@_; + \$ATTR{ \$sub } = "\@attrs"; + return; + } + sub FETCH_CODE_ATTRIBUTES { + return \$ATTR{ +pop }; + } + sub HELP { + \$::HELP{ +shift } = +pop; + } + sub id { '$name' } + ] . "\n#line 1 $fn\n" . join "", _read_file($fn)); + + if ($@) { + call_hooks("plugin_fail", $name, "Compile error: $@"); + next; + } + if (not $package->can("command")) { + warn "Plugin $name does not have a 'command' method; skipping.\n"; + next; + } + + register $package; + } +} + +sub new { + return map $_->new, @plugins; +} + +1; +__END__ +=head1 NAME + +RevBank::Plugins - Plugin mechanism for RevBank + +=head1 DESCRIPTION + +RevBank itself consists of a simple command line interface and a really brain +dead shopping cart. All transactions, even deposits and withdrawals, are +handled by plugins. + +Plugins are defined in the C file. Each plugin is a Perl +source file in the C directory. Plugins are always iterated over in +the order they were defined in. + +=head2 Methods + +=head3 RevBank::Plugins::load + +Reads the C file and load the plugins. + +=head3 RevBank::Plugins->new + +Returns a B of fresh plugin instances. + +=head3 RevBank::Plugins::register($package) + +Registers a plugin. + +=head3 RevBank::Plugins::call_hooks($hook, @arguments) + +Calls the given hook in each of the plugins. Non-standard hooks, called only +by plugins, SHOULD be prefixed with the name of the plugin, and an underscore. +For example, a plugin called C can call a hook called C (which +calls the C methods). + +There is no protection against infinite loops. Be careful! + +=head1 WRITING PLUGINS + + *** CAUTION *** + It is the responsibility of the PLUGINS to verify and normalize all + input. Behaviour for bad input is UNDEFINED. Weird things could + happen. Always use parse_user() and parse_amount() and test the + outcome for defined()ness. Use the result of the parse_*() functions + because that's canonicalised. + + Don't do this: + $cart->add($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 :)'); + +There are two kinds of plugin methods: input methods and hooks. A plugin MUST +define one C input method (but it MAY be a no-op), and can have any +number of hooks. + +=head2 Input methods + +Whenever a command is given in the 'outer' loop of revbank, the C +method of the plugins is called until one of the plugins returns either +C or C. An input method receives three arguments: the plugin +object, the shopping cart, and the given input string. The plugin object +(please call it C<$self>) is temporary but persists as long as your plugin +keeps control. It can be used as a scratchpad for carrying over values from +one method call to the next. + +A command method MUST return with one of the following statements: + +=over 10 + +=item return NEXT; + +The plugin declines handling of the given command, and revbank should proceed +with the next one. + +Input methods other than C MUST NOT return C. + +=item return REJECT, "Reason"; + +The plugin decides that the input should be rejected for the given reason. +RevBank will either query the user again, or (if there is any remaining input +in the buffer) abort the transaction to avoid confusion. + +=item return ABORT, "Reason"; + +=item return ABORT; + +The plugin decides that the transaction should be aborted. + +=item return ACCEPT; + +The plugin has finished processing the command. No other plugins will be called. + +=item return "Prompt", $method; + +The plugin requires arguments for the command, which will be taken from the +input buffer if extra input was given, or else, requested interactively. + +The given method, which can be a reference or the name of the method, will be +called with the given input. + +The literal input string C is a hard coded special case, and will +never reach the plugin's input methods. + +=back + +=head2 Hooks + +Hooks are called at specific points in the processing flow, and MAY introspect +the shopping cart. They SHOULD NOT manipulate the shopping cart, but this option +is provided anyway, to allow for interesting hacks. If you do manipulate the +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 method. +The suggested implementation for a no-op C method is: + + 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). + +The following hooks are available, with their respective arguments: + +=over 10 + +=item hook_register $class, $plugin + +Called when a new plugin is registered. + +=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 + +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 + +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_checkout $class, $cart, $user, $transaction_id + +Called when the transaction is finalized. + +=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 + +Called when input was not recognised by any of the plugins. + +=item hook_plugin_fail $class, $plugin, $error + +Called when a plugin fails. + +=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 + +Called when a user account is updated. + +=back + +Default messages can be silenced by overriding the hooks in +C. Such a hack might look like: + + undef &RevBank::Messages::hook_abort; + + sub hook_abort { + print "This message is much better!\n" + } + +=head2 Utility functions + +Several global utility functions are available. See L + +=head1 AUTHOR + +Juerd Waalboer <#####@juerd.nl> + +=head1 LICENSE + +Pick your favorite OSI license. + diff --git a/RevBank/Users.pm b/RevBank/Users.pm new file mode 100644 index 0000000..ace181b --- /dev/null +++ b/RevBank/Users.pm @@ -0,0 +1,70 @@ +package RevBank::Users; +use strict; +use RevBank::Global; +use RevBank::Plugins; + +my $filename = "revbank.accounts"; + +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 }; +} + +sub names { + return map $_->[0], values %{ _read() }; +} + +sub balance { + my ($name) = @_; + return _read()->{ lc $name }->[1]; +} + +sub create { + my ($username) = @_; + open my $fh, '>>', $filename or die $!; + my $now = now(); + print {$fh} "$username 0.00 $now\n" or die $!; + close $fh or die $!; + RevBank::Plugins::call_hooks("user_created", $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)) { + my @a = split " ", $line; + if (lc $a[0] eq lc $username) { + $old = $a[1]; + $new = $old + $delta; + printf {$out} "%-16s %+9.2f %s", + $username, $new, now() or die $!; + print {$out} "\n" or die $!; + } else { + print {$out} $line or die $!; + } + } + close $out or die $!; + close $in; + rename ".revbank.$$", "revbank.accounts" or die $!; + + RevBank::Plugins::call_hooks( + "user_balance", $username, $old, $delta, $new, $transaction_id + ); +} + +sub parse_user { + my ($username) = @_; + my $users = _read(); + return undef if not exists $users->{ lc $username }; + return $users->{ lc $username }->[0]; +} + +1; + + diff --git a/plugins/deposit b/plugins/deposit new file mode 100644 index 0000000..1ac613a --- /dev/null +++ b/plugins/deposit @@ -0,0 +1,51 @@ +# This plugin must at the end in the plugins file. + +HELP "deposit []" => "[Create and] deposit into an account"; + +sub command :Tab(deposit) { + my ($self, $cart, $command) = @_; + + if ($command eq 'deposit') { + return "Amount to deposit into your account", \&amount; + } + + if ($cart->select_items(qr/^Deposit$/)) { + # No other plugin recognised the input, so it must be a new user. + $self->{new_user} = $command; + return "Add new account for user '$command'?", \&create; + } + + return NEXT; +} + +sub amount { + my ($self, $cart, $amount) = @_; + + $amount = parse_amount($amount) + or return REJECT, "Invalid amount"; + + $cart->add(undef, +$amount, "Deposit"); + + return ACCEPT; +} + +sub create { + my ($self, $cart, $yesno) = @_; + my $user = $self->{new_user}; + + if ($yesno eq "y" or $yesno eq "yes") { + RevBank::Users::create( $user ); + $cart->checkout( $user ); + return ACCEPT; + } + return ABORT; +} + +sub hook_checkout { + my ($class, $cart, $user, $transaction_id) = @_; + my $sum; + $sum += $_->{amount} for $cart->select_items(qr/^Deposit$/); + + say sprintf "Don't forget to add EUR %.2f to the cash box!", $sum if $sum; +} + diff --git a/plugins/give b/plugins/give new file mode 100644 index 0000000..fd162ed --- /dev/null +++ b/plugins/give @@ -0,0 +1,32 @@ +HELP "give [ []]" => "Transfer money to user's account"; + +sub command :Tab(give) { + my ($self, $cart, $command) = @_; + + return NEXT if $command ne 'give'; + + return "Benificiary", \&benedinges; +} + +sub benedinges :Tab(USERS) { + my ($self, $cart, $input) = @_; + + $self->{user} = parse_user($input) + or return REJECT, "$input: No such user."; + + return "Amount to give to $input", \&amount; +} + +sub amount { + my ($self, $cart, $input) = @_; + + my $amount = parse_amount($input) + or return REJECT, "$input: Invalid amount."; + + my $user = $self->{user}; + + $cart->add(undef, -$amount, "Given to $user"); + $cart->add($user, +$amount, "Received from \$you"); + + return ACCEPT; +} diff --git a/plugins/help b/plugins/help new file mode 100644 index 0000000..4ddc48c --- /dev/null +++ b/plugins/help @@ -0,0 +1,25 @@ +HELP "help" => "The stuff you're looking at right now :)"; + +use List::Util qw(max); + +sub command :Tab(help,wtf,omgwtfbbq) { + my ($self, $cart, $command) = @_; + + return NEXT if $command !~ /^(?:help|wtf|omgwtfbbq)$/; + + say < after each element to get a follow-up prompt, or separate +individual elements with whitespace. + +Valid commands: +END + + my $width = max(map length, keys %::HELP); + say sprintf " %-${width}s %s", $_, $::HELP{$_} for sort keys %::HELP; + + return ACCEPT; +} diff --git a/plugins/log b/plugins/log new file mode 100644 index 0000000..043eb4f --- /dev/null +++ b/plugins/log @@ -0,0 +1,51 @@ +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: $!"; +} + +my %buffer; +sub hook_abort { + _log("ABORT"); +} +sub hook_prompt { + my ($class, $cart, $prompt) = @_; + $buffer{prompt} = $prompt; +} +sub hook_input { + my ($class, $cart, $input, $split_input) = @_; + $input //= "(UNDEF)"; + _log("PROMPT $buffer{prompt} >> $input"); +} + +sub hook_reject { + my ($class, $plugin, $reason, $abort) = @_; + _log("REJECT [$plugin] $reason"); +} + +sub hook_user_created { + my ($class, $username); + _log("NEWUSER $username"); +} + +sub hook_user_balance { + my ($class, $user, $old, $delta, $new, $transaction_id) = @_; + $_ = sprintf "%+.02f", $_ for $old, $delta, $new; + my $lost = $delta < 0 ? "lost" : "got"; + $delta = abs($delta); + _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 $cart->as_strings; +} + +sub hook_register { + my ($class, $plugin) = @_; + _log("REGISTER $plugin"); +} diff --git a/plugins/products b/plugins/products new file mode 100644 index 0000000..1c5df66 --- /dev/null +++ b/plugins/products @@ -0,0 +1,28 @@ +HELP "" => "Look up products from database"; +HELP "edit" => "Edit product list"; + +my $filename = 'revbank.products'; + +sub command :Tab(edit) { + my ($self, $cart, $command) = @_; + + if ($command eq 'edit') { + system $ENV{EDITOR}, $filename; + return ACCEPT; + } + + my @products; + + open my $fh, '<', $filename or die $!; + /\S/ && !/^\s*#/ and push @products, [split " ", $_, 3] while readline $fh; + chomp @$_ for @products; + + for my $fields (@products) { + next if $command ne $fields->[0]; + + $cart->add(undef, - $fields->[1], $fields->[2]); + return ACCEPT; + } + + return NEXT; +} diff --git a/plugins/restart b/plugins/restart new file mode 100644 index 0000000..0ec00d4 --- /dev/null +++ b/plugins/restart @@ -0,0 +1,25 @@ +HELP "restart" => "Attempt to restart the RevBank shell"; + +sub command :Tab(restart) { + my ($self, $cart, $command) = @_; + + return NEXT if $command ne 'restart'; + + no warnings; + call_hooks("restart_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"); +} diff --git a/plugins/sigint b/plugins/sigint new file mode 100644 index 0000000..ee704f5 --- /dev/null +++ b/plugins/sigint @@ -0,0 +1,3 @@ +sub command { NEXT } + +$SIG{INT} = 'IGNORE'; diff --git a/plugins/take b/plugins/take new file mode 100644 index 0000000..efccbd3 --- /dev/null +++ b/plugins/take @@ -0,0 +1,68 @@ +HELP "take [ []]" => "Take money from users (equal parts)"; + +sub command :Tab(take,steal) { + my ($self, $cart, $command) = @_; + + $command eq 'take' or $command eq 'steal' + or return NEXT; + + $self->{users} = []; + + return "User to take from", \&arg; +} + +sub arg :Tab(USERS) { + my ($self, $cart, $arg) = @_; + + my @users = @{ $self->{users} }; + my $amount = parse_amount($arg); + + if (@users and $amount) { + my $each = sprintf "%.2f", $amount / @users; + my $total = sprintf "%.2f", @users * $each; + + if ($total != $amount) { + print "Adjusted total amount to $total because of rounding.\n"; + } + + $self->{each} = $each; + $self->{total} = $total; + + my $them = @users == 1 ? $users[0] : 'each'; + + return "Why are you taking $each from $them?", \&reason; + } + + my $user = parse_user($arg); + if ($user) { + push @{ $self->{users} }, $user; + } else { + return REJECT, "$arg: No such user" . + ($amount ? "." : ", 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) = @_; + + return REJECT, "'$reason' is a username, not a description :)." + if parse_user($reason); + return REJECT, "'$reason' is an amount, not a description :)." + if parse_amount($reason); + + my @users = @{ $self->{users} }; + my $each = $self->{each}; + my $total = $self->{total}; + + for my $user (@users) { + $cart->add( $user, -$each, "Taken by \$you ($reason)" ); + } + + my $users = join '/', @users; + $cart->add( undef, $total, "Taken from $users ($reason)" ); + + return ACCEPT; +} + diff --git a/plugins/undo b/plugins/undo new file mode 100644 index 0000000..0120917 --- /dev/null +++ b/plugins/undo @@ -0,0 +1,46 @@ +HELP "undo []" => "Undo a certain transaction"; + +my $filename = ".revbank.undo"; + +sub command :Tab(undo) { + my ($self, $cart, $command) = @_; + + $command eq 'undo' or return NEXT; + + $cart->size and return ABORT, "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.$$: $!"; + while (defined(my $line = readline $in)) { + if ($line =~ /^$tid\s/) { + my (undef, $user, $delta) = split " ", $line; + $cart->add($user, $delta, "Undo $tid"); + } else { + print {$out} $line; + } + } + close $in; + close $out or die $!; + if ($cart->size) { + rename "$filename.$$", $filename or die $!; + $cart->checkout(); + } else { + return ABORT, "Transaction ID '$tid' not found in undo log."; + } + + return ACCEPT; +} + +sub hook_user_balance { + my ($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/users b/plugins/users new file mode 100644 index 0000000..f4d5485 --- /dev/null +++ b/plugins/users @@ -0,0 +1,48 @@ +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) = @_; + + return $self->list if $command eq 'list'; + return $self->list if $command eq 'ls'; + return $self->shame if $command eq 'shame'; + + my $user = parse_user($command) + or return NEXT; + + return $self->balance($user) if not $cart->size; + + $cart->checkout($user); + + return ACCEPT; +} + +sub hook_checkout { + my ($class, $cart, $user, $transaction_id) = @_; + + my $line = "-" x 40; + + say "/$line"; + say "| Final (transaction ID = $transaction_id):"; + $cart->display("| "); + say "\\$line"; +} + +sub list { + system "sort -f revbank.accounts | grep -v ^# | more"; + return ACCEPT; +} + +sub shame { + system "sort -f revbank.accounts | grep -v ^# | grep -- ' .-' | more"; + return ACCEPT; +} + +sub balance { + my ($self, $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/withdraw b/plugins/withdraw new file mode 100644 index 0000000..822d68f --- /dev/null +++ b/plugins/withdraw @@ -0,0 +1,11 @@ +HELP "" => "Withdraw or enter price manually"; + +sub command { + my ($self, $cart, $command) = @_; + + my $amount = parse_amount($command) or return NEXT; + + $cart->add(undef, -$amount, "Withdrawal or unlisted product"); + + return ACCEPT; +} diff --git a/revbank b/revbank index 546b88f..f36f71b 100755 --- a/revbank +++ b/revbank @@ -1,580 +1,177 @@ #!/usr/bin/perl -w + use strict; -no warnings 'exiting'; # We'll exit subs with 'next' -use POSIX qw(strftime); -use List::Util qw(sum); -require Term::ReadLine::Gnu; +use attributes; use Term::ReadLine; +use List::Util (); +use RevBank::Plugins; +use RevBank::Global; +use RevBank::Messages; +use RevBank::Cart; +require Term::ReadLine::Gnu; # The other one sucks. -$SIG{INT} = 'IGNORE'; +our $VERSION = "2.0"; +our %HELP = ( + "abort" => "Abort the current transaction", +); -# If you don't like the code, just rewrite it, but do keep all functionality -# around, please. +$| = 1; -# The user interface is based on supermarkets: first all products are scanned, -# and then the user pays. In our case, "paying" is done simply by entering -# an account name. No authentication... - -# Although the text files are reloaded all the time, it's probably not a good -# idea to edit them while someone else is using the bank script. They are, -# however, human readable and editable. - -# Likewise, things might go wrong if you run multiple instances of revbank... - -sub printlog { - open my $fh, ">>.revbank.log"; - my $x = join "", @_; - $x =~ s/\n/POSIX::strftime("\n%Y%m%d%H%M%S ", localtime)/ge; - print {$fh} $x; - close $fh; -} - -{ - package Tee; - use base 'Tie::StdHandle'; - sub PRINT { - shift; - local $| = 1; - print {*STDOUT} @_; - main::printlog(@_); - } - sub PRINTF { - shift->PRINT(sprintf(shift, @_)); - } -} - -tie *TEE, 'Tee'; -select *TEE; - -print "\e[0m\n\n\nWelcome to the RevBank Shell"; - -my $at = "\e[1;4mABORTING TRANSACTION.\e[0m"; my $readline = Term::ReadLine->new($0); $readline->ornaments('me,md,,'); -# For tab completion -my @commands = qw/ - help wtf omgwtfbbq examples deposit take steal give undo - list ls edit restart -/; - sub prompt { - my ($prompt, $completions) = @_; - $completions ||= []; - push @$completions, 'abort'; + my ($prompt, @completions) = @_; + + $prompt =~ s/$/: /; + $prompt =~ s/\?: $/? /; my @matches; $readline->Attribs->{completion_entry_function} = sub { my ($word, $state) = @_; - @matches = grep /^\Q$word\E/i, @$completions if $state == 0; + @matches = grep /^\Q$word\E/i, @completions if $state == 0; return shift @matches; }; my $input = $readline->readline($prompt); - printlog($prompt); - printlog(defined($input) ? $input : "\e[1;5mX\e[0m"); - printlog("\n"); - print "\e[0m"; defined $input or return; $input =~ s/^\s+//; # trim leading whitespace $input =~ s/\s+$//; # trim trailing whitespace - if ($input =~ /^abort$/i) { - print "$at\n"; - next LINE; # Whoa, scary out-of-scope jump! But it works :) + return $input; +} + +RevBank::Plugins->load; + +call_hooks("startup"); + +my $cart = RevBank::Cart->new; +my $old_cart_size = 0; + +my @words; + +OUTER: for (;;) { + print "\n" if not @words; + + if (not @words and $cart->size != $old_cart_size) { + call_hooks("cart_changed", $cart); + $old_cart_size = $cart->size; } - return $input -} -sub help { - print <new; + my $method = "command"; -1. Enter products, amounts or commands -2. Enter your name - -You can press after each element to get a follow-up prompt, or separate -individual elements with whitespace. - -Valid commands: - Look up product from database - Withdraw or enter price manually - [Pay with your account and] show balance - deposit [] [Create and] deposit into an account - give [] [] Transfer money to user's account - take [] [] Take money from users (equal parts) - list List accounts and balances - shame Display Hall of Shame (negative balances) - undo [] Undo a certain transaction - help The stuff you're looking at right now :) - examples Show some usage examples - abort Abort the current transaction - edit Edit product list - restart Attempt to restart the revbank shell -END - return ['noop']; -} - -sub examples { - print < $message; -} - -sub parse_product { - my ($id) = @_; - my @products; - open my $fh, 'revbank.products' or die $!; - /\S/ && !/^\s*#/ and push @products, [split " ", $_, 3] while readline $fh; - close $fh; - chomp @$_ for @products; - for (@products) { - return [ 'product', -$_->[1], $_->[2] ] if $_->[0] eq $id; + sub abort { + print @_, " " if @_; + @words = (); + call_hooks "abort", $cart; + $cart->empty; + { no warnings; redo OUTER; } } - return; -} -sub read_users { - my @users; - open my $fh, 'revbank.accounts' or die $!; - /\S/ and push @users, [split " "] while readline $fh; - close $fh; - return { map { lc($_->[0]) => $_ } @users }; -} + PROMPT: { + if (not @words) { + call_hooks "prompt", $cart, $prompt; -sub users { - map $_->[0], values %{ read_users() } -} - -sub create_account { - my ($username) = @_; - open my $fh, '>>revbank.accounts' or die $!; - my $now = now(); - print {$fh} "$username 0.00 $now\n" or die $!; - close $fh or die $!; -} - -sub update_account { - my ($username, $delta) = @_; - open my $in, 'revbank.accounts' or die $!; - open my $out, ">.revbank.$$" or die $!; - my $old; - my $new; - while (defined (my $line = readline $in)) { - my @a = split " ", $line; - if (lc $a[0] eq lc $username) { - $old = $a[1]; - $new = $old + $delta; - printf {$out} "%-16s %+9.2f %s", - $username, $new, now() or die $!; - print {$out} "\n" or die $!; - } else { - print {$out} $line or die $!; - } - } - close $out or die $!; - close $in; - rename ".revbank.$$", "revbank.accounts" or die $!; - - my $sign = $delta >= 0 ? '+' : '-'; - printf "New balance for %s: %+.2f %s %.2f = \e[1m%+.2f\e[0m %s\n", - $username, $old, $sign, abs($delta), $new, - ($new < -13.37 ? "\e[5;1m(!!)\e[0m" : ""); -} - -sub parse_user { - my ($id) = @_; - my $users = read_users; - return [ 'user', 0, $users->{lc $id}->[0] ] if exists $users->{lc $id}; -} - -sub parse_amount { - my ($amount) = @_; - length $amount or return; - if ($amount =~ /^(-)?[0-9]*(?:[,.][0-9]{1,2})?$/) { - if ($1) { - print "For our sanity, no negative amounts, please :). $at\n"; - next LINE; - } - $amount =~ s/,/./g; - if ($amount > 999) { - printf "Hm, EUR %.2f? Probably not. Unknown barcode? Enter price" - . " instead.\n\e[1;5m'%s' IGNORED!!\e[0m\n", $amount, $amount; - next ELEMENT; - } - return ['amount', 0 + $amount]; - } - return; -} - -sub parse_manual { - my ($amount) = @_; - my $p = parse_amount($amount) or return; - return ['payment', -$p->[1], "Withdrawal or unlisted product"]; -} - -sub parse_command { - my ($command, $line) = @_; - if ($command =~ /^(?:h|help|\?!?|wtf|omgwtfbbq)$/i) { - return help(); - } elsif ($command =~ /^(?:examples)$/i) { - return examples(); - } elsif ($command =~ /^(?:deposit)$/i) { - return deposit($line); - } elsif ($command =~ /^(?:take|steal)$/i) { - return take($line); - } elsif ($command =~ /^(?:give)$/i) { - return give($line); - } elsif ($command =~ /^(?:undo)$/i) { - return undo($line); - } elsif ($command =~ /^(?:ls|list)$/i) { - return list(); - } elsif ($command =~ /^(?:shame)$/i) { - return shame(); - } elsif ($command =~ /^(?:edit)$/i) { - return edit(); - } elsif ($command =~ /^(?:restart)$/i) { - exec $0; - die "exec() failed. You'll have to restart revbank yourself :P\n"; - } - return; -} - -sub deposit { - my ($line) = @_; - my $p; - if (@$line and $p = parse_amount($line->[0])) { - shift @$line; - return [ 'deposit', +$p->[1], "Deposit" ]; - } elsif (@$line) { - print "$line->[0]: Invalid amount. $at\n"; - next LINE; - } - for (;;) { - my $input = prompt "Amount to deposit into your account: "; - if ($p = parse_amount($input)) { - my $amount = $p->[1]; - return [ 'deposit', +$p->[1], "Deposit" ]; - } - print "$input: Invalid amount. Type 'abort' to abort.\n"; - } -} - -sub give { - my ($line) = @_; - my $p; - my $user; - if (@$line and $p = parse_user($line->[0])) { - shift @$line; - $user = $p->[2]; - } elsif (@$line) { - print "$line->[0]: Invalid user. $at\n"; - next LINE; - } - if (not $user) { - for (;;) { - my $input = prompt "Benificiary: ", [ users() ]; - if ($p = parse_user($input)) { - $user = $p->[2]; - last; + my %completions = qw(abort 1); + for (@plugins) { + my $attr = attributes::get( + ref $method ? $method : $_->can($method) + ) or next; + my ($tab) = $attr =~ /Tab \( (.*?) \)/x; + $completions{$_}++ for split /\s*,\s*/, $tab; } - print "$input: Invalid user. Type 'abort' to abort.\n"; - } - } - my $amount; - if (@$line and $p = parse_amount($line->[0])) { - shift @$line; - $amount = $p->[1]; - } elsif (@$line) { - print "$line->[0]: Invalid amount. $at\n"; - next LINE; - } - if (not defined $amount) { - for (;;) { - my $input = prompt "Amount to give to $user: "; - if ($p = parse_amount($input)) { - $amount = $p->[1]; - last; + if (delete $completions{USERS}) { + $completions{$_}++ for RevBank::Users::names; } - print "$input: Invalid amount. Type 'abort' to abort.\n"; - } - } - return [ 'transfer', -$amount, "Given to $user", [ - [ $user, +$amount, "Received from %%%" ], - ] ]; -} - -sub take { - my ($line) = @_; - my $p; - my @users; - my $amount; - ELEMENT: while (@$line) { - if ($p = parse_user($line->[0])) { - shift @$line; - push @users, $p->[2]; - next ELEMENT; - } - if ($p = parse_amount($line->[0])) { - shift @$line; - $amount = $p->[1]; - last ELEMENT; - } - print "$line->[0]: Invalid user or amount. $at\n"; - next LINE; - } - while (not @users or not defined $amount) { - PROMPT: for (;;) { - my $input = prompt( - "User to take from" - . (@users ? ", or total amount to finish: " : ": "), - [ users() ] - ); - if ($p = parse_user($input)) { - push @users, $p->[2]; - next PROMPT; - } - if ($p = parse_amount($input)) { - $amount = $p->[1]; - last PROMPT; - } - print "$input was not recognised as either an amount or a user.\n"; - } - } - my $each = sprintf "%.2f", $amount / @users; - my $total = sprintf "%.2f", @users * $each; - if ($total != $amount) { - print "Adjusted total amount to $total because of rounding.\n"; - } - my $x = @users > 1 ? 'each' : $users[0]; - my $reason; - while (not $reason) { - $reason = prompt - "Why are you taking $each from $x? (e.g. 'bbq' or 'wok') "; - } - my $users = join "/", @users; - return [ 'transfer', +$total, "Taken from $users ($reason)", [ - map [ $_, -$each, "Taken by %%% ($reason)" ], @users - ] ]; -} - -sub undo { - my ($line) = @_; - my $tid; - if (@$line and $line->[0] =~ /^[0-9]+$/) { - $tid = shift @$line; - } - until ($tid) { - $tid = prompt "Transaction ID to undo: "; - } - open my $in, ".revbank.undo" or die $!; - open my $out, ">.revbank.undo.$$" or die $!; - my $matches = 0; - while (defined(my $line = readline $in)) { - if ($line =~ /^$tid\s/) { - $matches++; - my (undef, $user, $delta) = split " ", $line; - update_account($user, $delta); - } else { - print {$out} $line; - } - } - close $in; - close $out or die $!; - if ($matches) { - rename ".revbank.undo.$$", ".revbank.undo" or die $!; - print "$matches account(s) affected by rollback.\n"; - } else { - print "Transaction ID '$tid' not found in undo log.\n"; - } - git_commit("Transaction $tid undone."); - return ['noop']; -} - -sub list { - system "sort -f revbank.accounts | grep -v ^# | more"; - return ['noop']; -} - -sub shame { - system "sort -f revbank.accounts | grep -v ^# | grep -- ' -' | more"; - return ['noop']; -} - -sub edit { - system "vim revbank.products"; - return ['noop']; -} - -sub number_of { - my ($type, @things) = @_; - my $counter = 0; - for (@things) { - $counter++ if $_->[0] eq $type; - } - return $counter; -} - -sub transaction_sum { - return sum map $_->[1], @_; -} - -sub todo2actions { - my ($user, @todo) = @_; - my %transactions; - for my $t (@todo) { - push @{ $transactions{$user} }, [ $t->[1], $t->[2] ]; - for (@{ $t->[3] }) { - (my $desc = $_->[2]) =~ s/%%%/$user/g; - push @{ $transactions{$_->[0]} }, [ $_->[1], $desc ]; - } - } - return %transactions; -} - -sub summary { - my ($indent, $user, @todo) = @_; - $user ||= '-you-'; - my %transactions = todo2actions($user, @todo); - - my @users = sort keys %transactions; - for my $u (@users) { - my @tr = @{ $transactions{$u} }; - for my $tr (@tr) { - printf( - "$indent %-16s %4s EUR %5.2f # %s\n", - $u, - ($tr->[0] > 0 ? 'GAIN' : $tr->[0] < 0 ? 'LOSE' : ''), - abs($tr->[0]), - $tr->[1] - ); - } - if (@tr > 1) { - my $sum = sum(map $_->[0], @tr); - printf( - "$indent %-16s %4s EUR %5.2f TOTAL\n", - $u, - ($sum > 0 ? 'GAIN' : $sum < 0 ? 'LOSE' : ''), - abs($sum), - ); - } - } -} - -LINE: for (;;) { - my @todo = (); - print "\n"; - - my $user; - while (not $user) { - print "\n"; - @todo = grep { $_->[0] ne 'noop' } @todo; - if (@todo) { - print "Preview:\n"; - summary(" ", $user, @todo); - print "\nEnter username to pay/finish or 'abort' to abort.\n" - } - my $line = prompt( - "Product ID, amount or command: ", - [ @commands, users() ] - ); - defined $line or exec $0; - my @line = split " ", $line; - ELEMENT: while (@line) { - my $element = shift @line; - my $p; - - if ($p = parse_product($element) ) { push @todo, $p; next; } - if ($p = parse_manual($element) ) { push @todo, $p; next; } - if ($p = parse_command($element, \@line)) { push @todo, $p; next; } - if ($p = parse_user($element)) { - $user = $p->[2]; - last; + if (delete $completions{NOABORT}) { + delete $completions{abort}; } - my $deposit = grep { $_->[0] eq 'deposit' } @todo; - if ($deposit) { - print "Input '$element' not recognised.\n"; - for (;;) { - my $yesno = prompt( - "Add new account for user '$element'? ", - [ qw/yes no/ ] # tab completion ;) - ); - if ($yesno =~ /^(?:y|yes)$/) { - create_account($element); - $user = $element; - next ELEMENT; - } elsif ($yesno =~ /^(?:n|no)$/) { - last; - } - print "Please enter y, yes, n, or no.\n"; + my $input = prompt $prompt, keys %completions; + + call_hooks "input", $cart, $input, $split_input; + + length $input or redo PROMPT; + + @words = ($split_input ? split(" ", $input) : $input); + $split_input = 0; # Only split 'outer' input. + } + + WORD: for (;;) { + redo PROMPT if not @words; + abort if grep $_ eq 'abort', @words; + + my $word = shift @words; + + PLUGIN: for my $plugin (@plugins) { + my ($rv, @rvargs) = eval { $plugin->$method($cart, $word) }; + if ($@) { + call_hooks "plugin_fail", $plugin->id, $@; + abort; } + if (not defined $rv) { + call_hooks "plugin_fail", $plugin->id, "No return code"; + abort; + } + if (not ref $rv) { + $prompt = $rv; + @plugins = $plugin; + ($method) = @rvargs; + call_hooks "plugin_fail", $plugin->id, "No method supplied" + if not ref $method; + next WORD; + } + if ($rv == ABORT) { + abort(@rvargs); + } + if ($rv == REJECT) { + my ($reason) = @rvargs; + call_hooks "reject", $plugin->id, $reason, @words ? 1 : 0; + abort if @words; + redo PROMPT; + } + if ($rv == ACCEPT) { + next OUTER; + } + if ($rv == NEXT) { + next PLUGIN if $method eq 'command'; + call_hooks "plugin_fail", $plugin->id, "Only 'command' " + . "should ever return NEXT."; + abort; + } + call_hooks "plugin_fail", $plugin->id, "Invalid return value"; + abort; } - print "$element: No such product, user, or command. $at\n"; - next LINE; - } - if (@line) { - print "Superfluous input (@line) after benificiary/remunerator " - . "($user). $at\n"; - next LINE; + call_hooks "invalid_input", $cart, $word; + abort if @words; + redo OUTER; } } - @todo = grep { $_->[0] ne 'noop' } @todo; - if (not @todo) { - printf "Balance for %s is \e[1m%+.2f\e[0m\n", - $user, read_users->{lc $user}->[1]; - print "NB: Products/amounts/commands FIRST, username LAST. $at\n"; - next LINE; - } - - my $tid = time() - 1300000000; - print "/", "-" x 40, "\n"; - print "| Final (transaction ID = $tid):\n"; - summary("| ", $user, @todo); - print "\\", "-" x 40, "\n"; - - open my $ufh, '>>.revbank.undo' or die $!; - my %transactions = todo2actions($user, @todo); - for (sort keys %transactions) { - my $delta = sum map $_->[0], @{ $transactions{$_} }; - print {$ufh} join " ", $tid, $_, -$delta, now(), "\n" or die $!; - my ($old, $new) = update_account($_, $delta); - } - close $ufh; - - git_commit("Transaction $tid by $user."); - - my $deposit = sum map $_->[1], grep { $_->[0] eq 'deposit' } @todo; - if ($deposit) { - printf "Don't forget to add EUR %.2f to the cash box!\n", $deposit; - } - - sleep 1; # Ensure new timestamp/id for new transaction } + +=head1 NAME + +revbank - Banking for hackerspace visitors + +=head1 DESCRIPTION + +Maybe I'll write some documentation, but not now. + +=head1 PLUGINS + +Refer to L for documentation about writing plugins. + +=head1 AUTHOR + +Juerd Waalboer <#####@juerd.nl> + +=head1 LICENSE + +Pick your favorite OSI license. + + diff --git a/revbank.plugins b/revbank.plugins new file mode 100644 index 0000000..375a582 --- /dev/null +++ b/revbank.plugins @@ -0,0 +1,18 @@ +# Order matters. Read RevBank::Plugins for documentation. + +# First, plugins with no commands, or very specific commands + +log # first, so that the registrations of other plugins are logged +sigint +restart +help +undo +give +take + +# Then, plugins that apply heuristics + +products # matches product IDs (barcodes) +withdraw # matches amounts +users # matches usernames +deposit # wants to be after 'users'