File Coverage

blib/lib/Dist/Zilla/Plugin/VerifyPhases.pm
Criterion Covered Total %
statement 143 144 99.3
branch 34 38 89.4
condition 15 24 62.5
subroutine 24 24 100.0
pod 0 10 0.0
total 216 240 90.0


line stmt bran cond sub pod time code
1 7     7   17644049 use strict;
  7         18  
  7         244  
2 7     7   39 use warnings;
  7         16  
  7         450  
3             package Dist::Zilla::Plugin::VerifyPhases; # git description: v0.015-3-g33016d6
4             # vim: set ts=8 sts=4 sw=4 tw=115 et :
5             # ABSTRACT: Compare data and files at different phases of the distribution build process
6             # KEYWORDS: plugin distribution configuration phase verification validation
7              
8             our $VERSION = '0.016';
9              
10 7     7   38 use Moose;
  7         15  
  7         63  
11             with
12             'Dist::Zilla::Role::BeforeBuild',
13             'Dist::Zilla::Role::FileGatherer',
14             'Dist::Zilla::Role::EncodingProvider',
15             'Dist::Zilla::Role::FilePruner',
16             'Dist::Zilla::Role::FileMunger',
17             'Dist::Zilla::Role::AfterBuild',
18             'Dist::Zilla::Role::BeforeRelease',
19             'Dist::Zilla::Role::Releaser',
20             'Dist::Zilla::Role::AfterRelease';
21 7     7   44206 use Moose::Util 'find_meta';
  7         20  
  7         51  
22 7     7   1476 use Digest::MD5 'md5_hex';
  7         16  
  7         497  
23 7     7   41 use List::Util 1.33 qw(none any);
  7         176  
  7         418  
24 7     7   1855 use Term::ANSIColor 3.00 'colored';
  7         16381  
  7         1244  
25 7     7   52 use Storable 'dclone';
  7         24  
  7         330  
26 7     7   3301 use Test::Deep::NoTest qw(cmp_details deep_diag);
  7         1153  
  7         30  
27 7     7   1304 use namespace::autoclean;
  7         16  
  7         67  
