revbank/revbank

#!/usr/bin/perl

use v5.28;
use warnings;
use feature qw(signatures);
no warnings "experimental::signatures";

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 = "3.2";
our %HELP = (
    "abort" => "Abort the current transaction",
);

my @words;
my $retry;
my @retry;

my $one_off = 0;

if (@ARGV) {
    # Non-interactive like in sh: -c command_string
    @ARGV >= 1 and $ARGV[0] eq '-c' or die "$0 has no switches, except -c.";

    $one_off = 1;

    @words = split " ", $ARGV[1];
    push @words, @ARGV[3 .. $#ARGV] if @ARGV > 3;
    push @words, "help" if not @words;
}

$| = 1;

my $readline = Term::ReadLine->new($0);

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

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

sub prompt($prompt, $plugins, $completions) {
    if ($prompt) {
        $prompt =~ s/$/:/ if $prompt !~ /[?>]$/;
        $prompt .= " ";
    } else {
        # \x01...\x02 = zero width markers for readline
        # \e[...m     = ansi escape (32 = green, 1 = bright)
        $prompt = "\x01\e[32;1m\x02>\x01\e[0m\x02 ";
    }

    my @matches;
    $readline->Attribs->{completion_entry_function} = sub {
        my ($word, $state) = @_;
        return undef if $word eq "";
        @matches = grep /^\Q$word\E/i, @$completions if $state == 0;
        return shift @matches;
    };

    my $done;
    my $input;

    print "$retry\n" if $retry;
    $readline->callback_handler_install($prompt, sub {
        $done = 1;
        $input = shift;
        $readline->callback_handler_remove;
    });

    if ($retry) {
        my $preset = join " ", @retry[0 .. $#retry - 1];
        my $cursor = length $preset;
        $preset .= " " . join " ", @{ $retry[-1] };
        $readline->insert_text($preset);
        $readline->Attribs->{point} = $cursor;
        @retry = ();
        $retry = 0;
    }
    $readline->redisplay();

    my $begin = my $time = time;
    while (not $done) {
        if ($::ABORT_HACK) {
            # Global variable that a signal handling plugin can set.
            # Do not use, but "return ABORT" instead.
            my $reason = $::ABORT_HACK;
            $::ABORT_HACK = 0;
            abort($reason);
        }
        if ($select->can_read(.05)) {
            $readline->callback_read_char;
            $begin = $time;
        }
        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;
    $readline->addhistory($input);

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

    return $input;
}

RevBank::Plugins->load;

call_hooks("startup");

OUTER: for (;;) {
    if (not @words) {
        call_hooks("cart_changed", $cart) if $cart->changed;
        print "\n";
    }

    my $split_input = 1;
    my $prompt = "";
    my @plugins = RevBank::Plugins->new;
    my $method = "command";

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

    PROMPT: {
        if (not @words) {
            if ($one_off) {
                exit if $one_off++ > 1;

                abort "Incomplete command." if $cart->size;
                exit;
            }

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

        WORD: for (;;) {
            redo PROMPT if not @words;
            abort if grep $_ eq 'abort', @words;

            my $word = shift @words;
            push @retry, $word;
            $split_input = 0;  # Only split 'outer' input.

            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;

                    abort "Incomplete command." if $one_off and not @words;
                    next WORD;
                }
                if ($rv == ABORT) {
                    abort(@rvargs);
                }
                if ($rv == REJECT) {
                    my ($reason) = @rvargs;
                    #abort if @words;

                    if (@words) {
                        call_hooks "retry", $plugin->id, $reason, @words ? 1 : 0;
                        push @retry, [@words];
                        @words = ();
                        $retry = $reason;
                        redo OUTER;
                    } else {
                        call_hooks "reject", $plugin->id, $reason, @words ? 1 : 0;
                        @retry = ();
                        redo PROMPT;
                    }
                }
                if ($rv == ACCEPT) {
                    @retry = ();
                    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;
            @retry = ();
            abort if @words;
            redo OUTER;
        }
    }
}

=head1 NAME

revbank - Banking for hackerspace visitors

=head1 DESCRIPTION

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

Shell-like invocation with C<-c> is supported, sort of, but it has to be a
complete command. Currently, multiple commands are supported on the command
line (space separated), but that's an unintended feature...

=head1 PLUGINS

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

Plugins themselves may have some documentation in the respective plugin files.

Note that plugins that begin with C<revspace_> are revspace specific hacks, and
were not written with reusability in mind. They will probably not work for your
setup.

=head1 AUTHOR

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

=head1 LICENSE

Pick your favorite OSI license.