File Coverage

blib/lib/MooseX/App/Exporter.pm
Criterion Covered Total %
statement 127 135 94.0
branch 22 34 64.7
condition 9 15 60.0
subroutine 23 26 88.4
pod 0 13 0.0
total 181 223 81.1


line stmt bran cond sub pod time code
1             # ============================================================================
2             package MooseX::App::Exporter;
3             # ============================================================================
4              
5 15     15   346 use 5.010;
  15         54  
6 15     15   85 use utf8;
  15         31  
  15         106  
7 15     15   432 use strict;
  15         30  
  15         337  
8 15     15   78 use warnings;
  15         113  
  15         515  
9              
10 15     15   100 use Moose::Exporter;
  15         30  
  15         106  
11 15     15   8112 use MooseX::App::Utils;
  15         53  
  15         827  
12 15     15   8188 use MooseX::App::ParsedArgv;
  15         68  
  15         829  
13 15     15   155 use List::Util qw(first);
  15         39  
  15         26211  
14              
15             my %PLUGIN_SPEC;
16              
17             sub import {
18 36     36   6063 my ( $class, @imports ) = @_;
19              
20 36         154 my $caller_class = caller();
21              
22 36         1190 my $caller_stash = Package::Stash->new($caller_class);
23 36         241 my $exporter_stash = Package::Stash->new(__PACKAGE__);
24              
25 36         182 foreach my $import (@imports) {
26 246         1228 my $symbol = $exporter_stash->get_symbol('&'.$import);
27 246 50       664 Carp::confess(sprintf('Symbol %s not defined in %s',$import,__PACKAGE__))
28             unless defined $symbol;
29 246         1613 $caller_stash->add_symbol('&'.$import, $symbol);
30             }
31              
32 36         1408 return;
33             }
34              
35             sub parameter {
36 15     15 0 24203 my ($meta,$name,@rest) = @_;
37 15         51 return _handle_attribute($meta,$name,'parameter',@rest);
38             }
39              
40             sub option {
41 102     102 0 123177 my ($meta,$name,@rest) = @_;
42 102         397 return _handle_attribute($meta,$name,'option',@rest);
43             }
44              
45             sub _handle_attribute {
46 117     117   407 my ($meta,$name,$type,@rest) = @_;
47              
48 117 50       475 Moose->throw_error('Usage: option \'name\' => ( key => value, ... )')
49             if @rest % 2 == 1;
50              
51 117         233 my %info;
52 117         425 @info{qw(package file line)} = caller(2);
53              
54 117         3327 my %attributes = ( definition_context => \%info, @rest );
55 117 100       493 my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
56              
57             # We are in a command class
58 117 100 100     1176 if (! $meta->isa('Moose::Meta::Role')
59             && $meta->meta->does_role('MooseX::App::Meta::Role::Class::Command')) {
60              
61             # Get required extra traits for this class on first attrubute
62 88 100       30512 unless ($meta->has_app_attribute_metaroles) {
63             # Find MooseX::App::Meta::Role::Class::Base in ISA
64 28         162 foreach my $parent ($meta->linearized_isa) {
65 91 50       25198 if ($parent->meta->does_role('MooseX::App::Meta::Role::Class::Base')) {
66 0         0 $meta->app_attribute_metaroles([]);
67 0         0 last;
68             }
69             }
70             # Apply missing meta roles if required to do so
71 28 50       4513 unless ($meta->has_app_attribute_metaroles) {
72 28         82 my @extra_classes;
73 28         104 my $name = $meta->name;
74 28         127 foreach my $class (keys %PLUGIN_SPEC) {
75 31         235 my @commands = $class->meta->command_classes;
76 31 100   90   293 if (first { $name eq $_ } @commands) {
  90         219  
77 28         108 my $attribute_metaclass = $class->meta->attribute_metaclass;
78             push @extra_classes,
79 4         24 map { $_->name }
80 34         248 grep { $_->name ne 'MooseX::App::Meta::Role::Attribute::Option' }
81 36         194 grep { ! $_->isa('Moose::Meta::Role::Composite') }
82             map {
83 28 100       642 $_->isa('Moose::Meta::Role::Composite') ?
  32         6391  
84             $_->calculate_all_roles : $_
85             }
86             $attribute_metaclass->meta->calculate_all_roles_with_inheritance;
87             }
88             }
89              
90 28         1404 $meta->app_attribute_metaroles_add(@extra_classes);
91             }
92             }
93              
94 88   50     612 $attributes{traits} ||= [];
95 88         153 push(@{$attributes{traits}},$meta->app_attribute_metaroles_uniq);
  88         3981  
96             }
97              
98 117         13466 $attributes{'cmd_type'} = $type;
99             # Loop all attributes and check attribute traits
100 117         292 foreach my $attr (@$attrs) {
101 119         5109 my %local_attributes = %attributes;
102 119 100       466 if ($attr =~ m/^\+(.+)/) {
103 1         11 my $meta_attribute = $meta->find_attribute_by_name($1);
104 1 50       75 unless ($meta_attribute->does('MooseX::App::Meta::Role::Attribute::Option')) {
105 1   50     126 $local_attributes{traits} ||= [];
106 1         4 push @{$local_attributes{traits}},'MooseX::App::Meta::Role::Attribute::Option'
107 0 0   0   0 unless (first { $_ eq 'AppOption' || $_ eq 'MooseX::App::Meta::Role::Attribute::Option' }
108 1 50       7 @{$local_attributes{traits}});
  1         8  
109             }
110             }
111              
112 119         646 $meta->add_attribute($attr, %local_attributes);
113             }
114              
115 117         412167 return;
116             }
117              
118             sub app_prefer_commandline($) {
119 4     4 0 73 my ( $meta, $value ) = @_;
120 4         156 return $meta->app_prefer_commandline($value);
121             }
122              
123             sub app_strict($) {
124 4     4 0 18257 my ( $meta, $value ) = @_;
125 4         207 return $meta->app_strict($value);
126             }
127              
128             sub app_fuzzy($) {
129 1     1 0 5230 my ( $meta, $value ) = @_;
130 1         80 return $meta->app_fuzzy($value);
131             }
132              
133             sub app_permute($) {
134 3     3 0 13518 my ( $meta, $value ) = @_;
135 3         147 return $meta->app_permute($value);
136             }
137              
138             sub app_base($) {
139 3     3 0 52 my ( $meta, $name ) = @_;
140 3         113 return $meta->app_base($name);
141             }
142              
143             sub process_plugins {
144 17     17 0 67 my ($self,$caller_class,@plugins) = @_;
145              
146             # Loop all requested plugins
147 17         41 my @plugin_classes;
148 17         57 foreach my $plugin (@plugins) {
149 15         54 my $plugin_class = 'MooseX::App::Plugin::'.$plugin;
150              
151             # TODO eval plugin class
152 15         149 Class::Load::load_class($plugin_class);
153              
154 15         522 push (@plugin_classes,$plugin_class);
155             }
156              
157             # Store plugin spec
158 17         81 $PLUGIN_SPEC{$caller_class} = \@plugin_classes;
159 17         67 return;
160             }
161              
162             sub process_init_meta {
163 17     17 0 93 my ($self,%args) = @_;
164              
165 17         135 Moose->init_meta( %args );
166              
167 17   50     63031 my $plugins = $PLUGIN_SPEC{$args{for_class}} || [];
168 17   50     89 my $apply_metaroles = delete $args{metaroles} || {};
169 17   50     76 my $apply_roles = delete $args{roles} || [];
170              
171             # Add plugin roles
172 17         60 foreach my $plugin (@$plugins) {
173 15         35 push(@{$apply_roles},$plugin,{ -excludes => [ 'plugin_metaroles' ] } )
  15         77  
174             }
175              
176             # Add common role
177 17         67 push(@{$apply_roles},'MooseX::App::Role::Common')
178 17 50   47   96 unless first { $_ eq 'MooseX::App::Role::Common' } @{$apply_roles};
  47         135  
  17         503  
179              
180             # Process all plugins in the given order
181 17         67 foreach my $plugin_class (@{$plugins}) {
  17         56  
182 15 50       402 if ($plugin_class->can('plugin_metaroles')) {
183 15         138 my ($metaroles) = $plugin_class->plugin_metaroles($args{for_class});
184 15 50       75 if (ref $metaroles eq 'HASH') {
185 15         62 foreach my $type (keys %$metaroles) {
186 19   50     70 $apply_metaroles->{$type} ||= [];
187 19         38 push (@{$apply_metaroles->{$type}},@{$metaroles->{$type}});
  19         48  
  19         80  
188             }
189             }
190             }
191             }
192              
193             # Add meta roles
194             Moose::Util::MetaRole::apply_metaroles(
195             for => $args{for_class},
196 17         144 class_metaroles => $apply_metaroles
197             );
198              
199             # Add class roles
200 17         38100 Moose::Util::apply_all_roles($args{for_class},@{$apply_roles});
  17         166  
201              
202             # Init plugins
203 17         21338 foreach my $plugin_class (@{$plugins}) {
  17         75  
204 15 50       171 if ($plugin_class->can('init_plugin')) {
205 0         0 $plugin_class->init_plugin($args{for_class});
206             }
207             }
208              
209             # Return meta
210 17         122 my $meta = $args{for_class}->meta;
211              
212 17         515 return $meta;
213             }
214              
215             sub command_short_description($) {
216 18     18 0 473 my ( $meta, $description ) = @_;
217 18         804 return $meta->command_short_description($description);
218             }
219              
220             sub command_long_description($) {
221 10     10 0 15486 my ( $meta, $description ) = @_;
222 10         425 return $meta->command_long_description($description);
223             }
224              
225             sub command_usage($) {
226 0     0 0   my ( $meta, $usage ) = @_;
227 0           return $meta->command_usage($usage);
228             }
229              
230             *app_description = \&command_long_description;
231             *app_usage = \&command_usage;
232              
233             sub command_strict($) {
234 0     0 0   my ( $meta, $value ) = @_;
235 0           return $meta->command_strict($value);
236             }
237              
238             1;