File Coverage

blib/lib/Dist/Zilla/Util/BundleInfo/Plugin.pm
Criterion Covered Total %
statement 49 116 42.2
branch 7 28 25.0
condition n/a
subroutine 10 19 52.6
pod 5 5 100.0
total 71 168 42.2


line stmt bran cond sub pod time code
1 6     6   95861 use 5.006; # our
  6         17  
2 6     6   22 use strict;
  6         7  
  6         97  
3 6     6   26 use warnings;
  6         5  
  6         403  
4              
5             package Dist::Zilla::Util::BundleInfo::Plugin;
6              
7             our $VERSION = '1.001005';
8              
9             # ABSTRACT: Data about a single plugin instance in a bundle
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 6     6   1412 use Moo 1.000008 qw( has );
  6         26333  
  6         32  
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54             has name => ( is => ro =>, required => 1, );
55             has module => (
56             is => ro =>,
57             required => 1,
58             isa => sub {
59             return if defined $_[0];
60             require Carp;
61             return Carp::croak('module must be a defined value');
62             },
63             );
64             has payload => ( is => ro =>, required => 1, );
65              
66             has _loaded_module => (
67             is => ro =>,
68             lazy => 1,
69             builder => sub {
70 0     0   0 require Module::Runtime;
71 0         0 Module::Runtime::require_module( $_[0]->module );
72 0         0 return $_[0]->module;
73             },
74             );
75              
76             has _mvp_alias_rmap => (
77             is => ro =>,
78             lazy => 1,
79             builder => sub {
80 0     0   0 my ($self) = @_;
81 0 0       0 return {} unless $self->_loaded_module->can('mvp_aliases');
82 0         0 my $rmap = {};
83 0         0 my $fmap = $self->_loaded_module->mvp_aliases;
84 0         0 for my $key ( keys %{$fmap} ) {
  0         0  
85 0         0 my $value = $fmap->{$key};
86 0 0       0 $rmap->{$value} = [] if not exists $rmap->{$value};
87 0         0 push @{ $rmap->{$value} }, $key;
  0         0  
88             }
89 0         0 return $rmap;
90             },
91             );
92              
93             sub _mvp_alias_for {
94 0     0   0 my ( $self, $alias ) = @_;
95 0 0       0 return unless exists $self->_mvp_alias_rmap->{$alias};
96 0         0 return @{ $self->_mvp_alias_rmap->{$alias} };
  0         0  
97             }
98             has _mvp_multivalue_args => (
99             is => ro =>,
100             lazy => 1,
101             builder => sub {
102 0 0   0   0 return {} unless $_[0]->_loaded_module->can('mvp_multivalue_args');
103 0         0 my $map = {};
104 0         0 for my $arg ( $_[0]->_loaded_module->mvp_multivalue_args ) {
105 0         0 $map->{$arg} = 1;
106 0         0 for my $alias ( $_[0]->_mvp_alias_for($arg) ) {
107 0         0 $map->{$alias} = 1;
108             }
109             }
110 0         0 return $map;
111             },
112             );
113              
114 6     6   10377 no Moo;
  6         10  
  6         39  
