1# Check Perl module versions for consistency. 2# 3# This module contains the common code for testing and updating Perl module 4# versions for consistency within a Perl module distribution and within a 5# larger package that contains both Perl modules and other code. 6# 7# SPDX-License-Identifier: MIT 8 9package Test::RRA::ModuleVersion; 10 11use 5.008; 12use base qw(Exporter); 13use strict; 14use warnings; 15 16use File::Find qw(find); 17use Test::More; 18use Test::RRA::Config qw(@MODULE_VERSION_IGNORE); 19 20# Declare variables that should be set in BEGIN for robustness. 21our (@EXPORT_OK, $VERSION); 22 23# Set $VERSION and everything export-related in a BEGIN block for robustness 24# against circular module loading (not that we load any modules, but 25# consistency is good). 26BEGIN { 27 @EXPORT_OK = qw(test_module_versions update_module_versions); 28 29 # This version should match the corresponding rra-c-util release, but with 30 # two digits for the minor version, including a leading zero if necessary, 31 # so that it will sort properly. 32 $VERSION = '8.01'; 33} 34 35# A regular expression matching the version string for a module using the 36# package syntax from Perl 5.12 and later. $1 will contain all of the line 37# contents prior to the actual version string, $2 will contain the version 38# itself, and $3 will contain the rest of the line. 39our $REGEX_VERSION_PACKAGE = qr{ 40 ( # prefix ($1) 41 \A \s* # whitespace 42 package \s+ # package keyword 43 [\w\:\']+ \s+ # package name 44 ) 45 ( v? [\d._]+ ) # the version number itself ($2) 46 ( # suffix ($3) 47 \s* ; 48 ) 49}xms; 50 51# A regular expression matching a $VERSION string in a module. $1 will 52# contain all of the line contents prior to the actual version string, $2 will 53# contain the version itself, and $3 will contain the rest of the line. 54our $REGEX_VERSION_OLD = qr{ 55 ( # prefix ($1) 56 \A .* # any prefix, such as "our" 57 [\$*] # scalar or typeglob 58 [\w\:\']*\b # optional package name 59 VERSION\b # version variable 60 \s* = \s* # assignment 61 ) 62 [\"\']? # optional leading quote 63 ( v? [\d._]+ ) # the version number itself ($2) 64 [\"\']? # optional trailing quote 65 ( # suffix ($3) 66 \s* 67 ; 68 ) 69}xms; 70 71# Find all the Perl modules shipped in this package, if any, and returns the 72# list of file names. 73# 74# $dir - The root directory to search 75# 76# Returns: List of file names 77sub _module_files { 78 my ($dir) = @_; 79 return if !-d $dir; 80 my @files; 81 my %ignore = map { $_ => 1 } @MODULE_VERSION_IGNORE; 82 my $wanted = sub { 83 if ($_ eq 'blib') { 84 $File::Find::prune = 1; 85 return; 86 } 87 if (m{ [.] pm \z }xms && !$ignore{$File::Find::name}) { 88 push(@files, $File::Find::name); 89 } 90 return; 91 }; 92 find($wanted, $dir); 93 return @files; 94} 95 96# Given a module file, read it for the version value and return the value. 97# 98# $file - File to check, which should be a Perl module 99# 100# Returns: The version of the module 101# Throws: Text exception on I/O failure or inability to find version 102sub _module_version { 103 my ($file) = @_; 104 open(my $data, q{<}, $file) or die "$0: cannot open $file: $!\n"; 105 while (defined(my $line = <$data>)) { 106 if ( $line =~ $REGEX_VERSION_PACKAGE 107 || $line =~ $REGEX_VERSION_OLD) 108 { 109 my ($prefix, $version, $suffix) = ($1, $2, $3); 110 close($data) or die "$0: error reading from $file: $!\n"; 111 return $version; 112 } 113 } 114 close($data) or die "$0: error reading from $file: $!\n"; 115 die "$0: cannot find version number in $file\n"; 116} 117 118# Given a module file and the new version for that module, update the version 119# in that module to the new one. 120# 121# $file - Perl module file whose version should be updated 122# $version - The new version number 123# 124# Returns: undef 125# Throws: Text exception on I/O failure or inability to find version 126sub _update_module_version { 127 my ($file, $version) = @_; 128 129 # The old-style syntax may require different quoting. If the version 130 # starts with v, use it without quotes. Otherwise, quote it to prevent 131 # removal of trailing zeroes. 132 my $old_version = $version; 133 if ($old_version !~ m{ \A v }xms) { 134 $old_version = "'$old_version'"; 135 } 136 137 # Scan for the version and replace it. 138 open(my $in, q{<}, $file) or die "$0: cannot open $file: $!\n"; 139 open(my $out, q{>}, "$file.new") 140 or die "$0: cannot create $file.new: $!\n"; 141 SCAN: 142 while (defined(my $line = <$in>)) { 143 if ( $line =~ s{ $REGEX_VERSION_PACKAGE }{$1$version$3}xms 144 || $line =~ s{ $REGEX_VERSION_OLD }{$1$old_version$3}xms) 145 { 146 print {$out} $line or die "$0: cannot write to $file.new: $!\n"; 147 last SCAN; 148 } 149 print {$out} $line or die "$0: cannot write to $file.new: $!\n"; 150 } 151 152 # Copy the rest of the input file to the output file. 153 print {$out} <$in> or die "$0: cannot write to $file.new: $!\n"; 154 close($out) or die "$0: cannot flush $file.new: $!\n"; 155 close($in) or die "$0: error reading from $file: $!\n"; 156 157 # All done. Rename the new file over top of the old file. 158 rename("$file.new", $file) 159 or die "$0: cannot rename $file.new to $file: $!\n"; 160 return; 161} 162 163# Act as a test suite. Find all of the Perl modules under the provided root, 164# if any, and check that the version for each module matches the version. 165# Reports results with Test::More and sets up a plan based on the number of 166# modules found. 167# 168# $root - Directory under which to look for Perl modules 169# $version - The version all those modules should have 170# 171# Returns: undef 172# Throws: Text exception on fatal errors 173sub test_module_versions { 174 my ($root, $version) = @_; 175 my @modules = _module_files($root); 176 177 # Output the plan. Skip the test if there were no modules found. 178 if (@modules) { 179 plan tests => scalar(@modules); 180 } else { 181 plan skip_all => 'No Perl modules found'; 182 return; 183 } 184 185 # For each module, get the module version and compare. 186 for my $module (@modules) { 187 my $module_version = _module_version($module); 188 is($module_version, $version, "Version for $module"); 189 } 190 return; 191} 192 193# Update the versions of all modules to the current distribution version. 194# 195# $root - Directory under which to look for Perl modules 196# $version - The version all those modules should have 197# 198# Returns: undef 199# Throws: Text exception on fatal errors 200sub update_module_versions { 201 my ($root, $version) = @_; 202 my @modules = _module_files($root); 203 for my $module (@modules) { 204 _update_module_version($module, $version); 205 } 206 return; 207} 208 2091; 210__END__ 211 212=for stopwords 213Allbery sublicense MERCHANTABILITY NONINFRINGEMENT rra-c-util versioning 214 215=head1 NAME 216 217Test::RRA::ModuleVersion - Check Perl module versions for consistency 218 219=head1 SYNOPSIS 220 221 use Test::RRA::ModuleVersion 222 qw(test_module_versions update_module_versions); 223 224 # Ensure all modules under perl/lib have a version of 3.12. 225 test_module_versions('perl/lib', '3.12'); 226 227 # Update the version of those modules to 3.12. 228 update_module_versions('perl/lib', 3.12'); 229 230=head1 DESCRIPTION 231 232This module provides functions to test and update the versions of Perl 233modules. It helps with enforcing consistency of versioning across all modules 234in a Perl distribution or embedded in a larger project containing non-Perl 235code. The calling script provides the version with which to be consistent 236and the root directory under which modules are found. 237 238=head1 FUNCTIONS 239 240None of these functions are imported by default. The ones used by a script 241should be explicitly imported. 242 243=over 4 244 245=item test_module_versions(ROOT, VERSION) 246 247Tests the version of all Perl modules under ROOT to ensure they match VERSION, 248reporting the results with Test::More. If the test configuration loaded by 249Test::RRA::Config contains a @MODULE_VERSION_EXCLUDE variable, the module 250files listed there will be ignored for this test. This function also sets up 251a plan based on the number of modules, so should be the only testing function 252called in a test script. 253 254=item update_module_versions(ROOT, VERSION) 255 256Update the version of all Perl modules found under ROOT to VERSION, except for 257any listed in a @MODULE_VERSION_EXCLUDE variable set in the test configuration 258loaded by Test::RRA::Config. 259 260=back 261 262=head1 AUTHOR 263 264Russ Allbery <eagle@eyrie.org> 265 266=head1 COPYRIGHT AND LICENSE 267 268Copyright 2016, 2018-2019 Russ Allbery <eagle@eyrie.org> 269 270Permission is hereby granted, free of charge, to any person obtaining a copy 271of this software and associated documentation files (the "Software"), to deal 272in the Software without restriction, including without limitation the rights 273to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 274copies of the Software, and to permit persons to whom the Software is 275furnished to do so, subject to the following conditions: 276 277The above copyright notice and this permission notice shall be included in all 278copies or substantial portions of the Software. 279 280THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 281IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 282FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 283AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 284LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 285OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 286SOFTWARE. 287 288=head1 SEE ALSO 289 290Test::More(3), Test::RRA::Config(3) 291 292This module is maintained in the rra-c-util package. The current version 293is available from L<https://www.eyrie.org/~eagle/software/rra-c-util/>. 294 295=cut 296 297# Local Variables: 298# copyright-at-end-flag: t 299# End: 300