File Coverage

blib/lib/Dist/Zilla/Plugin/Test/PrereqsFromMeta.pm
Criterion Covered Total %
statement 8 16 50.0
branch 0 2 0.0
condition n/a
subroutine 3 4 75.0
pod 0 1 0.0
total 11 23 47.8


line stmt bran cond sub pod time code
1             #---------------------------------------------------------------------
2             package Dist::Zilla::Plugin::Test::PrereqsFromMeta;
3             #
4             # Copyright 2011 Christopher J. Madsen
5             #
6             # Author: Christopher J. Madsen <perl@cjmweb.net>
7             # Created: 22 Nov 2011
8             #
9             # This program is free software; you can redistribute it and/or modify
10             # it under the same terms as Perl itself.
11             #
12             # This program is distributed in the hope that it will be useful,
13             # but WITHOUT ANY WARRANTY; without even the implied warranty of
14             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the
15             # GNU General Public License or the Artistic License for more details.
16             #
17             # ABSTRACT: Check the prereqs from our META.json
18             #---------------------------------------------------------------------
19              
20 1     1   1579 use 5.008;
  1         3  
21             our $VERSION = '4.23';
22             # This file is part of Dist-Zilla-Plugins-CJM 4.27 (August 29, 2015)
23              
24              
25 1     1   6 use Moose;
  1         2  
  1         9  
26             extends 'Dist::Zilla::Plugin::InlineFiles';
27             with 'Dist::Zilla::Role::FilePruner';
28              
29             #---------------------------------------------------------------------
30             # Make sure we've included a META.json:
31              
32             sub prune_files
33             {
34 0     0 0   my $self = shift;
35              
36 0           my $files = $self->zilla->files;
37              
38 0 0         unless (grep { $_->name eq 'META.json' } @$files) {
  0            
39 0           $self->log("WARNING: META.json not found, removing t/00-all_prereqs.t");
40 0           @$files = grep { $_->name ne 't/00-all_prereqs.t' } @$files;
  0            
41             } # end unless META.json
42              
43 0           return;
44             } # end prune_files
45              
46             #---------------------------------------------------------------------
47 1     1   6236 no Moose;
  1         1  
  1         6  
