File Coverage

blib/lib/Test/Version.pm
Criterion Covered Total %
statement 139 143 97.2
branch 71 78 91.0
condition 20 26 76.9
subroutine 13 13 100.0
pod 2 2 100.0
total 245 262 93.5


line stmt bran cond sub pod time code
1             package Test::Version;
2 19     19   1512776 use 5.006;
  19         297  
3 19     19   136 use strict;
  19         45  
  19         629  
4 19     19   134 use warnings;
  19         46  
  19         686  
5 19     19   131 use Carp;
  19         35  
  19         1869  
6              
7             our $VERSION = '2.08_02'; # TRIAL VERSION
8              
9 19     19   9721 use parent 'Exporter';
  19         6459  
  19         114  
10 19     19   1337 use Test::Builder;
  19         47  
  19         657  
11 19     19   9046 use version 0.86 qw( is_lax is_strict );
  19         39891  
  19         155  
12 19     19   12310 use File::Find::Rule::Perl;
  19         373272  
  19         240  
13 19     19   3497 use Test::More;
  19         22184  
  19         188  
14 19     19   19898 use Module::Metadata 1.000020;
  19         124199  
  19         26138  
15              
16             our @EXPORT = qw( version_all_ok ); ## no critic (Modules::ProhibitAutomaticExportation)
17             our @EXPORT_OK = qw( version_ok );
18              
19             my $cfg;
20              
21             sub import { ## no critic qw( Subroutines::RequireArgUnpacking Subroutines::RequireFinalReturn )
22 23     23   24022 my @exports;
23 23         80 foreach my $param ( @_ ) {
24 59 100       178 unless ( ref( $param ) eq 'HASH' ) {
25 40         129 push @exports, $param;
26             } else {
27 19         61 $cfg = $param
28             }
29             }
30              
31             $cfg->{is_strict}
32             = defined $cfg->{is_strict} ? $cfg->{is_strict}
33 23 100       129 : 0
34             ;
35              
36             $cfg->{has_version}
37             = defined $cfg->{has_version} ? $cfg->{has_version}
38 23 100       84 : 1
39             ;
40              
41             $cfg->{consistent}
42             = defined $cfg->{consistent} ? $cfg->{consistent}
43 23 100       90 : 0
44             ;
45              
46             $cfg->{filename_match}
47             = defined $cfg->{filename_match} ? $cfg->{filename_match}
48 23 100       96 : []
49             ;
50              
51             $cfg->{multiple}
52             = defined $cfg->{multiple} ? $cfg->{multiple}
53 23 100       80 : 0
54             ;
55              
56 23 100       128 unless(ref($cfg->{filename_match}) eq 'ARRAY') {
57 3         12 $cfg->{filename_match} = [$cfg->{filename_match}];
58             }
59              
60 23         244 my $mmv = version->parse( $Module::Metadata::VERSION );
61 23         131 my $rec = version->parse( '1.000020' );
62 23 100 66     872 if ( $mmv >= $rec && ! defined $cfg->{ignore_unindexable} ) {
63 8         22 $cfg->{ignore_unindexable} = 1;
64             }
65              
66 23         25316 __PACKAGE__->export_to_level( 1, @exports );
67             }
68              
69             my $version_counter = 0;
70             my $version_number;
71             my $consistent = 1;
72             my %versions;
73              
74             my $test = Test::Builder->new;
75              
76             our $_IN_VERSION_ALL_OK = 0;
77             our %FILE_FIND_RULE_EXTRAS = (
78             untaint => 1,
79             #
80             # the untainting pattern for Windows used by File::Find seems to be wrong.
81             #
82             # - cwd returns an absolute directory will usually return a volume (e.g. 'C:')
83             # - windows file systems frequently include directorieswith parans and spaces in them
84             # I am a little dubious that accepting them is safe. The alternative is that
85             # this module would not be installable in a lot of environments, and I honestly
86             # don't believe that many people are using Test::Version in taint mode on Windows
87             # anyway, so I am weighing the risk as worth it.
88             # - windows has short names with tildes in them (e.g. "FOO~1"). Tilde is not a
89             # special character in windows shells anyway, so I think we should be safe there.
90             #
91             ($^O eq 'MSWin32' ? (untaint_pattern => qr|^(([a-zA-Z]:)?[-+@\w./\~\(\) ]+)$|x) : ()),
92             );
93              
94              
95             sub version_ok {
96 73     73 1 40644 my ( $file, $name ) = @_;
97 73   100     446 $file ||= '';
98 73   33     691 $name ||= "check version in '$file'";
99              
100 73 100       272 croak 'No file passed to version_ok().' unless $file;
101              
102 72 100       1729 croak "'$file' doesn't exist." unless -e $file;
103              
104 71         690 my $info = Module::Metadata->new_from_file( $file );
105 71 50 66     60379 if ( $cfg->{ignore_unindexable} && ! $info->is_indexable) {
106 0         0 $test->skip( "$file not indexable" );
107 0         0 return 0;
108             }
109              
110 71 100       441 if(@{ $cfg->{filename_match} } > 0) {
  71         275  
111 12         22 my $match = 0;
112 12         20 foreach my $pattern (@{ $cfg->{filename_match} }) {
  12         31  
113              
114 12 100       40 if(ref($pattern) eq 'Regexp') {
    100          
115 3 100       19 $match = 1 if $file =~ $pattern;
116             }
117              
118             elsif(ref($pattern) eq 'CODE') {
119 3 100       10 $match = 1 if $pattern->($file);
120             }
121              
122             else {
123 6 100       23 $match = 1 if $file eq $pattern;
124             }
125              
126 12 100       46 last if $match;
127             }
128 12 100       31 unless ($match) {
129 8         87 $test->skip( "$file does not match filename_match" );
130 8         1788 return 0;
131             }
132             }
133              
134 63         134 my $ok = 1;
135 63         114 my @diag;
136 63 100       376 my @packages = $cfg->{multiple} ? $info->packages_inside : ($info->name);
137              
138 63 100       524 unless($_IN_VERSION_ALL_OK) {
139 11         29 $consistent = 1;
140 11         29 $version_number = undef;
141             }
142              
143 63 100       186 unless($cfg->{has_version}) {
144 25         69 @packages = grep { $info->version($_) } @packages;
  25         98  
145 25 100       636 unless(@packages) {
146 6         95 $test->skip(qq{No versions were found in "$file" and has_version is false});
147 6         1795 $consistent = 0;
148 6         44 $versions{$file}->{$info->name} = undef;
149 6         82 return 1;
150             }
151             }
152              
153 57 50       167 unless(@packages) {
154 0         0 $ok = 0;
155 0         0 push @diag, "No packages found in '$file'";
156             }
157              
158 57         159 foreach my $package (@packages) {
159              
160 63         258 my $version = $info->version($package);
161              
162 63         950 $versions{$file}->{$package} = $version;
163              
164 63 100       198 if (not defined $version) {
165 10         32 $consistent = 0;
166             }
167              
168 63         130 $version_counter++;
169              
170 63 100       785 unless ( $version ) {
171 10         23 $ok = 0;
172 10         66 push @diag, "No version was found in '$file' ($package).";
173 10         45 next;
174             }
175              
176 53 100       268 unless (defined $version_number) {
177 21         53 $version_number = $version;
178             }
179 53 100       301 if ($version ne $version_number) {
180 27         58 $consistent = 0;
181             }
182              
183 53 100       258 unless ( is_lax( $version ) ) {
184 3         148 $ok = 0;
185 3         31 push @diag, "The version '$version' found in '$file' ($package) is invalid.";
186 3         15 next;
187             }
188              
189 50 100       2228 if ( $cfg->{is_strict} ) {
190 1 50       4 unless ( is_strict( $version ) ) {
191 1         39 $ok = 0;
192 1         14 push @diag, "The version '$version' found in '$file' ($package) is not strict.";
193 1         6 next;
194             }
195             }
196             }
197              
198 57 100       235 unless($_IN_VERSION_ALL_OK) {
199 11 100 100     82 if($ok && ! $consistent && $cfg->{consistent}) {
      100        
200 1         3 $ok = 0;
201 1         6 push @diag, "The versions found in '$file' are inconsistent.";
202             }
203             }
204              
205 57         677 $test->ok( $ok, $name );
206 57         30961 $test->diag($_) for @diag;
207 57         2979 return $ok;
208             }
209              
210             sub version_all_ok {
211 12     12 1 3334 my ( $dir, $name ) = @_;
212              
213 12         26 $version_counter = 0;
214 12         28 $version_number = undef;
215 12         28 $consistent = 1;
216 12         41 %versions = ();
217              
218 12 0       60 $dir
    50          
219             = defined $dir ? $dir
220             : -d 'blib' ? 'blib'
221             : 'lib'
222             ;
223              
224 12 50       324 croak $dir . ' does not exist, or is not a directory' unless -d $dir;
225              
226             # Report failure location correctly - GH #1
227 12         63 local $Test::Builder::Level = $Test::Builder::Level + 1; ## no critic (Variables::ProhibitPackageVars)
228              
229 12   33     123 $name ||= "all modules in $dir have valid versions";
230              
231 12         156 my @files = File::Find::Rule->perl_module->extras(\%FILE_FIND_RULE_EXTRAS)->in($dir);
232              
233             {
234 12         23138 local $_IN_VERSION_ALL_OK = 1;
  12         44  
235 12         34 foreach my $file ( @files ) {
236 60         171 version_ok( $file );
237             }
238             }
239              
240 12 100 100     88 if ($cfg->{consistent} and not $consistent) {
241 3         27 $test->ok( 0, $name );
242 3         1180 $test->diag('The version numbers in this distribution are not the same');
243 3         415 foreach my $file (sort keys %versions) {
244 8         592 foreach my $package (sort keys %{ $versions{$file} }) {
  8         30  
245 8         19 my $version = $versions{$file}->{$package};
246 8 100       75 $test->diag(sprintf "%10s %s (%s)", defined $version ? $version : 'undef', $file, $package);
247             }
248             }
249 3         372 return;
250             }
251              
252             # has at least 1 version in the dist
253 9 100 100     50 if ( not $cfg->{has_version} and $version_counter < 1 ) {
254 1         8 $test->ok( 0, $name );
255 1         420 $test->diag(
256             'Your dist has no valid versions defined. '
257             . 'Must have at least one version'
258             );
259             }
260             else {
261 8         56 $test->ok( 1, $name );
262             }
263              
264 9         3952 return;
265             }
266             1;
267              
268             # ABSTRACT: Check to see that version's in modules are sane
269              
270             __END__