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   46424 use strict;
  5         13  
  5         154  
2 5     5   29 use warnings;
  5         9  
  5         260  
3             package App::Spec::Role::Command;
4              
5             our $VERSION = '0.011'; # VERSION
6              
7 5     5   1815 use YAML::PP;
  5         188568  
  5         262  
8 5     5   43 use List::Util qw/ any /;
  5         13  
  5         476  
9 5     5   38 use App::Spec::Option;
  5         11  
  5         127  
10 5     5   1410 use Ref::Util qw/ is_arrayref /;
  5         4687  
  5         301  
11              
12 5     5   36 use Moo::Role;
  5         12  
  5         49  
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 148 qw/ Meta Help /
27             }
28              
29             sub has_subcommands {
30 33     33 1 77 my ($self) = @_;
31 33 100       408 return $self->subcommands ? 1 : 0;
32             }
33              
34             sub build {
35 434     434 1 1868 my ($class, %spec) = @_;
36 434   100     1655 $spec{options} ||= [];
37 434   100     1695 $spec{parameters} ||= [];
38 434         661 for (@{ $spec{options} }, @{ $spec{parameters} }) {
  434         840  
  434         883  
39 577 50       1441 $_ = { spec => $_ } unless ref $_;
40             }
41 434 50       673 $_ = App::Spec::Option->build(%$_) for @{ $spec{options} || [] };
  434         2139  
42 434 50       730 $_ = App::Spec::Parameter->build(%$_) for @{ $spec{parameters} || [] };
  434         1697  
43              
44 434         686 my $commands;
45 434 100       621 for my $name (keys %{ $spec{subcommands} || {} }) {
  434         1900  
46 343         2384 my $cmd = $spec{subcommands}->{ $name };
47 343         1508 $commands->{ $name } = App::Spec::Subcommand->build(
48             name => $name,
49             %$cmd,
50             );
51             }
52 434         2059 $spec{subcommands} = $commands;
53              
54 434 100       1259 if ( defined (my $op = $spec{op}) ) {
55 291 50       1421 die "Invalid op '$op'" unless $op =~ m/^\w+\z/;
56             }
57 434 100       1129 if ( defined (my $class = $spec{class}) ) {
58 91 50       645 die "Invalid class '$class'" unless $class =~ m/^ \w+ (?: ::\w+)* \z/x;
59             }
60              
61 434         8298 my $self = $class->new(%spec);
62             }
63              
64             sub read {
65 91     91 1 366825 my ($class, $file) = @_;
66 91 50       332 unless (defined $file) {
67 0         0 die "No filename given";
68             }
69              
70 91         319 my $spec = $class->load_data($file);
71              
72 91         245 my %disable;
73             my @plugins;
74              
75 91   100     484 my $spec_plugins = $spec->{plugins} || [];
76 91         284 for my $plugin (@$spec_plugins) {
77 27 100       169 if ($plugin =~ m/^-(.*)/) {
78 2         11 $disable{ $1 } = 1;
79             }
80             }
81 91         652 my @default_plugins = grep { not $disable{ $_ } } $class->default_plugins;
  62         241  
82              
83 91         281 push @plugins, @default_plugins;
84 91         203 push @plugins, grep{ not m/^-/ } @$spec_plugins;
  27         173  
85 91         219 for my $plugin (@plugins) {
86 85 50       266 unless ($plugin =~ s/^=//) {
87 85         238 $plugin = "App::Spec::Plugin::$plugin";
88             }
89             }
90 91         251 $spec->{plugins} = \@plugins;
91              
92 91         606 my $self = $class->build(%$spec);
93              
94 91         1099 $self->load_plugins;
95 91         1022 $self->init_plugins;
96              
97 91         961 return $self;
98             }
99              
100             sub load_data {
101 91     91 1 242 my ($class, $file) = @_;
102 91         155 my $spec;
103 91 50       643 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         143  
109             }
110             elsif (ref $file eq 'SCALAR') {
111 29         73 my $data = $$file;
112 29         69 $spec = eval { YAML::PP::Load($data) };
  29         132  
113             }
114             elsif (ref $file eq 'HASH') {
115 33         66 $spec = $file;
116             }
117              
118 91 50       4264562 unless ($spec) {
119 0         0 die "Error reading '$file': $@";
120             }
121 91         388 return $spec;
122             }
123              
124             sub load_plugins {
125 91     91 1 215 my ($self) = @_;
126 91         346 my $plugins = $self->plugins;
127 91 100       364 if (@$plugins) {
128 31         310 require Module::Runtime;
129 31         105 for my $plugin (@$plugins) {
130 85         1815 my $loaded = Module::Runtime::require_module($plugin);
131             }
132             }
133             }
134              
135             sub init_plugins {
136 91     91 1 249 my ($self) = @_;
137 91         222 my $plugins = $self->plugins;
138 91 100       290 if (@$plugins) {
139 31         308 my $subcommands = $self->subcommands;
140 31         202 my $options = $self->options;
141 31         103 for my $plugin (@$plugins) {
142 85 100       1868 if ($plugin->does('App::Spec::Role::Plugin::Subcommand')) {
143 60         1545 push @{ $self->plugins_by_type->{Subcommand} }, $plugin;
  60         366  
144 60         371 my $subc = $plugin->install_subcommands( spec => $self );
145 60 50       264 $subc = [ $subc ] unless is_arrayref($subc);
146              
147 60 100       238 if ($subcommands) {
148 52         122 for my $cmd (@$subc) {
149 52   33     423 $subcommands->{ $cmd->name } ||= $cmd;
150             }
151             }
152             }
153              
154 85 100       964 if ($plugin->does('App::Spec::Role::Plugin::GlobalOptions')) {
155 56         877 push @{ $self->plugins_by_type->{GlobalOptions} }, $plugin;
  56         242  
156 56         266 my $new_opts = $plugin->install_options( spec => $self );
157 56 50       149 if ($new_opts) {
158 56   50     127 $options ||= [];
159              
160 56         149 for my $opt (@$new_opts) {
161 56         336 $opt = App::Spec::Option->build(%$opt);
162 56 50   103   500 unless (any { $_->name eq $opt->name } @$options) {
  103         399  
163 56         316 push @$options, $opt;
164             }
165             }
166              
167             }
168             }
169              
170             }
171             }
172             }
173              
174              
175             1;
176              
177             __END__