File Coverage

blib/lib/MooX/Commander.pm

Criterion	Covered	Total	%
statement	18	50	36.0
branch	0	14	0.0
condition	0	9	0.0
subroutine	6	8	75.0
pod	0	1	0.0
total	24	82	29.2

package MooX::Commander;

use Moo;

use Class::Load qw/load_class/;
use String::CamelSnakeKebab qw/upper_camel_case/;
use Syntax::Keyword::Junction qw/any/;
use Path::Tiny;

our $VERSION = "0.02";

has base_class   => (is => 'rw');
has class_prefix => (is => 'rw', default => sub { "Cmd" });
has version      => (is => 'lazy');

sub _build_version {
    my $self = shift;
    load_class($self->base_class);
    my $program = path($0);
    my $version = $self->base_class . "::VERSION";
    no strict 'refs';
    print $program->basename . " $${version}\n";
    exit;
}

sub dispatch {
    my ($self, %params) = @_;
    my $argv = [@{ $params{argv} }]; # make a copy of the array

    (print($self->version->(), "\n") && exit 1)
        if $argv->[0]
        && $argv->[0] eq any(qw/-v --version/);

    unshift @$argv, 'help' if $argv->[0] && $argv->[0] eq any(qw/-h --help/);
    unshift @$argv, 'help' unless $argv->[0];

    my @args;
    while (my $arg = shift @$argv) {
        last if $arg =~ /^--?/;
        push @args, $arg;
    }

    my $action = upper_camel_case shift @args;
    my $class = $self->base_class . "::" . $self->class_prefix . "::" . $action;
    eval { load_class($class) };
    if ($@) {
        eval {
            my $start = $self->base_class . "::" . $self->class_prefix;
            my $class =  "${start}::Help";
            eval { load_class($class) };
            if ($@) {
                print "subcommand not found\n";
                exit 1;
            }

            $class->new(argv => $params{argv})->usage;
        };
    };

    $class->new(argv => $params{argv})->go(@args);
    die $@ if $@;
}

1;
__END__