File Coverage

blib/lib/App/Rad/Plugin/ReadLine.pm

Criterion	Covered	Total	%
statement	16	75	21.3
branch	0	34	0.0
condition	0	14	0.0
subroutine	6	15	40.0
pod	2	2	100.0
total	24	140	17.1

package App::Rad::Plugin::ReadLine;
BEGIN {
  $App::Rad::Plugin::ReadLine::VERSION = '0.003'; # TRIAL
}

# ABSTRACT: App::Rad::Plugin::ReadLine a Term::UI ->shell for Rad Apps


use warnings;
use strict;

our $GreetWithCommand = 'help';  # when the shell starts, run this command
our $GreetWithSub             ;  # you can pass in a sub too,  both GreetWith's are run
our $DefaultCommand   = ''    ;
our $ShellPrompt      = "[" . $0 . "]";

# we keep prompting until this is false
# (we register "exit" as a command to set it to 0 upon entering shell)
our $still_going = 1;


use Term::UI;
use Term::ReadLine;


our $term;
sub _terminal {
    $term ||= Term::ReadLine->new($ENV{TERM} || 'critter');
}

sub _shell_prompt   {
    # add a space to the end
    $ShellPrompt =~ / $/?  $ShellPrompt : "$ShellPrompt "
}
sub _shell_help     { "run $0 in interactive mode" };
sub _shell_command  { 'shell' }


sub shell_options {
    my $c = shift;

    if (@_==0) {
        $c->register( _shell_command() => \&shell, _shell_help() );
        return;
    }

    my ($opts, $name, $help);
    my $no_register;

    if ('HASH' eq ref $_[0]) {
        ($opts, $name, $help) = @_;
        $GreetWithCommand = $opts->{GreetWithCommand}
                             if exists $opts->{GreetWithCommand};
        $GreetWithSub = $opts->{GreetWithSub}
                             if exists $opts->{GreetWithSub};
        $DefaultCommand = $opts->{DefaultCommand}
                             if exists $opts->{DefaultCommand};
        $ShellPrompt = $opts->{ShellPrompt}
                             if exists $opts->{ShellPrompt};

        $c->debug(sprintf'shell_options '
                    . '$GreetWithCommand   = %s, '
                    . '$GreetWithSub       = %s, '
                    . '$ShellPrompt        = %s, '
                    . '$DefaultCommand     = %s. also '
                    . '$name = %s, $help = %s',
                    map defined $_ ? $_ : '(not defined)',
                        $GreetWithCommand,
                        $GreetWithSub,
                        $ShellPrompt,
                        $DefaultCommand,
                        $name, $help
        );

        $no_register = 1
            if @_ >= 2 and not defined $name;
    }
    else {
        ($name, $help) = @_;
        $no_register = 1
            if @_ >= 1 and not defined $name;
    }

    if ($no_register) {
        $c->debug("not registering shell as a command since \$name was passed as undef");
    }
    else {
        $name = _shell_command() if not defined $name;
        $help = _shell_help()    if not defined $help;


        $c->debug("registering shell as '$name' => '$help'");
        $c->register( $name => \&shell, $help );
    }
}


# this is printed when your shell first starts, it will optionally run a command,
# then optionally run a sub
# again, you can do both, but that's likely to be unhelpful
sub _welcome {
    my $c = shift;
    # $c->critters();
    $c->stash->{shelllvl} ++;

    do {
        local $c->{'cmd'} = $GreetWithCommand;
        $c->execute();
    } if defined $GreetWithCommand;

    $c->$GreetWithSub() if defined $GreetWithSub;

}

sub shell {
    my $c = shift;
    # $c->critters();
    $c->stash->{shelllvl} ++;
    {no warnings qw[ redefine ];
    *App::Rad::Help::usage = sub {
        "Your app as a shell. Type commands with arguments"
    };}


    # sub-shells
    local $GreetWithCommand  = $GreetWithCommand ;
    local $GreetWithSub      = $GreetWithSub     ;
    local $DefaultCommand    = $DefaultCommand   ;

    local $ShellPrompt       = $ShellPrompt      ;
    local $still_going       = $still_going      ;

    $c->shell_options(@_) if @_;

    $c->register( 'exit', sub {
        $App::Rad::Plugin::ReadLine::still_going = 0;
    }, "exit the $0 shell" );

    $c->unregister_command('shell');# Xhibit forbidden

    my $welcome = \&_welcome;
    $c->$welcome();

    while($still_going) {
        (my $cmd, local @ARGV) = split  ' ',
        _terminal->get_reply(
              prompt => _shell_prompt(),
              default => $DefaultCommand,
        );
        if (defined $cmd and $cmd ne '') {
            @{$c->argv} = @ARGV;
            $c->{'cmd'} = $cmd;

            $c->debug('received command: ' . $c->{'cmd'});
            $c->debug('received parameters: ' . join (' ', @{$c->argv} ));
        }
        $c->_tinygetopt();
        # run the specified command
        #       setup/pre_process are run for us...
        $c->execute();
        # teardown is run after this (again, magically)
    }
}


"Say my name"

__END__