File Coverage

blib/lib/Dist/Zilla/Role/MetaProvider/Provider.pm
Criterion Covered Total %
statement 86 86 100.0
branch 18 22 81.8
condition 8 9 88.8
subroutine 11 11 100.0
pod 1 1 100.0
total 124 129 96.1


line stmt bran cond sub pod time code
1 8     8   1463151 use 5.006;
  8         20  
2 8     8   29 use strict;
  8         10  
  8         169  
3 8     8   25 use warnings;
  8         9  
  8         499  
4              
5             package Dist::Zilla::Role::MetaProvider::Provider;
6              
7             our $VERSION = '2.002002'; # TRIAL
8              
9             # ABSTRACT: A Role for Metadata providers specific to the 'provider' key.
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 8     8   394 use Moose::Role qw( with requires has around );
  8         288336  
  8         48  
14 8     8   23189 use MooseX::Types::Moose qw( Bool );
  8         38642  
  8         87  
15 8     8   25299 use namespace::autoclean;
  8         13  
  8         61  
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35             with 'Dist::Zilla::Role::MetaProvider';
36              
37              
38              
39              
40              
41              
42              
43              
44             requires 'provides';
45              
46              
47              
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66              
67              
68             has inherit_version => (
69             is => 'ro',
70             isa => Bool,
71             default => 1,
72             documentation => 'Whether or not to treat the global version as an authority',
73             );
74              
75              
76              
77              
78              
79              
80              
81              
82              
83              
84              
85              
86              
87              
88              
89              
90              
91              
92              
93              
94              
95              
96             has inherit_missing => (
97             is => 'ro',
98             isa => Bool,
99             default => 1,
100             documentation => <<'DOC',
101             How to behave when we are trusting modules to have versions and one is missing one
102             DOC
103             );
104              
105              
106              
107              
108              
109              
110              
111              
112              
113              
114              
115              
116              
117              
118              
119              
120              
121              
122              
123              
124              
125              
126             has meta_noindex => (
127             is => 'ro',
128             isa => Bool,
129             default => 1,
130             documentation => <<'DOC',
131             Scan for the meta_noindex metadata key and do not add provides records for things in it
132             DOC
133             );
134              
135              
136              
137              
138              
139              
140              
141              
142              
143              
144              
145              
146              
147              
148              
149              
150              
151              
152              
153             sub _resolve_version {
154 19     19   143738 my $self = shift;
155 19         20 my $version = shift;
156 19 100 100     601 if ( $self->inherit_version
      66        
157             or ( $self->inherit_missing and not defined $version ) )
158             {
159 16         411 return ( 'version', $self->zilla->version );
160             }
161 3 100       8 if ( not defined $version ) {
162 1         4 return ();
163             }
164 2         10 return ( 'version', $version );
165             }
166              
167              
168              
169              
170              
171              
172              
173              
174              
175              
176              
177              
178              
179              
180              
181             sub _try_regen_metadata {
182 7     7   85900 my ($self) = @_;
183              
184 7         11 my $meta = {};
185              
186 7         12 for my $plugin ( @{ $self->zilla->plugins } ) {
  7         164  
187 85 100       1237 next unless $plugin->isa('Dist::Zilla::Plugin::MetaNoIndex');
188 4         1128 require Hash::Merge::Simple;
189 4         797 $meta = Hash::Merge::Simple::merge( $meta, $plugin->metadata );
190             }
191 7         18 return $meta;
192             }
193              
194              
195              
196              
197              
198              
199              
200              
201              
202              
203              
204              
205              
206             sub _apply_meta_noindex {
207 6     6   240 my ( $self, @items ) = @_;
208              
209             # meta_noindex application is disabled
210 6 100       213 if ( not $self->meta_noindex ) {
211 1         10 return @items;
212             }
213              
214 5         18 my $meta = $self->_try_regen_metadata;
215              
216 5 100 100     7 if ( not keys %{$meta} or not exists $meta->{no_index} ) {
217 4         110 $self->log_debug( q{No no_index attribute found while trying to apply meta_noindex for} . $self->plugin_name );
218 4         1305 return @items;
219             }
220             else {
221 1         6 $self->log_debug(q{no_index found in metadata, will apply rules});
222             }
223              
224             my $noindex = {
225              
226             # defaults
227             file => [],
228             package => [],
229             namespace => [],
230             dir => [],
231 1         73 %{ $meta->{'no_index'} },
  1         7  
232             };
233 1 50       6 $noindex->{dir} = $noindex->{directory} if exists $noindex->{directory};
234              
235 1         1 for my $file ( @{ $noindex->{file} } ) {
  1         3  
236 1         1 @items = grep { $_->file ne $file } @items;
  12         338  
237             }
238 1         2 for my $module ( @{ $noindex->{'package'} } ) {
  1         3  
239 1         2 @items = grep { $_->module ne $module } @items;
  11         304  
240             }
241 1         2 for my $dir ( @{ $noindex->{'dir'} } ) {
  1         2  
242             ## no critic (RegularExpressions ProhibitPunctuationVars)
243 2         3 @items = grep { $_->file !~ qr{^\Q$dir\E($|/)} } @items;
  18         504  
244             }
245 1         2 for my $namespace ( @{ $noindex->{'namespace'} } ) {
  1         3  
246             ## no critic (RegularExpressions ProhibitPunctuationVars)
247 1         2 @items = grep { $_->module !~ qr{^\Q$namespace\E::} } @items;
  8         225  
248             }
249 1         12 return @items;
250             }
251              
252             around dump_config => sub {
253             my ( $orig, $self, @args ) = @_;
254             my $config = $orig->( $self, @args );
255             my $payload = $config->{ +__PACKAGE__ } = {};
256              
257             $payload->{inherit_version} = $self->inherit_version;
258             $payload->{inherit_missing} = $self->inherit_missing;
259             $payload->{meta_noindex} = $self->meta_noindex;
260              
261             $payload->{ q[$] . __PACKAGE__ . '::VERSION' } = $VERSION;
262             return $config;
263             };
264              
265 8     8   4595 no Moose::Role;
  8         12  
  8         40  
