File Coverage

blib/lib/YA/CLI.pm

Criterion	Covered	Total	%
statement	61	66	92.4
branch	22	30	73.3
condition	17	20	85.0
subroutine	13	14	92.8
pod	4	5	80.0
total	117	135	86.6

package YA::CLI;
our $VERSION = '0.007';
use Moo;

# ABSTRACT: Yet another CLI framework

use Carp qw(croak);
use Getopt::Long;
use List::Util qw(first);
use Module::Pluggable::Object;

with 'YA::CLI::PodRole';

sub BUILD_ARGS {
    croak "Please use run()";
}

sub default_handler {
    return 'main';
}

sub default_search_path {
    return shift;
}

sub cli_options {
    return;
}

sub _init {
    my ($class, $args) = @_;

    $args //= \@ARGV;

    my %cli_args = $class->_get_opts($args);

    my ($action, $subaction);
    if (@$args && $args->[0] !~ /^--/) {
        $action = shift @$args;
    }
    if ($action && @$args && $args->[0] !~ /^--/) {
        $subaction = shift @$args;
    }

    $action //= $class->default_handler;
    if (!defined $action) {
        return $class->as_manpage()  if $cli_args{man};
        return $class->as_help()     if $cli_args{help};
        return $class->as_help(1);
    }
    return $class->as_help() if !defined $action;

    my $handler = $class->_get_action_handler($action, $subaction);

    if (!$handler) {
        require YA::CLI::ErrorHandler;
        $handler = 'YA::CLI::ErrorHandler';
        if (!defined $subaction) {
            return $handler->as_help(1, "$action command does not exist!");
        }
        else {
            return $handler->as_help(1, "$action $subaction command does not exist!");
        }
    }

    if ($handler && defined $subaction && !$handler->can('subaction')) {
        unshift(@$args, $subaction);
    }

    return $handler->as_manpage()  if $cli_args{man};
    return $handler->as_help()     if $cli_args{help};

    return $handler->new_from_args($args);
}

sub run {
    my ($class, $args) = @_;
    my $handler = $class->_init($args);
    return $handler->run();
}

sub _get_opts {
    my ($class, $args) = @_;

    my @cli_options = qw(
        help|h
        man|m
    );

    push(@cli_options, $class->cli_options);

    my $p = Getopt::Long::Parser->new(
        config => [
            qw(
                pass_through
                no_auto_abbrev
            )
        ]
    );

    my %cli_args;
    $p->getoptionsfromarray($args, \%cli_args, @cli_options);
    return %cli_args;
}

my @PLUGINS;

sub _get_action_handler {
    my $class     = shift;
    my $action    = shift;
    my $subaction = shift;

    my $finder = Module::Pluggable::Object->new(
        search_path => $class->default_search_path,
        require     => 1,
        $class->can('exclude_search_path') ? (
            except => $class->exclude_search_path,
        ) : (),
    );

    @PLUGINS = $finder->plugins if !@PLUGINS;
    my @found = grep { $_->has_action($action, $subaction) } @PLUGINS;
    return unless @found;

    return $found[0] if @found == 1;
    return first { $_->has_subaction($subaction) == 1 } @found;

}

__PACKAGE__->meta->make_immutable;

__END__