Find a file
2013-02-26 04:32:26 +01:00
plugins RevBank 2.0, a rewrite. It's plugin based now. 2013-02-26 04:11:13 +01:00
RevBank RevBank 2.0, a rewrite. It's plugin based now. 2013-02-26 04:11:13 +01:00
README.pod Symlink so github sees a README. 2013-02-26 04:32:26 +01:00
revbank RevBank 2.0, a rewrite. It's plugin based now. 2013-02-26 04:11:13 +01:00
revbank.accounts Empty accounts file 2011-05-16 22:04:47 +02:00
revbank.plugins RevBank 2.0, a rewrite. It's plugin based now. 2013-02-26 04:11:13 +01:00
revbank.products Slightly better comments 2013-02-26 04:09:15 +01:00

#!/usr/bin/perl -w

use strict;
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.

our $VERSION = "2.0";
our %HELP = (
    "abort" => "Abort the current transaction",
);

$| = 1;

my $readline = Term::ReadLine->new($0);
$readline->ornaments('me,md,,');

sub prompt {
    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;
        return shift @matches;
    };
    my $input = $readline->readline($prompt);

    print "\e[0m";
    defined $input or return;

    $input =~ s/^\s+//;  # trim leading whitespace
    $input =~ s/\s+$//;  # trim trailing whitespace

    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;
    }

    my $split_input = 1;
    my $prompt = "Product ID, amount or command";
    my @plugins = RevBank::Plugins->new;
    my $method = "command";

    sub abort {
        print @_, " " if @_;
        @words = ();
        call_hooks "abort", $cart;
        $cart->empty;
        { no warnings; redo OUTER; }
    }

    PROMPT: {
        if (not @words) {
            call_hooks "prompt", $cart, $prompt;

            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;
            }
            if (delete $completions{USERS}) {
                $completions{$_}++ for RevBank::Users::names;
            }
            if (delete $completions{NOABORT}) {
                delete $completions{abort};
            }

            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;
            }
            call_hooks "invalid_input", $cart, $word;
            abort if @words;
            redo OUTER;
        }
    }
}

=head1 NAME

revbank - Banking for hackerspace visitors

=head1 DESCRIPTION

Maybe I'll write some documentation, but not now.

=head1 PLUGINS

Refer to L<RevBank::Plugins> for documentation about writing plugins.

=head1 AUTHOR

Juerd Waalboer <#####@juerd.nl>

=head1 LICENSE

Pick your favorite OSI license.