File Coverage

blib/lib/YA/CLI.pm
Criterion Covered Total %
statement 48 49 97.9
branch 10 10 100.0
condition 6 8 75.0
subroutine 13 14 92.8
pod 4 5 80.0
total 81 86 94.1


line stmt bran cond sub pod time code
1             package YA::CLI;
2             our $VERSION = '0.003';
3 2     2   176239 use Moo;
  2         11514  
  2         10  
4              
5             # ABSTRACT: Yet another CLI framework
6              
7 2     2   1867 use Carp qw(croak);
  2         4  
  2         84  
8 2     2   1544 use Getopt::Long;
  2         23880  
  2         11  
9 2     2   326 use List::Util qw(first);
  2         4  
  2         201  
10 2     2   1022 use Module::Pluggable::Object;
  2         12898  
  2         1067  
11              
12              
13             sub BUILD_ARGS {
14 0     0 0 0 croak "Please use run()";
15             }
16              
17             sub default_handler {
18 5     5 1 19 return 'main';
19             }
20              
21             sub default_search_path {
22 11     11 1 56 return shift;
23             }
24              
25             sub cli_options {
26 11     11 1 21 return;
27             }
28              
29             sub _init {
30 11     11   21 my ($class, $args) = @_;
31              
32 11   50     25 $args //= \@ARGV;
33              
34 11         25 my %cli_args = $class->_get_opts($args);
35              
36 11         19 my $action;
37 11 100 100     56 if (@$args && $args->[0] !~ /^--/) {
38 6         17 $action = shift @$args;
39             }
40 11   66     44 $action //= $class->default_handler;
41              
42 11         24 my $handler = $class->_get_action_handler($action);
43              
44 11 100       38 if (!$handler) {
45 2         545 require YA::CLI::ErrorHandler;
46 2         22 $handler = 'YA::CLI::ErrorHandler';
47 2         11 return $handler->as_help(1, "$action command does not exist!");
48             }
49              
50 9 100       31 return $handler->as_manpage() if $cli_args{man};
51 7 100       22 return $handler->as_help() if $cli_args{help};
52              
53 5         14 return $handler->new_from_args($args);
54             }
55              
56             sub run {
57 11     11 1 36996 my ($class, $args) = @_;
58 11         28 my $handler = $class->_init($args);
59 11         146 return $handler->run();
60             }
61              
62             sub _get_opts {
63 11     11   22 my ($class, $args) = @_;
64              
65 11         20 my @cli_options = qw(
66             help|h
67             man|m
68             );
69              
70 11         31 push(@cli_options, $class->cli_options);
71              
72 11         50 my $p = Getopt::Long::Parser->new(
73             config => [
74             qw(
75             pass_through
76             no_auto_abbrev
77             )
78             ]
79             );
80              
81 11         1352 my %cli_args;
82 11         44 $p->getoptionsfromarray($args, \%cli_args, @cli_options);
83 11         3077 return %cli_args;
84             }
85              
86             my @PLUGINS;
87              
88             sub _get_action_handler {
89 11     11   23 my ($class, $action) = @_;
90              
91 11         26 my $finder = Module::Pluggable::Object->new(
92             search_path => $class->default_search_path,
93             require => 1,
94             );
95              
96 11 100       107 @PLUGINS = $finder->plugins if !@PLUGINS;
97 11     16   6248 return first { $_->has_action($action) } @PLUGINS;
  16         67  
98             }
99              
100             __PACKAGE__->meta->make_immutable;
101              
102             __END__