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 14     14   300 use 5.010;
  14         36  
6 14     14   54 use utf8;
  14         16  
  14         91  
7 14     14   248 use strict;
  14         875  
  14         231  
8 14     14   44 use warnings;
  14         14  
  14         370  
9              
10 14     14   51 use Moose::Exporter;
  14         17  
  14         111  
11 14     14   5108 use MooseX::App::Utils;
  14         43  
  14         784  
12 14     14   7291 use MooseX::App::ParsedArgv;
  14         51  
  14         1065  
13 14     14   109 use List::Util qw(first);
  14         23  
  14         18340  
14              
15             my %PLUGIN_SPEC;
16              
17             sub import {
18 35     35   3902 my ( $class, @imports ) = @_;
19              
20 35         122 my $caller_class = caller();
21              
22 35         914 my $caller_stash = Package::Stash->new($caller_class);
23 35         239 my $exporter_stash = Package::Stash->new(__PACKAGE__);
24              
25 35         93 foreach my $import (@imports) {
26 233         900 my $symbol = $exporter_stash->get_symbol('&'.$import);
27 233 50       452 Carp::confess(sprintf('Symbol %s not defined in %s',$import,__PACKAGE__))
28             unless defined $symbol;
29 233         1252 $caller_stash->add_symbol('&'.$import, $symbol);
30             }
31              
32 35         943 return;
33             }
34              
35             sub parameter {
36 15     15 0 20970 my ($meta,$name,@rest) = @_;
37 15         60 return _handle_attribute($meta,$name,'parameter',@rest);
38             }
39              
40             sub option {
41 99     99 0 83078 my ($meta,$name,@rest) = @_;
42 99         350 return _handle_attribute($meta,$name,'option',@rest);
43             }
44              
45             sub _handle_attribute {
46 114     114   284 my ($meta,$name,$type,@rest) = @_;
47              
48 114 50       454 Moose->throw_error('Usage: option \'name\' => ( key => value, ... )')
49             if @rest % 2 == 1;
50              
51 114         164 my %info;
52 114         362 @info{qw(package file line)} = caller(2);
53              
54 114         2609 my %attributes = ( definition_context => \%info, @rest );
55 114 100       438 my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
56              
57             # We are in a command class
58 114 100 100     1163 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       24652 unless ($meta->has_app_attribute_metaroles) {
63             # Find MooseX::App::Meta::Role::Class::Base in ISA
64 28         132 foreach my $parent ($meta->linearized_isa) {
65 91 50       17214 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       3244 unless ($meta->has_app_attribute_metaroles) {
72 28         58 my @extra_classes;
73 28         93 my $name = $meta->name;
74 28         247 foreach my $class (keys %PLUGIN_SPEC) {
75 31         168 my @commands = $class->meta->command_classes;
76 31 100   106   266 if (first { $name eq $_ } @commands) {
  106         142  
77 28         98 my $attribute_metaclass = $class->meta->attribute_metaclass;
78             push @extra_classes,
79 4         16 map { $_->name }
80 34         219 grep { $_->name ne 'MooseX::App::Meta::Role::Attribute::Option' }
81 36         146 grep { ! $_->isa('Moose::Meta::Role::Composite') }
82             map {
83 28 100       525 $_->isa('Moose::Meta::Role::Composite') ?
  32         4774  
84             $_->calculate_all_roles : $_
85             }
86             $attribute_metaclass->meta->calculate_all_roles_with_inheritance;
87             }
88             }
89              
90 28         1264 $meta->app_attribute_metaroles_add(@extra_classes);
91             }
92             }
93              
94 88   50     514 $attributes{traits} ||= [];
95 88         130 push(@{$attributes{traits}},$meta->app_attribute_metaroles_uniq);
  88         3735  
96             }
97              
98 114         8264 $attributes{'cmd_type'} = $type;
99             # Loop all attributes and check attribute traits
100 114         239 foreach my $attr (@$attrs) {
101 116         3546 my %local_attributes = %attributes;
102 116 100       409 if ($attr =~ m/^\+(.+)/) {
103 1         11 my $meta_attribute = $meta->find_attribute_by_name($1);
104 1 50       42 unless ($meta_attribute->does('MooseX::App::Meta::Role::Attribute::Option')) {
105 1   50     82 $local_attributes{traits} ||= [];
106 1         3 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       3 @{$local_attributes{traits}});
  1         7  
109             }
110             }
111              
112 116         533 $meta->add_attribute($attr, %local_attributes);
113             }
114              
115 114         310260 return;
116             }
117              
118             sub app_prefer_commandline($) {
119 4     4 0 39 my ( $meta, $value ) = @_;
120 4         127 return $meta->app_prefer_commandline($value);
121             }
122              
123             sub app_strict($) {
124 4     4 0 10446 my ( $meta, $value ) = @_;
125 4         157 return $meta->app_strict($value);
126             }
127              
128             sub app_fuzzy($) {
129 1     1 0 2442 my ( $meta, $value ) = @_;
130 1         39 return $meta->app_fuzzy($value);
131             }
132              
133             sub app_permute($) {
134 3     3 0 8871 my ( $meta, $value ) = @_;
135 3         160 return $meta->app_permute($value);
136             }
137              
138             sub app_base($) {
139 3     3 0 38 my ( $meta, $name ) = @_;
140 3         112 return $meta->app_base($name);
141             }
142              
143             sub process_plugins {
144 16     16 0 40 my ($self,$caller_class,@plugins) = @_;
145              
146             # Loop all requested plugins
147 16         24 my @plugin_classes;
148 16         37 foreach my $plugin (@plugins) {
149 15         58 my $plugin_class = 'MooseX::App::Plugin::'.$plugin;
150              
151             # TODO eval plugin class
152 15         69 Class::Load::load_class($plugin_class);
153              
154 15         443 push (@plugin_classes,$plugin_class);
155             }
156              
157             # Store plugin spec
158 16         54 $PLUGIN_SPEC{$caller_class} = \@plugin_classes;
159 16         62 return;
160             }
161              
162             sub process_init_meta {
163 16     16 0 59 my ($self,%args) = @_;
164              
165 16         98 Moose->init_meta( %args );
166              
167 16   50     39444 my $plugins = $PLUGIN_SPEC{$args{for_class}} || [];
168 16   50     91 my $apply_metaroles = delete $args{metaroles} || {};
169 16   50     63 my $apply_roles = delete $args{roles} || [];
170              
171             # Add plugin roles
172 16         45 foreach my $plugin (@$plugins) {
173 15         23 push(@{$apply_roles},$plugin,{ -excludes => [ 'plugin_metaroles' ] } )
  15         69  
174             }
175              
176             # Add common role
177 16         43 push(@{$apply_roles},'MooseX::App::Role::Common')
178 16 50   46   70 unless first { $_ eq 'MooseX::App::Role::Common' } @{$apply_roles};
  46         87  
  16         100  
179              
180             # Process all plugins in the given order
181 16         47 foreach my $plugin_class (@{$plugins}) {
  16         77  
182 15 50       138 if ($plugin_class->can('plugin_metaroles')) {
183 15         94 my ($metaroles) = $plugin_class->plugin_metaroles($args{for_class});
184 15 50       53 if (ref $metaroles eq 'HASH') {
185 15         40 foreach my $type (keys %$metaroles) {
186 19   50     79 $apply_metaroles->{$type} ||= [];
187 19         21 push (@{$apply_metaroles->{$type}},@{$metaroles->{$type}});
  19         33  
  19         62  
188             }
189             }
190             }
191             }
192              
193             # Add meta roles
194             Moose::Util::MetaRole::apply_metaroles(
195             for => $args{for_class},
196 16         104 class_metaroles => $apply_metaroles
197             );
198              
199             # Add class roles
200 16         26199 Moose::Util::apply_all_roles($args{for_class},@{$apply_roles});
  16         112  
201              
202             # Init plugins
203 16         15584 foreach my $plugin_class (@{$plugins}) {
  16         71  
204 15 50       182 if ($plugin_class->can('init_plugin')) {
205 0         0 $plugin_class->init_plugin($args{for_class});
206             }
207             }
208              
209             # Return meta
210 16         115 my $meta = $args{for_class}->meta;
211              
212 16         397 return $meta;
213             }
214              
215             sub command_short_description($) {
216 18     18 0 328 my ( $meta, $description ) = @_;
217 18         719 return $meta->command_short_description($description);
218             }
219              
220             sub command_long_description($) {
221 10     10 0 12700 my ( $meta, $description ) = @_;
222 10         414 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;