File Coverage

blib/lib/App/Spec/Role/Command.pm
Criterion Covered Total %
statement 109 116 93.9
branch 37 50 74.0
condition 8 11 72.7
subroutine 15 15 100.0
pod 7 7 100.0
total 176 199 88.4


line stmt bran cond sub pod time code
1 5     5   48317 use strict;
  5         13  
  5         152  
2 5     5   26 use warnings;
  5         9  
  5         312  
3             package App::Spec::Role::Command;
4              
5             our $VERSION = '0.013'; # VERSION
6              
7 5     5   1924 use YAML::PP;
  5         193521  
  5         262  
8 5     5   45 use List::Util qw/ any /;
  5         13  
  5         432  
9 5     5   37 use App::Spec::Option;
  5         13  
  5         168  
10 5     5   1562 use Ref::Util qw/ is_arrayref /;
  5         4948  
  5         299  
11              
12 5     5   33 use Moo::Role;
  5         14  
  5         46  
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 31     31 1 166 qw/ Meta Help /
27             }
28              
29             sub has_subcommands {
30 33     33 1 87 my ($self) = @_;
31 33 100       195 return $self->subcommands ? 1 : 0;
32             }
33              
34             sub build {
35 434     434 1 1950 my ($class, %spec) = @_;
36 434   100     1684 $spec{options} ||= [];
37 434   100     1752 $spec{parameters} ||= [];
38 434         683 for (@{ $spec{options} }, @{ $spec{parameters} }) {
  434         838  
  434         877  
39 585 50       1341 $_ = { spec => $_ } unless ref $_;
40             }
41 434 50       721 $_ = App::Spec::Option->build(%$_) for @{ $spec{options} || [] };
  434         2187  
42 434 50       804 $_ = App::Spec::Parameter->build(%$_) for @{ $spec{parameters} || [] };
  434         1772  
43              
44 434         768 my $commands;
45 434 100       713 for my $name (keys %{ $spec{subcommands} || {} }) {
  434         1985  
46 343         2511 my $cmd = $spec{subcommands}->{ $name };
47 343         1503 $commands->{ $name } = App::Spec::Subcommand->build(
48             name => $name,
49             %$cmd,
50             );
51             }
52 434         2157 $spec{subcommands} = $commands;
53              
54 434 100       1210 if ( defined (my $op = $spec{op}) ) {
55 291 50       1323 die "Invalid op '$op'" unless $op =~ m/^\w+\z/;
56             }
57 434 100       1247 if ( defined (my $class = $spec{class}) ) {
58 91 50       618 die "Invalid class '$class'" unless $class =~ m/^ \w+ (?: ::\w+)* \z/x;
59             }
60              
61 434         8586 my $self = $class->new(%spec);
62             }
63              
64             sub read {
65 91     91 1 369535 my ($class, $file) = @_;
66 91 50       289 unless (defined $file) {
67 0         0 die "No filename given";
68             }
69              
70 91         294 my $spec = $class->load_data($file);
71              
72 91         223 my %disable;
73             my @plugins;
74              
75 91   100     477 my $spec_plugins = $spec->{plugins} || [];
76 91         277 for my $plugin (@$spec_plugins) {
77 27 100       188 if ($plugin =~ m/^-(.*)/) {
78 2         9 $disable{ $1 } = 1;
79             }
80             }
81 91         625 my @default_plugins = grep { not $disable{ $_ } } $class->default_plugins;
  62         235  
82              
83 91         262 push @plugins, @default_plugins;
84 91         217 push @plugins, grep{ not m/^-/ } @$spec_plugins;
  27         170  
85 91         240 for my $plugin (@plugins) {
86 85 50       292 unless ($plugin =~ s/^=//) {
87 85         289 $plugin = "App::Spec::Plugin::$plugin";
88             }
89             }
90 91         252 $spec->{plugins} = \@plugins;
91              
92 91         665 my $self = $class->build(%$spec);
93              
94 91         1240 $self->load_plugins;
95 91         1129 $self->init_plugins;
96              
97 91         977 return $self;
98             }
99              
100             sub load_data {
101 91     91 1 256 my ($class, $file) = @_;
102 91         161 my $spec;
103 91 50       618 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 29         59 $spec = eval { YAML::PP::LoadFile($file) };
  29         471  
109             }
110             elsif (ref $file eq 'SCALAR') {
111 29         70 my $data = $$file;
112 29         77 $spec = eval { YAML::PP::Load($data) };
  29         122  
113             }
114             elsif (ref $file eq 'HASH') {
115 33         70 $spec = $file;
116             }
117              
118 91 50       4424121 unless ($spec) {
119 0         0 die "Error reading '$file': $@";
120             }
121 91         372 return $spec;
122             }
123              
124             sub load_plugins {
125 91     91 1 249 my ($self) = @_;
126 91         341 my $plugins = $self->plugins;
127 91 100       325 if (@$plugins) {
128 31         281 require Module::Runtime;
129 31         114 for my $plugin (@$plugins) {
130 85         2127 my $loaded = Module::Runtime::require_module($plugin);
131             }
132             }
133             }
134              
135             sub init_plugins {
136 91     91 1 198 my ($self) = @_;
137 91         205 my $plugins = $self->plugins;
138 91 100       305 if (@$plugins) {
139 31         266 my $subcommands = $self->subcommands;
140 31         200 my $options = $self->options;
141 31         110 for my $plugin (@$plugins) {
142 85 100       1699 if ($plugin->does('App::Spec::Role::Plugin::Subcommand')) {
143 60         1714 push @{ $self->plugins_by_type->{Subcommand} }, $plugin;
  60         303  
144 60         342 my $subc = $plugin->install_subcommands( spec => $self );
145 60 50       272 $subc = [ $subc ] unless is_arrayref($subc);
146              
147 60 100       282 if ($subcommands) {
148 52         143 for my $cmd (@$subc) {
149 52   33     410 $subcommands->{ $cmd->name } ||= $cmd;
150             }
151             }
152             }
153              
154 85 100       976 if ($plugin->does('App::Spec::Role::Plugin::GlobalOptions')) {
155 56         918 push @{ $self->plugins_by_type->{GlobalOptions} }, $plugin;
  56         286  
156 56         312 my $new_opts = $plugin->install_options( spec => $self );
157 56 50       156 if ($new_opts) {
158 56   50     137 $options ||= [];
159              
160 56         165 for my $opt (@$new_opts) {
161 56         329 $opt = App::Spec::Option->build(%$opt);
162 56 50   111   554 unless (any { $_->name eq $opt->name } @$options) {
  111         422  
163 56         321 push @$options, $opt;
164             }
165             }
166              
167             }
168             }
169              
170             }
171             }
172             }
173              
174              
175             1;
176              
177             __END__