File Coverage

blib/lib/Test/Dist/VersionSync.pm
Criterion Covered Total %
statement 76 76 100.0
branch 20 26 76.9
condition 12 20 60.0
subroutine 10 10 100.0
pod 1 1 100.0
total 119 133 89.4


line stmt bran cond sub pod time code
1             package Test::Dist::VersionSync;
2              
3 9     9   144405 use strict;
  9         21  
  9         307  
4 9     9   46 use warnings;
  9         17  
  9         237  
5              
6 9     9   12818 use Data::Dumper;
  9         109998  
  9         733  
7 9     9   9256 use Test::More;
  9         85213  
  9         91  
8              
9              
10             =head1 NAME
11              
12             Test::Dist::VersionSync - Verify that all the modules in a distribution have the same version number.
13              
14              
15             =head1 VERSION
16              
17             Version 1.1.3
18              
19             =cut
20              
21             our $VERSION = '1.1.3';
22              
23              
24             =head1 SYNOPSIS
25              
26             use Test::Dist::VersionSync;
27             Test::Dist::VersionSync::ok_versions();
28              
29              
30             =head1 USE AS A TEST FILE
31              
32             The most common use should be to add a module_versions.t file to your tests directory for a given distribution, with the following content:
33              
34             #!perl -T
35              
36             use strict;
37             use warnings;
38              
39             use Test::More;
40              
41             # Ensure a recent version of Test::Dist::VersionSync
42             my $version_min = '1.0.1';
43             eval "use Test::Dist::VersionSync $version_min";
44             plan( skip_all => "Test::Dist::VersionSync $version_min required for testing module versions in the distribution." )
45             if $@;
46              
47             Test::Dist::VersionSync::ok_versions();
48              
49             =head1 FUNCTIONS
50              
51             =head2 ok_versions()
52              
53             Verify that all the Perl modules in the distribution have the same version
54             number.
55              
56             # Default, use MANIFEST and MANIFEST.SKIP to find out what modules exist.
57             ok_versions();
58              
59             # Optional, specify a list of modules to check for identical versions.
60             ok_versions(
61             modules =>
62             [
63             'Test::Module1',
64             'Test::Module2',
65             'Test::Module3',
66             ],
67             );
68              
69             =cut
70              
71             sub ok_versions
72             {
73 6     6 1 12688 my ( %args ) = @_;
74 6         26 my $modules = delete( $args{'modules'} );
75 6         18 my $return = 1;
76              
77             # Find out via Test::Builder if a plan has been declared, otherwise we'll
78             # declare our own.
79 6         40 my $builder = Test::More->builder();
80 6         73 my $plan_declared = $builder->has_plan();
81              
82             # If a list of files was passed, verify that the argument is an arrayref.
83             # Otherwise, load the files from MANIFEST and MANIFEST.SKIP.
84 6 100       60 if ( defined( $modules) )
85             {
86 2 50       10 Test::More::plan( tests => 3 )
87             unless $plan_declared;
88              
89 2   33     12 $return = Test::More::isa_ok(
90             $modules,
91             'ARRAY',
92             'modules list',
93             ) && $return;
94             }
95             else
96             {
97 4 50       19 Test::More::plan( tests => 5 )
98             unless $plan_declared;
99              
100 4         21 $modules = _get_modules_from_manifest();
101             }
102              
103             # If we have modules, check their versions.
104 6 100       35 SKIP:
105             {
106 6         831 Test::More::skip(
107             'No module found in the distribution.',
108             2,
109             ) if scalar( @$modules ) == 0;
110              
111 4         11 my $versions = {};
112             $return = Test::More::subtest(
113             'Retrieve versions for all modules listed.',
114             sub
115             {
116 4     4   2581 Test::More::plan( tests => scalar( @$modules ) * 2 );
117              
118 4         399 foreach my $module ( @$modules )
119             {
120 8     4   32 Test::More::use_ok( $module );
  4     4   1929  
  4         47  
  4         10  
  4         86  
  4         1440  
  4         40  
  4         9  
  4         69  
121              
122 8         2776 my $version = $module->VERSION();
123 8         55 my $version_declared = Test::More::ok(
124             defined( $version ),
125             "Module $module declares a version.",
126             );
127              
128 8         2735 $version = '(undef)'
129             unless $version_declared;
130              
131 8   100     116 $versions->{ $version } ||= [];
132 8         12 push( @{ $versions->{ $version } }, $module );
  8         39  
133             }
134             }
135 4   66     46 ) && $return;
136              
137 4         2444 my $has_only_one_version = is(
138             scalar( keys %$versions ),
139             1,
140             'The modules declare only one version.',
141             );
142 4 100       2421 diag( 'Versions and the modules they were found in: ' . Dumper( $versions ) )
143             unless $has_only_one_version;
144 4   66     574 $return = $has_only_one_version && $has_only_one_version;
145              
146             }
147              
148 6         470 return $return;
149             }
150              
151              
152             =head2 import()
153              
154             Import a test plan. This uses the regular Test::More plan options.
155              
156             use Test::Dist::VersionSync tests => 4;
157              
158             ok_versions();
159              
160             Test::Dist::VersionSync also detects if Test::More was already used with a test
161             plan declared and will piggyback on it. For example:
162              
163             use Test::More tests => 2;
164             use Test::Dist::VersionSync;
165              
166             ok( 1, 'Some Test' );
167             ok_versions();
168              
169             =cut
170              
171             sub import
172             {
173 9     9   99 my ( $self, %test_plan ) = @_;
174              
175 9 50       67 Test::More::plan( %test_plan )
176             if scalar( keys %test_plan ) != 0;
177              
178 9         270 return 1;
179             }
180              
181              
182             =begin _private
183              
184             =head1 INTERNAL FUNCTIONS
185              
186             =head2 _get_modules_from_manifest
187              
188             Retrieve an arrayref of modules using the MANIFEST file at the root of the
189             distribution. IF MANIFEST.SKIP is present, its list of exclusions is used
190             to filter out modules to verify.
191              
192             my $modules = _get_modules_from_manifest();
193              
194             =end _private
195              
196             =cut
197              
198             sub _get_modules_from_manifest
199             {
200             # Gather a list of exclusion patterns for files listed in MANIFEST.
201 6     6   5207 my $excluded_patterns;
202 6 100       97 if ( -e 'MANIFEST.SKIP' )
203             {
204 1   33     45 my $opened_manifest_skip = Test::More::ok(
205             open( my $MANIFESTSKIP, '<', 'MANIFEST.SKIP' ),
206             'Retrieve MANIFEST.SKIP file.',
207             ) || diag( "Failed to open < MANIFEST.SKIP file: $!." );
208              
209 1 50       549 if ( $opened_manifest_skip )
210             {
211 1         3 my $exclusions = [];
212 1         21 while ( my $pattern = <$MANIFESTSKIP> )
213             {
214 3         11 chomp( $pattern );
215 3         23 push( @$exclusions, $pattern );
216             }
217 1         13 close( $MANIFESTSKIP );
218              
219 1 50       16 $excluded_patterns = '(' . join( '|', @$exclusions ) . ')'
220             if scalar( @$exclusions ) != 0;
221             }
222             }
223             else
224             {
225 5         22 Test::More::ok(
226             1,
227             'No MANIFEST.SKIP found, skipping.',
228             );
229             }
230              
231             # Make sure that there is a MANIFEST file at the root of the distribution,
232             # before we even open it.
233 6         1824 my $manifest_exists = Test::More::ok(
234             -e 'MANIFEST',
235             'The MANIFEST file is present at the root of the distribution.',
236             );
237              
238             # Retrieve the list of modules in MANIFEST.
239 6         2495 my $modules = [];
240 6 100       44 SKIP:
241             {
242 6         14 Test::More::skip(
243             'MANIFEST is missing, cannot retrieve list of files.',
244             1,
245             ) unless $manifest_exists;
246              
247 5   33     244 my $opened_manifest = Test::More::ok(
248             open( my $MANIFEST, '<', 'MANIFEST' ),
249             'Retrieve MANIFEST file.',
250             ) || diag( "Failed to open < MANIFEST file: $!." );
251              
252 5 50       2190 if ( $opened_manifest )
253             {
254 5         176 while ( my $file = <$MANIFEST> )
255             {
256 72         134 chomp( $file );
257 72 100 100     375 next if defined( $excluded_patterns ) && $file =~ /$excluded_patterns/;
258 70 100       421 next unless $file =~ m/^lib[\\\/](.*)\.pm$/;
259              
260 10         38 my $module = $1;
261 10         39 $module =~ s/[\\\/]/::/g;
262 10         60 push( @$modules, $module );
263             }
264 5         84 close( $MANIFEST );
265             }
266             }
267              
268 6         173 return $modules;
269             }
270              
271              
272             =head1 BUGS
273              
274             Please report any bugs or feature requests through the web interface at
275             L.
276             I will be notified, and then you'll automatically be notified of progress on
277             your bug as I make changes.
278              
279              
280             =head1 SUPPORT
281              
282             You can find documentation for this module with the perldoc command.
283              
284             perldoc Test::Dist::VersionSync
285              
286              
287             You can also look for information at:
288              
289             =over
290              
291             =item * GitHub's request tracker
292              
293             L
294              
295             =item * AnnoCPAN: Annotated CPAN documentation
296              
297             L
298              
299             =item * CPAN Ratings
300              
301             L
302              
303             =item * MetaCPAN
304              
305             L
306              
307             =back
308              
309              
310             =head1 AUTHOR
311              
312             L,
313             C<< >>.
314              
315              
316             =head1 COPYRIGHT & LICENSE
317              
318             Copyright 2012-2014 Guillaume Aubert.
319              
320             This program is free software: you can redistribute it and/or modify it under
321             the terms of the GNU General Public License version 3 as published by the Free
322             Software Foundation.
323              
324             This program is distributed in the hope that it will be useful, but WITHOUT ANY
325             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
326             PARTICULAR PURPOSE. See the GNU General Public License for more details.
327              
328             You should have received a copy of the GNU General Public License along with
329             this program. If not, see http://www.gnu.org/licenses/
330              
331             =cut
332              
333             1;