28              
29             # filename => [ { object => $file_object, content => $checksummed_content } ]
30             my %all_files;
31              
32             # returns the filename and index under which the provided file can be found
33             sub _search_all_files
34             {
35 28     28   77 my ($self, $file) = @_;
36              
37 28         91 for my $filename (keys %all_files)
38             {
39 46         75 foreach my $index (0 .. $#{$all_files{$filename}})
  46         140  
40             {
41 36 100       185 return ($filename, $index) if $all_files{$filename}[$index]{object} == $file;
42             }
43             }
44             }
45              
46             #sub mvp_multivalue_args { qw(skip) }
47             has skip_file => (
48             isa => 'ArrayRef[Str]',
49             traits => [ 'Array' ],
50             handles => { skip_file => 'elements' },
51             init_arg => undef, # do not allow in configs just yet
52             lazy => 1,
53             default => sub { [ qw(Makefile.PL Build.PL) ] },
54             );
55              
56             has skip_distmeta => (
57             isa => 'ArrayRef[Str]',
58             traits => [ 'Array' ],
59             handles => { skip_distmeta => 'elements' },
60             init_arg => undef, # do not allow in configs just yet
61             lazy => 1,
62             default => sub { [ qw(x_static_install) ] },
63             );
64              
65             my %zilla_constructor_args;
66              
67             sub BUILD
68             {
69 8     8 0 100222 my $self = shift;
70 8         235 my $zilla = $self->zilla;
71 8         89 my $meta = find_meta($zilla);
72              
73             # no phases have been run yet, so we can effectively capture the initial
74             # state of the zilla object (and determine its construction args)
75             %zilla_constructor_args = map {
76 8         103 my $attr = $meta->find_attribute_by_name($_);
  80         6421  
77 80 100 66     5676 $attr && $attr->has_value($zilla) ? ( $_ => $attr->get_value($zilla) ) : ()
78             } qw(name version release_status abstract main_module authors distmeta _license_class _copyright_holder _copyright_year);
79             }
80              
81             # no reason to include configs - this plugin does not alter the build output
82             around dump_config => sub
83             {
84             my ($orig, $self) = @_;
85             my $config = $self->$orig;
86              
87             my $data = {
88             blessed($self) ne __PACKAGE__ ? ( version => $VERSION ) : (),
89             };
90             $config->{+__PACKAGE__} = $data if keys %$data;
91              
92             return $config;
93             };
94              
95             sub before_build
96             {
97 8     8 0 460456 my $self = shift;
98              
99             # adjust plugin order so that we are always last!
100 8         330 my $plugins = $self->zilla->plugins;
101 8         246 @$plugins = ((grep { $_ != $self } @$plugins), $self);
  99         208  
102              
103 8         55 $self->log_debug('---- this is the last before_build plugin ----');
104             }
105              
106             sub gather_files
107             {
108 8     8 0 87827 my $self = shift;
109              
110 8         231 my $zilla = $self->zilla;
111 8         96 my $meta = find_meta($zilla);
112              
113 8         122 foreach my $attr_name (qw(name version release_status abstract main_module authors distmeta))
114             {
115 56 100       2814 next if exists $zilla_constructor_args{$attr_name};
116 35         130 my $attr = $meta->find_attribute_by_name($attr_name);
117 35 100 66     2674 $self->_alert($attr_name . ' has already been calculated by end of file gathering phase')
118             if $attr and $attr->has_value($zilla);
119             }
120              
121             # license is created from some private attrs, which may have been provided
122             # at construction time
123             $self->_alert('license has already been calculated by end of file gathering phase')
124             if any {
125 22 100   22   198 not exists $zilla_constructor_args{$_}
126             and $meta->find_attribute_by_name($_)->has_value($zilla)
127 8 100       576 } qw(_license_class _copyright_holder _copyright_year);
128              
129             # all files should have been added by now. save their filenames/objects
130 8         1051 foreach my $file (@{$zilla->files})
  8         214  
131             {
132 11         239 push @{ $all_files{$file->name} }, {
  11         42  
133             object => $file,
134             # encoding can change; don't bother capturing it yet
135             # content can change; don't bother capturing it yet
136             };
137             }
138              
139 8         475 $self->log_debug('---- this is the last gather_files plugin ----');
140             }
141              
142             # since last phase,
143             # new files added: not ok
144             # files removed: not ok
145             # files renamed: not ok
146             # encoding changed: ok to now; no from now on
147             # contents: ignore
148             sub set_file_encodings
149             {
150 8     8 0 13787 my $self = shift;
151              
152             # since the encoding attribute is SetOnce, if we force all the builders to
153             # fire now, we can guarantee they won't change later
154 8         20 foreach my $file (@{$self->zilla->files})
  8         194  
155             {
156 11         270 foreach my $entry (@{ $all_files{$file->name} })
  11         44  
157             {
158 13 100       783 $entry->{encoding} = $file->encoding if $entry->{object} eq $file;
159             }
160             }
161              
162 8         217 $self->log_debug('---- this is the last set_file_encodings plugin ----');
163             }
164              
165             # since last phase,
166             # new files added: not ok
167             # files removed: ok to now; not ok from now on
168             # files renamed: not ok
169             # encoding changed: not ok
170             # contents: ignore
171             sub prune_files
172             {
173 8     8 0 14638 my $self = shift;
174              
175             # remove all still-existing files from our tracking list
176 8         22 foreach my $file (@{$self->zilla->files})
  8         194  
177             {
178 10         224 my ($filename, $index) = $self->_search_all_files($file);
179 10 50 33     64 if ($filename and defined $index)
180             {
181             # file has been renamed - an odd time to do this
182 10 50       41 $self->_alert('file has been renamed after file gathering phase: \'' . $file->name
183             . "' (originally '$filename', " . $file->added_by . ')')
184             if $filename ne $file->name;
185              
186 10         436 splice @{ $all_files{$filename} }, $index, 1;
  10         29  
187 10         36 next;
188             }
189              
190 0         0 $self->_alert('file has been added after file gathering phase: \'' . $file->name
191             . '\' (' . $file->added_by . ')');
192             }
193              
194             # anything left over has been removed, but this is okay by a file pruner
195              
196             # capture full file list all over again.
197 8         77 %all_files = ();
198 8         29 foreach my $file (@{$self->zilla->files})
  8         191  
199             {
200 10         381 push @{ $all_files{$file->name} }, {
  10         34  
201             object => $file,
202             encoding => $file->encoding,
203             content => undef, # content can change; don't bother capturing it yet
204             };
205             }
206              
207 8         526 $self->log_debug('---- this is the last prune_files plugin ----');
208             }
209              
210             my $distmeta;
211              
212             # since last phase,
213             # new files added: not ok
214             # files removed: not ok
215             # files renamed: allowed
216             # encoding changed: not ok
217             # record contents: ok to now; not ok from now on
218             # distmeta changed: ok to now; not ok from now on
219             # no prerequisites have been added yet
220             sub munge_files
221             {
222 7     7 0 28453 my $self = shift;
223              
224             # remove all still-existing files from our tracking list
225 7         20 foreach my $file (@{$self->zilla->files})
  7         188  
226             {
227 9         253 my ($filename, $index) = $self->_search_all_files($file);
228 9 100 66     62 if ($filename and defined $index)
229             {
230             # the file may have been renamed - but this is okay by a file munger
231 8         16 splice @{ $all_files{$filename} }, $index, 1;
  8         22  
232 8         30 next;
233             }
234              
235             # this is a new file we haven't seen before.
236 1         5 $self->_alert('file has been added after file gathering phase: \'' . $file->name
237             . '\' (' . $file->added_by . ')');
238             }
239              
240             # now report on any files added earlier that were removed.
241 7         402 foreach my $filename (keys %all_files)
242             {
243             $self->_alert('file has been removed after file pruning phase: \'' . $filename
244             . '\' (' . $_->{object}->added_by . ')')
245 9         16 foreach @{ $all_files{$filename} };
  9         57  
246             }
247              
248             # capture full file list all over again, recording contents now.
249 7         379 %all_files = ();
250 7         27 foreach my $file (@{$self->zilla->files})
  7         182  
251             {
252             # don't force FromCode files to calculate early; it might fire some
253             # lazy attributes prematurely
254 9 50       1394 push @{ $all_files{$file->name} }, {
  9         48  
255             object => $file,
256             encoding => $file->encoding,
257             content => ( $file->isa('Dist::Zilla::File::FromCode')
258             ? 'content ignored'
259             : md5_hex($file->encoded_content) ),
260             };
261             }
262              
263             # verify that nothing has tried to read the prerequisite data yet
264             # (only possible when the attribute is lazily built)
265 7         3670 my $prereq_attr = find_meta($self->zilla)->find_attribute_by_name('prereqs');
266 7 100 66     1338 $self->_alert('prereqs have already been read from after munging phase!')
267             if Dist::Zilla->VERSION >= 5.024 and $prereq_attr->has_value($self->zilla);
268              
269             # verify no prerequisites have been provided yet
270             # (it would be highly unlikely for distmeta not to be populated yet, but
271             # force it anwyay so we have something to compare to later)
272 7         882 $distmeta = dclone($self->zilla->distmeta);
273 7 100       235809 if (exists $distmeta->{prereqs})
274             {
275 1         633 require Data::Dumper;
276             $self->_alert('prereqs have been improperly included with distribution metadata:',
277 1         4782 Data::Dumper->new([ $distmeta->{prereqs} ])->Indent(2)->Terse(1)->Sortkeys(1)->Dump,
278             );
279 1         401 delete $distmeta->{prereqs};
280             }
281              
282 7         60 $self->log_debug('---- this is the last munge_files plugin ----');
283             }
284              
285             # since last phase,
286             # new files added: not ok
287             # files removed: not ok
288             # files renamed: not ok
289             # change contents: not ok
290             # distmeta has not changed
291             sub after_build
292             {
293 7     7 0 93543 my $self = shift;
294              
295 7         20 foreach my $file (@{$self->zilla->files})
  7         209  
296             {
297 9         338 my ($filename, $index) = $self->_search_all_files($file);
298 9 100 66     76 if (not $filename or not defined $index)
299             {
300 1         4 $self->_alert('file has been added after file gathering phase: \'' . $file->name
301             . '\' (' . $file->added_by . ')');
302 1         340 next;
303             }
304              
305 8 100       34 if ($filename ne $file->name)
306             {
307 1         41 $self->_alert('file has been renamed after munging phase: \'' . $file->name
308             . "' (originally '$filename', " . $file->added_by . ')');
309 1         382 splice @{ $all_files{$filename} }, $index, 1;
  1         3  
310 1         5 next;
311             }
312              
313             # we give FromCode files a bye, since there is a good reason why their
314             # content at file munging time is incomplete
315             $self->_alert('content has changed after munging phase: \'' . $file->name
316             # this looks suspicious; we ought to have separate added_by,
317             # changed_by attributes
318             . '\' (' . $file->added_by . ')')
319             if not $file->isa('Dist::Zilla::File::FromCode')
320 13     13   372 and none { $file->name eq $_ } $self->skip_file
321 7 50 66     711 and $all_files{$file->name}[$index]{content} ne md5_hex($file->encoded_content);
      66        
322              
323 7         1047 delete $all_files{$file->name};
324             }
325              
326 7         278 foreach my $filename (keys %all_files)
327             {
328             $self->_alert('file has been removed after file pruning phase: \'' . $filename
329             . '\' (' . $_->{object}->added_by . ')')
330 2         330 foreach @{ $all_files{$filename} };
  2         38  
331             }
332              
333             # check distmeta, minus prereqs
334 7         182 my $new_distmeta = dclone($self->zilla->distmeta);
335 7         635 delete $new_distmeta->{prereqs};
336 7         312 foreach my $ignore_key ($self->skip_distmeta)
337             {
338 7         50 $distmeta->{$ignore_key} = Test::Deep::ignore;
339 7 100       8095 delete $distmeta->{$ignore_key} if not exists $new_distmeta->{$ignore_key};
340             }
341 7         41 my ($ok, $stack) = cmp_details($new_distmeta, $distmeta);
342 7 100       95031 if (not $ok)
343             {
344 1         4 chomp(my $error = deep_diag($stack));
345 1         124 $self->_alert('distribution metadata has been altered after munging phase!', $error);
346             }
347              
348 7         439 $self->log_debug('---- this is the last after_build plugin ----');
349             }
350              
351             sub before_release {
352 2     2 0 110024 shift->log_debug('---- this is the last before_release plugin ----');
353             }
354              
355             sub release
356             {
357 2     2 0 885 my $self = shift;
358              
359             # perform the check that we just neutered in Dist::Zilla::Dist::Builder::release
360             Carp::croak("you can't release without any Releaser plugins")
361 2 100       8 if @{ $self->zilla->plugins_with(-Releaser) } <= 1;
  2         70  
362              
363 1         1918 $self->log_debug('---- this is the last release plugin ----');
364             }
365              
366             sub after_release {
367 1     1 0 1940 shift->log_debug('---- this is the last after_release plugin ----');
368             }
369              
370             sub _alert
371             {
372 16     16   938 my $self = shift;
373 16         86 $self->log(colored(join(' ', @_), 'bright_red'));
374             }
375              
376             1;
377              
378             __END__
379              
380             =pod
381              
382             =encoding UTF-8
383              
384             =head1 NAME
385              
386             Dist::Zilla::Plugin::VerifyPhases - Compare data and files at different phases of the distribution build process
387              
388             =head1 VERSION
389              
390             version 0.016
391              
392             =head1 SYNOPSIS
393              
394             At the end of your F<dist.ini>:
395              
396             [VerifyPhases]
397              
398             =head1 DESCRIPTION
399              
400             This plugin runs in multiple L<Dist::Zilla> phases to check what actions have
401             taken place so far. Its intent is to find any plugins that are performing
402             actions outside the appropriate phase, so they can be fixed.
403              
404             Running at the end of the C<-FileGatherer> phase, it verifies that the
405             following distribution properties have not yet been populated/calculated, as
406             they usually depend on having the full complement of files added to the
407             distribution, with known encodings:
408              
409             =over 4
410              
411             =item *
412              
413             name
414              
415             =item *
416              
417             version
418              
419             =item *
420              
421             release_status
422              
423             =item *
424              
425             abstract
426              
427             =item *
428              
429             main_module
430              
431             =item *
432              
433             license
434              
435             =item *
436              
437             authors
438              
439             =item *
440              
441             metadata
442              
443             =back
444              
445             Running at the end of the C<-EncodingProvider> phase, it forces all encodings
446             to be built (by calling their lazy builders), to use their C<SetOnce> property
447             to ensure that no subsequent phase attempts to alter a file encoding.
448              
449             Running at the end of the C<-FilePruner> phase, it verifies that no additional
450             files have been added to the distribution, nor renamed, since the
451             C<-FileGatherer> phase.
452              
453             Running at the end of the C<-FileMunger> phase, it verifies that no additional
454             files have been added to nor removed from the distribution, nor renamed, since
455             the C<-FilePruner> phase; and that no prerequisites have yet been provided.
456             Additionally, it verifies that the prerequisite list has not yet been read
457             from, when possible.
458              
459             Running at the end of the C<-AfterBuild> phase, the full state of all files
460             are checked: files may not be added, removed, renamed nor had their content
461             change. Additionally, it verifies that no distribution metadata (with the
462             exception of prerequisites) has changed since the end of the C<-FileMunger>
463             phase.
464              
465             =for stopwords FromCode
466              
467             Currently, L<FromCode|Dist::Zilla::File::FromCode> files are not checked for
468             content, as interesting side effects can occur if their content subs are run
469             before all content is available (for example, other lazy builders can run too
470             early, resulting in incomplete or missing data).
471              
472             =for Pod::Coverage BUILD before_build gather_files set_file_encodings prune_files munge_files after_build
473             before_release release after_release
474              
475             =head1 SEE ALSO
476              
477             =over 4
478              
479             =item *
480              
481             L<Dist::Zilla::Plugin::ReportPhase>
482              
483             =item *
484              
485             L<Dist::Zilla::App::Command::dumpphases>
486              
487             =back
488              
489             =head1 SUPPORT
490              
491             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Dist-Zilla-Plugin-VerifyPhases>
492             (or L<bug-Dist-Zilla-Plugin-VerifyPhases@rt.cpan.org|mailto:bug-Dist-Zilla-Plugin-VerifyPhases@rt.cpan.org>).
493              
494             There is also a mailing list available for users of this distribution, at
495             L<http://dzil.org/#mailing-list>.
496              
497             There is also an irc channel available for users of this distribution, at
498             L<C<#distzilla> on C<irc.perl.org>|irc://irc.perl.org/#distzilla>.
499              
500             I am also usually active on irc, as 'ether' at C<irc.perl.org>.
501              
502             =head1 AUTHOR
503              
504             Karen Etheridge <ether@cpan.org>
505              
506             =head1 COPYRIGHT AND LICENCE
507              
508             This software is copyright (c) 2014 by Karen Etheridge.
509              
510             This is free software; you can redistribute it and/or modify it under
511             the same terms as the Perl 5 programming language system itself.
512              
513             =cut