48             __PACKAGE__->meta->make_immutable;
49             1;
50              
51             =head1 NAME
52              
53             Dist::Zilla::Plugin::Test::PrereqsFromMeta - Check the prereqs from our META.json
54              
55             =head1 VERSION
56              
57             This document describes version 4.23 of
58             Dist::Zilla::Plugin::Test::PrereqsFromMeta, released August 29, 2015
59             as part of Dist-Zilla-Plugins-CJM version 4.27.
60              
61             =head1 SYNOPSIS
62              
63             In your F<dist.ini>:
64              
65             [Test::PrereqsFromMeta]
66              
67             =head1 DESCRIPTION
68              
69             This plugin will inject F<t/00-all_prereqs.t> into your dist. This
70             test reads your F<META.json> file and attempts to load all runtime
71             prerequisites. It fails if any required runtime prerequisites fail to
72             load. (If the loaded version is less than the required version, it
73             prints a warning message but the test does not fail.)
74              
75             In addition, if C<AUTOMATED_TESTING> is set, it dumps out every module
76             in C<%INC> along with its version. This can help you determine the
77             cause of failures reported by CPAN Testers.
78              
79             You can also get the version dump by running F<t/00-all_prereqs.t> with
80             the C<-v> or C<--verbose> option. (This is not the same as passing
81             the C<-v> option to C<prove>.)
82              
83              
84             =for Pod::Coverage
85             prune_files
86              
87             =head1 INCOMPATIBILITIES
88              
89             None reported.
90              
91             =head1 BUGS AND LIMITATIONS
92              
93             No bugs have been reported.
94              
95             =head1 AUTHOR
96              
97             Christopher J. Madsen S<C<< <perl AT cjmweb.net> >>>
98              
99             Please report any bugs or feature requests
100             to S<C<< <bug-Dist-Zilla-Plugins-CJM AT rt.cpan.org> >>>
101             or through the web interface at
102             L<< http://rt.cpan.org/Public/Bug/Report.html?Queue=Dist-Zilla-Plugins-CJM >>.
103              
104             You can follow or contribute to Dist-Zilla-Plugins-CJM's development at
105             L<< https://github.com/madsen/dist-zilla-plugins-cjm >>.
106              
107             =head1 COPYRIGHT AND LICENSE
108              
109             This software is copyright (c) 2015 by Christopher J. Madsen.
110              
111             This is free software; you can redistribute it and/or modify it under
112             the same terms as the Perl 5 programming language system itself.
113              
114             =head1 DISCLAIMER OF WARRANTY
115              
116             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
117             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
118             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
119             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
120             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
121             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
122             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
123             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
124             NECESSARY SERVICING, REPAIR, OR CORRECTION.
125              
126             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
127             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
128             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE
129             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
130             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
131             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
132             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
133             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
134             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
135             SUCH DAMAGES.
136              
137             =cut
138              
139             __DATA__
140             ___[ t/00-all_prereqs.t ]___
141             #!perl
142              
143             use strict;
144             use warnings;
145              
146             # This doesn't use Test::More because I don't want to clutter %INC
147             # with modules that aren't prerequisites.
148              
149             my $test = 0;
150             my $tests_completed;
151              
152             sub ok ($$)
153             {
154             my ($ok, $name) = @_;
155              
156             printf "%sok %d - %s\n", ($ok ? '' : 'not '), ++$test, $name;
157              
158             return $ok;
159             } # end ok
160              
161             END {
162             ok(0, 'unknown failure') unless defined $tests_completed;
163             print "1..$tests_completed\n";
164             }
165              
166             sub get_version
167             {
168             my ($package) = @_;
169              
170             local $@;
171             my $version = eval { $package->VERSION };
172              
173             defined $version ? $version : 'undef';
174             } # end get_version
175              
176             TEST: {
177             ok(open(META, '<META.json'), 'opened META.json') or last TEST;
178              
179             while (<META>) {
180             last if /^\s*"prereqs" : \{\s*\z/;
181             } # end while <META>
182              
183             ok(defined $_, 'found prereqs') or last TEST;
184              
185             while (<META>) {
186             last if /^\s*\},?\s*\z/;
187             ok(/^\s*"(.+)" : \{\s*\z/, "found phase $1") or last TEST;
188             my $phase = $1;
189              
190             while (<META>) {
191             last if /^\s*\},?\s*\z/;
192             next if /^\s*"[^"]+"\s*:\s*\{\s*\},?\s*\z/;
193             ok(/^\s*"(.+)" : \{\s*\z/, "found relationship $phase $1") or last TEST;
194             my $rel = $1;
195              
196             while (<META>) {
197             last if /^\s*\},?\s*\z/;
198             ok(/^\s*"([^"]+)"\s*:\s*(\S+?),?\s*\z/, "found prereq $1")
199             or last TEST;
200             my ($prereq, $version) = ($1, $2);
201              
202             next if $phase ne 'runtime' or $prereq eq 'perl';
203              
204             # Need a special case for if.pm, because "require if;" is a syntax error.
205             my $loaded = ($prereq eq 'if')
206             ? eval "require '$prereq.pm'; 1"
207             : eval "require $prereq; 1";
208             if ($rel eq 'requires') {
209             ok($loaded, "loaded $prereq") or
210             print STDERR "\n# ERROR: Wanted: $prereq $version\n";
211             } else {
212             ok(1, ($loaded ? 'loaded' : 'failed to load') . " $prereq");
213             }
214             if ($loaded and not ($version eq '"0"' or
215             eval "'$prereq'->VERSION($version); 1")) {
216             printf STDERR "\n# WARNING: Got: %s %s\n# Wanted: %s %s\n",
217             $prereq, get_version($prereq), $prereq, $version;
218             }
219             } # end while <META> in prerequisites
220             } # end while <META> in relationship
221             } # end while <META> in phase
222              
223             close META;
224              
225             # Print version of all loaded modules:
226             if ($ENV{AUTOMATED_TESTING} or
227             (@ARGV and ($ARGV[0] eq '-v' or $ARGV[0] eq '--verbose'))) {
228             print STDERR "# Listing %INC\n";
229              
230             my @packages = grep { s/\.pm\Z// and do { s![\\/]!::!g; 1 } } sort keys %INC;
231              
232             my $len = 0;
233             for (@packages) { $len = length if length > $len }
234             $len = 68 if $len > 68;
235              
236             for my $package (@packages) {
237             printf STDERR "# %${len}s %s\n", $package, get_version($package);
238             }
239             } # end if AUTOMATED_TESTING
240             } # end TEST
241              
242             $tests_completed = $test;
243              
244             __END__