266              
267              
268              
269              
270              
271              
272              
273              
274             sub metadata {
275 4     4 1 3168873 my ($self) = @_;
276 4         10 my $discover = {};
277 4 50       8 my (%all_filenames) = map { $_->name => 1 } @{ $self->zilla->files || [] };
  4         164  
  4         151  
278 4         191 my (%missing_files);
279             my (%unmapped_modules);
280              
281 4         22 for my $provide_record ( $self->provides ) {
282 7         232 my $file = $provide_record->file;
283 7         211 my $module = $provide_record->module;
284              
285 7 100       17 if ( not exists $all_filenames{$file} ) {
286 4         8 $missing_files{$file} = 1;
287 4         19 $self->log_debug( 'Provides entry states missing file <' . $file . '>' );
288             }
289              
290 7         820 my $notional_filename = do { ( join q[/], split /::|'/sx, $module ) . '.pm' };
  7         39  
291 7 100       101 if ( $file !~ /\b\Q$notional_filename\E\z/sx ) {
292 5         12 $unmapped_modules{$module} = 1;
293 5         26 $self->log_debug( 'Provides entry for module <' . $module . '> mapped to problematic <' . $file . '> ( want: <.*/' . $notional_filename . '> )' );
294             }
295              
296 7         1103 $provide_record->copy_into($discover);
297             }
298              
299             ## no critic (RestrictLongStrings)
300 4 50       129 if ( my $nkeys = scalar keys %missing_files ) {
301 4         32 $self->log( "$nkeys provide map entries did not map to distfiles: " . join q[, ],
302             sort keys %missing_files );
303             }
304 4 50       819 if ( my $nkeys = scalar keys %unmapped_modules ) {
305 4         28 $self->log( "$nkeys provide map entries did not map to .pm files and may not be loadable at install time: " . join q[, ],
306             sort keys %unmapped_modules );
307             }
308 4         813 return { provides => $discover };
309             }
310              
311             1;
312              
313             __END__
314              
315             =pod
316              
317             =encoding UTF-8
318              
319             =head1 NAME
320              
321             Dist::Zilla::Role::MetaProvider::Provider - A Role for Metadata providers specific to the 'provider' key.
322              
323             =head1 VERSION
324              
325             version 2.002002
326              
327             =head1 PUBLIC METHODS
328              
329             =head2 C<metadata>
330              
331             Fulfills the requirement of L<Dist::Zilla::Role::MetaProvider> by processing
332             results returned from C<$self-E<gt>provides>.
333              
334             =head1 ATTRIBUTES / PARAMETERS
335              
336             =head2 C<inherit_version>
337              
338             This dictates how to report versions.
339              
340             =head3 values
341              
342             =over 4
343              
344             =item * Set to "1" B<[default]>
345             The version defined by L<Dist::Zilla> is the authority, and all versions
346             discovered in packages are ignored.
347              
348             =item * Set to "0"
349             The version defined in the discovered class is the authority, and it is copied
350             to the provides metadata.
351              
352             =back
353              
354             ( To use this feature in a performing class, see L</_resolve_version> )
355              
356             =head2 C<inherit_missing>
357              
358             This dictates how to react when a class is discovered but a version is not
359             specified.
360              
361             =head3 values
362              
363             =over 4
364              
365             =item * Set to "1" B<[default]>
366             C<dist.ini>'s version turns up in the final metadata.
367              
368             =item * Set to "0".
369             A C<provide> turns up in the final metadata without a version, which is permissible.
370              
371             =back
372              
373             ( To use this feature in a performing class, see L</_resolve_version> )
374              
375             =head2 C<meta_noindex>
376              
377             This dictates how to behave when a discovered class is also present in the C<no_index> META field.
378              
379             =head3 values
380              
381             =over 4
382              
383             =item * Set to "0" B<[default]>
384              
385             C<no_index> META field will be ignored
386              
387             =item * Set to "1"
388              
389             C<no_index> META field will be recognised and things found in it will cause respective packages
390             to not be provided in the metadata.
391              
392             =back
393              
394             =head1 PERFORMS ROLES
395              
396             =head2 MetaProvider
397              
398             L<Dist::Zilla::Role::MetaProvider>
399              
400             =head1 REQUIRED METHODS FOR PERFORMING ROLES
401              
402             =head2 C<provides>
403              
404             Must return an array full of L<Dist::Zilla::MetaProvides::ProvideRecord>
405             instances.
406              
407             =head1 PRIVATE METHODS
408              
409             =head2 C<_resolve_version>
410              
411             This is a utility method to make performing classes life easier in adhering to
412             user requirements.
413              
414             my $params = {
415             file => $somefile ,
416             $self->_resolve_version( $version );
417             }
418              
419             is the suggested use.
420              
421             Returns either an empty list, or a list with C<('version', $version )>;
422              
423             This is so C<{ version =E<gt> undef }> does not occur in the YAML.
424              
425             =head2 C<_try_regen_metadata>
426              
427             This is a nasty hack really, to work around the way L<< C<Dist::Zilla>|Dist::Zilla >> handles
428             metaproviders, which result in meta-data being inaccessible to metadata Plugins.
429              
430             my $meta = $object->_try_regen_metadata()
431              
432             This at present returns metadata provided by L<< C<MetaNoIndex>|Dist::Zilla::Plugin::MetaNoIndex >> ( if present )
433             but will be expanded as needed.
434              
435             If you have a module you think should be in this list, contact me, or file a bug, I'll do my best ☺
436              
437             =head2 C<_apply_meta_noindex>
438              
439             This is a utility method to make performing classes life easier in skipping no_index entries.
440              
441             my @filtered_provides = $self->_apply_meta_noindex( @provides )
442              
443             is the suggested use.
444              
445             Returns either an empty list, or a list of C<ProvideRecord>'s
446              
447             =begin MetaPOD::JSON v1.1.0
448              
449             {
450             "namespace":"Dist::Zilla::Role::MetaProvider::Provider",
451             "interface":"role",
452             "does":"Dist::Zilla::Role::MetaProvider"
453             }
454              
455              
456             =end MetaPOD::JSON
457              
458             =head1 SEE ALSO
459              
460             =over 4
461              
462             =item * L<Dist::Zilla::Role::MetaProvider>
463              
464             =item * L<Dist::Zilla::Plugin::MetaProvider>
465              
466             =item * L<Dist::Zilla::MetaProvides::ProvideRecord>
467              
468             =back
469              
470             =head1 THANKS
471              
472             =over 4
473              
474             =item * Thanks to David Golden ( xdg / DAGOLDEN ) for the suggestion of the no_index feature
475             for compatibility with MetaNoIndex plugin.
476              
477             =back
478              
479             =head1 AUTHOR
480              
481             Kent Fredric <kentnl@cpan.org>
482              
483             =head1 COPYRIGHT AND LICENSE
484              
485             This software is copyright (c) 2016 by Kent Fredric <kentfredric@gmail.com>.
486              
487             This is free software; you can redistribute it and/or modify it under
488             the same terms as the Perl 5 programming language system itself.
489              
490             =cut