115              
116             sub _property_is_mvp_multi {
117 0     0   0 my ( $self, $property ) = @_;
118 0         0 return exists $self->_mvp_multivalue_args->{$property};
119             }
120              
121              
122              
123              
124              
125              
126              
127              
128              
129              
130              
131              
132              
133              
134             sub inflate_bundle_entry {
135 33     33 1 30 my ( $self, $entry ) = @_;
136 33         24 my (%params);
137 33         22 @params{qw( name module payload )} = @{$entry};
  33         53  
138 33         51 for my $variable ( keys %params ) {
139 99 50       145 next if defined $params{$variable};
140 0         0 require Carp;
141 0         0 Carp::carp("$variable was undefined");
142             }
143 33         414 return $self->new(%params);
144             }
145              
146              
147              
148              
149              
150              
151              
152              
153              
154              
155             sub to_bundle_entry {
156 0     0 1 0 my ( $self, ) = @_;
157 0         0 return [ $self->name, $self->module, $self->payload ];
158             }
159              
160              
161              
162              
163              
164              
165              
166              
167              
168              
169              
170              
171              
172             sub short_module {
173 34     34 1 76 my ($self) = @_;
174 34         42 my $name = $self->module;
175 34 50       132 if ( $name =~ /^Dist::Zilla::Plugin::(.*$)/xsm ) {
176 34         72 return "$1";
177             }
178 0         0 return "=$name";
179             }
180              
181             sub _dzil_ini_header {
182 2     2   4 my ($self) = @_;
183 2         6 return sprintf '[%s / %s]', $self->short_module, $self->name;
184             }
185              
186             sub _dzil_config_line {
187 1     1   2 my ( undef, $name, $value ) = @_;
188 1         3 return sprintf '%s = %s', $name, $value;
189             }
190              
191             sub _dzil_config_multiline {
192 0     0   0 my ( $self, $key, @values ) = @_;
193 0 0       0 if ( not $self->_property_is_mvp_multi($key) ) {
194 0         0 require Carp;
195 0         0 Carp::carp( "$key is not an MVP multi-value for " . $self->module );
196             }
197 0         0 my @out;
198 0         0 for my $value (@values) {
199 0 0       0 if ( not ref $value ) {
200 0         0 push @out, $self->_dzil_config_line( $key, $value );
201 0         0 next;
202             }
203 0         0 require Carp;
204 0         0 Carp::croak('2 Dimensional arrays cannot be exported to distini format');
205             }
206 0         0 return @out;
207             }
208              
209             sub _autoexpand_list {
210 0     0   0 my ( $self, $key, $value ) = @_;
211 0 0       0 if ( not ref $value ) {
212 0         0 return ( $key, $value );
213             }
214 0 0       0 if ( not $self->_property_is_mvp_multi($key) ) {
215 0         0 require Carp;
216 0         0 Carp::carp( "$key is not an MVP multi-value for " . $self->module );
217             }
218 0         0 return map { ( $key, $_ ) } @{$value};
  0         0  
  0         0  
219             }
220              
221              
222              
223              
224              
225              
226              
227              
228              
229              
230              
231              
232              
233              
234              
235              
236              
237              
238              
239              
240              
241              
242              
243              
244             sub payload_list {
245 0     0 1 0 my ( $self, ) = @_;
246 0         0 my $payload = $self->payload;
247 0         0 my @out;
248 0         0 for my $key ( sort keys %{$payload} ) {
  0         0  
249 0         0 push @out, $self->_autoexpand_list( $key, $payload->{$key} );
250             }
251 0         0 return @out;
252             }
253              
254              
255              
256              
257              
258              
259              
260              
261             sub to_dist_ini {
262 2     2 1 72 my ( $self, ) = @_;
263 2         4 my @out;
264 2         7 push @out, $self->_dzil_ini_header;
265              
266 2         6 my $payload = $self->payload;
267 2         3 for my $key ( sort keys %{$payload} ) {
  2         8  
268 2         4 my $value = $payload->{$key};
269 2 50       12 if ( not ref $value ) {
270 0         0 push @out, $self->_dzil_config_line( $key, $value );
271 0         0 next;
272             }
273 2 50       6 if ( 'ARRAY' eq ref $value ) {
274 2 100       3 if ( 0 == @{$value} ) {
  2         6  
275 1         6 require Carp;
276 1         170 Carp::carp( 'Can\'t create an INI entry for an empty array attribute ( with key: ' . $key . ' )' );
277 1         42 next;
278             }
279 1 50       1 if ( 1 == @{$value} ) {
  1         2  
280 1         2 push @out, $self->_dzil_config_line( $key, @{$value} );
  1         4  
281 1         2 next;
282             }
283 0         0 push @out, $self->_dzil_config_multiline( $key, @{$value} );
  0         0  
284 0         0 next;
285             }
286 0         0 require Carp;
287 0         0 Carp::croak( 'Cannot format plugin payload of type ' . ref $value );
288             }
289 2         10 return join qq{\n}, @out, q[], q[];
290             }
291              
292             1;
293              
294             __END__
295              
296             =pod
297              
298             =encoding UTF-8
299              
300             =head1 NAME
301              
302             Dist::Zilla::Util::BundleInfo::Plugin - Data about a single plugin instance in a bundle
303              
304             =head1 VERSION
305              
306             version 1.001005
307              
308             =head1 METHODS
309              
310             =head2 C<inflate_bundle_entry>
311              
312             Creates a C<<::BundleInfo::Plugin> node based on an array-line returned from
313             C<< yourbundle->bundle_config >>.
314              
315             e.g:
316              
317             my $instance = ::Plugin->inflate_bundle_entry([
318             '@ABUNDLE/My::Name::Here', 'Fully::Qualified::Module::Name', { %config }
319             ]);
320              
321             =head2 C<to_bundle_entry>
322              
323             As with L<< C<inflate_bundle_entry>|/inflate_bundle_entry >>, except does the inverse operation,
324             turning an object into an array to pass to C<Dist::Zilla>
325              
326             my $line = $instance->to_bundle_entry;
327              
328             =head2 C<short_module>
329              
330             Returns the "short" form of the module name.
331              
332             This is basically the inverse of Dist::Zillas plugin name expansion
333             routine
334              
335             Dist::Zilla::Plugin::Foo -> Foo
336             Non::Dist::Zilla::Plugin::Foo -> =Non::Dist::Zilla::Plugin::Foo
337              
338             =head2 C<payload_list>
339              
340             Returns the payload in "expanded" form.
341              
342             Internally, payloads are stored as:
343              
344             {
345             key_a => value_0,
346             key_b => [ value_1, value_2, value_3 ],
347             }
348              
349             And this is optimal for coding.
350              
351             This method returns them in an order more amenable for C<INI> injection.
352              
353             ( 'key_a', value_0,
354             'key_b', value_1,
355             'key_b', value_2,
356             'key_b', value_3,
357             )
358              
359             =head2 C<to_dist_ini>
360              
361             Returns a copy of this C<plugin> in a textual form suitable for injecting into
362             a C<dist.ini>
363              
364             =head1 ATTRIBUTES
365              
366             =head2 C<name>
367              
368             The "name" property of the plugin.
369              
370             e.g:
371              
372             [ Foo / Bar ] ; My name is Bar
373              
374             =head2 C<module>
375              
376             The "module" property of the plugin.
377              
378             e.g.:
379              
380             [ Foo / Bar ] ; My module is Dist::Zilla::Plugin::Bar
381              
382             =head2 C<payload>
383              
384             The "payload" property of the plugin
385             that will be passed during C<register_compontent>
386              
387             =begin MetaPOD::JSON v1.1.0
388              
389             {
390             "namespace":"Dist::Zilla::Util::BundleInfo::Plugin",
391             "interface":"class",
392             "inherits":"Moo::Object"
393             }
394              
395              
396             =end MetaPOD::JSON
397              
398             =head1 AUTHOR
399              
400             Kent Fredric <kentnl@cpan.org>
401              
402             =head1 COPYRIGHT AND LICENSE
403              
404             This software is copyright (c) 2017 by Kent Fredric <kentfredric@gmail.com>.
405              
406             This is free software; you can redistribute it and/or modify it under
407             the same terms as the Perl 5 programming language system itself.
408              
409             =cut