revbank/revbank

#!/usr/bin/perl -w

use strict;
use attributes;
use IO::Select;
use List::Util ();
use Term::ReadLine;
require Term::ReadLine::Gnu;  # The other one sucks.

use FindBin qw($RealBin);
use lib "$RealBin/lib";
use RevBank::Plugins;
use RevBank::Global;
use RevBank::Messages;
use RevBank::Cart;

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

$| = 1;

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

my $select = IO::Select->new;
$select->add(\*STDIN);

my $cart = RevBank::Cart->new;

sub prompt {
    my ($prompt, $plugins, @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 $done;
    my $input;

    $readline->callback_handler_install($prompt, sub {
        $done = 1;
        $input = shift;
        $readline->callback_handler_remove;
    });
    
    my $begin = my $time = time;
    while (not $done) { 
        $readline->callback_read_char if $select->can_read(.05);
        if (time > $time) {
            $time = time;
            call_hooks(
                "prompt_idle",
                $cart,
                (@$plugins > 1 ? undef : $plugins->[0]), # >1 plugin = main loop
                $time - $begin,
                $readline,
            );
        }
    }

    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 @words;

OUTER: for (;;) {
    print "\n" if not @words;

    if (not @words and $cart->changed) {
        call_hooks("cart_changed", $cart);
    }

    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 my $plugin (@plugins) {
                my $attr = attributes::get(
                    ref $method ? $method : $plugin->can($method)
                ) or next;
                my ($tab) = $attr =~ /Tab \( (.*?) \)/x;
                for my $keyword (split /\s*,\s*/, $tab) {
                    if ($keyword =~ /^&(.*)/) {
                        my $method = $1;
                        @completions{ $plugin->$method } = ();
                    } else {
                        $completions{ $keyword }++;
                    }
                }
            }
            if (delete $completions{USERS}) {
                $completions{$_}++ for RevBank::Users::names;
            }
            if (delete $completions{NOABORT}) {
                delete $completions{abort};
            }

            my $input = prompt $prompt, \@plugins, 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.