File Coverage

blib/lib/App/Spec/Role/Command.pm
Criterion Covered Total %
statement 109 116 93.9
branch 38 50 76.0
condition 8 11 72.7
subroutine 15 15 100.0
pod 7 7 100.0
total 177 199 88.9


line stmt bran cond sub pod time code
1 9     9   349913 use strict;
  9         24  
  9         364  
2 9     9   47 use warnings;
  9         18  
  9         1008  
3             package App::Spec::Role::Command;
4              
5             our $VERSION = 'v0.15.0'; # VERSION
6              
7 9     9   5061 use YAML::PP;
  9         749634  
  9         635  
8 9     9   86 use List::Util qw/ any /;
  9         19  
  9         801  
9 9     9   609 use App::Spec::Option;
  9         38  
  9         309  
10 9     9   5252 use Ref::Util qw/ is_arrayref /;
  9         19687  
  9         868  
11              
12 9     9   670 use Moo::Role;
  9         11605  
  9         100  
13              
14             has name => ( is => 'rw' );
15             has markup => ( is => 'rw', default => 'pod' );
16             has class => ( is => 'rw' );
17             has op => ( is => 'ro' );
18             has plugins => ( is => 'ro' );
19             has plugins_by_type => ( is => 'ro', default => sub { +{} } );
20             has options => ( is => 'rw', default => sub { +[] } );
21             has parameters => ( is => 'rw', default => sub { +[] } );
22             has subcommands => ( is => 'rw', default => sub { +{} } );
23             has description => ( is => 'rw' );
24              
25             sub default_plugins {
26 38     38 1 167 qw/ Meta Help /
27             }
28              
29             sub has_subcommands {
30 36     36 1 100 my ($self) = @_;
31 36 100       248 return $self->subcommands ? 1 : 0;
32             }
33              
34             sub build {
35 499     499 1 2526 my ($class, %spec) = @_;
36 499   100     2261 $spec{options} ||= [];
37 499   100     2280 $spec{parameters} ||= [];
38 499         831 for (@{ $spec{options} }, @{ $spec{parameters} }) {
  499         1155  
  499         1156  
39 674 100       1641 $_ = { spec => $_ } unless ref $_;
40             }
41 499 50       827 $_ = App::Spec::Option->build(%$_) for @{ $spec{options} || [] };
  499         3383  
42 499 50       940 $_ = App::Spec::Parameter->build(%$_) for @{ $spec{parameters} || [] };
  499         2576  
43              
44 499         1012 my $commands;
45 499 100       839 for my $name (keys %{ $spec{subcommands} || {} }) {
  499         2790  
46 390         3807 my $cmd = $spec{subcommands}->{ $name };
47 390         2054 $commands->{ $name } = App::Spec::Subcommand->build(
48             name => $name,
49             %$cmd,
50             );
51             }
52 499         3237 $spec{subcommands} = $commands;
53              
54 499 100       1616 if ( defined (my $op = $spec{op}) ) {
55 330 50       2008 die "Invalid op '$op'" unless $op =~ m/^\w+\z/;
56             }
57 499 100       1723 if ( defined (my $class = $spec{class}) ) {
58 109 50       929 die "Invalid class '$class'" unless $class =~ m/^ \w+ (?: ::\w+)* \z/x;
59             }
60              
61 499         13775 my $self = $class->new(%spec);
62             }
63              
64             sub read {
65 109     109 1 1953069 my ($class, $file) = @_;
66 109 50       462 unless (defined $file) {
67 0         0 die "No filename given";
68             }
69              
70 109         549 my $spec = $class->load_data($file);
71              
72 109         352 my %disable;
73             my @plugins;
74              
75 109   100     814 my $spec_plugins = $spec->{plugins} || [];
76 109         358 for my $plugin (@$spec_plugins) {
77 32 100       209 if ($plugin =~ m/^-(.*)/) {
78 5         48 $disable{ $1 } = 1;
79             }
80             }
81 109         891 my @default_plugins = grep { not $disable{ $_ } } $class->default_plugins;
  76         324  
82              
83 109         294 push @plugins, @default_plugins;
84 109         310 push @plugins, grep{ not m/^-/ } @$spec_plugins;
  32         134  
85 109         283 for my $plugin (@plugins) {
86 98 50       308 unless ($plugin =~ s/^=//) {
87 98         309 $plugin = "App::Spec::Plugin::$plugin";
88             }
89             }
90 109         1190 $spec->{plugins} = \@plugins;
91              
92 109         927 my $self = $class->build(%$spec);
93              
94 109         1911 $self->load_plugins;
95 109         1392 $self->init_plugins;
96              
97 109         1711 return $self;
98             }
99              
100             sub load_data {
101 109     109 1 418 my ($class, $file) = @_;
102 109         300 my $spec;
103 109 50       966 if (ref $file eq 'GLOB') {
    100          
    100          
    50          
104 0         0 my $data = do { local $/; <$file> };
  0         0  
  0         0  
105 0         0 $spec = eval { YAML::PP::Load($data) };
  0         0  
106             }
107             elsif (not ref $file) {
108 36         119 $spec = eval { YAML::PP::LoadFile($file) };
  36         254  
109             }
110             elsif (ref $file eq 'SCALAR') {
111 33         95 my $data = $$file;
112 33         74 $spec = eval { YAML::PP::Load($data) };
  33         217  
113             }
114             elsif (ref $file eq 'HASH') {
115 40         93 $spec = $file;
116             }
117              
118 109 50       7200731 unless ($spec) {
119 0         0 die "Error reading '$file': $@";
120             }
121 109         551 return $spec;
122             }
123              
124             sub load_plugins {
125 109     109 1 331 my ($self) = @_;
126 109         461 my $plugins = $self->plugins;
127 109 100       505 if (@$plugins) {
128 38         3827 require Module::Runtime;
129 38         10379 for my $plugin (@$plugins) {
130 98         2289 my $loaded = Module::Runtime::require_module($plugin);
131             }
132             }
133             }
134              
135             sub init_plugins {
136 109     109 1 352 my ($self) = @_;
137 109         345 my $plugins = $self->plugins;
138 109 100       443 if (@$plugins) {
139 38         178 my $subcommands = $self->subcommands;
140 38         159 my $options = $self->options;
141 38         118 for my $plugin (@$plugins) {
142 98 100       2379 if ($plugin->does('App::Spec::Role::Plugin::Subcommand')) {
143 71         1865 push @{ $self->plugins_by_type->{Subcommand} }, $plugin;
  71         444  
144 71         465 my $subc = $plugin->install_subcommands( spec => $self );
145 71 50       385 $subc = [ $subc ] unless is_arrayref($subc);
146              
147 71 100       420 if ($subcommands) {
148 61         1084 for my $cmd (@$subc) {
149 61   33     651 $subcommands->{ $cmd->name } ||= $cmd;
150             }
151             }
152             }
153              
154 98 100       1317 if ($plugin->does('App::Spec::Role::Plugin::GlobalOptions')) {
155 65         1227 push @{ $self->plugins_by_type->{GlobalOptions} }, $plugin;
  65         374  
156 65         359 my $new_opts = $plugin->install_options( spec => $self );
157 65 50       204 if ($new_opts) {
158 65   50     214 $options ||= [];
159              
160 65         174 for my $opt (@$new_opts) {
161 65         612 $opt = App::Spec::Option->build(%$opt);
162 65 50   131   891 unless (any { $_->name eq $opt->name } @$options) {
  131         652  
163 65         465 push @$options, $opt;
164             }
165             }
166              
167             }
168             }
169              
170             }
171             }
172             }
173              
174              
175             1;
176              
177             __END__