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.010; 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 = '10.03'; 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 || $line =~ $REGEX_VERSION_OLD) { 107 my ($prefix, $version, $suffix) = ($1, $2, $3); 108 close($data) or die "$0: error reading from $file: $!\n"; 109 return $version; 110 } 111 } 112 close($data) or die "$0: error reading from $file: $!\n"; 113 die "$0: cannot find version number in $file\n"; 114} 115 116# Given a module file and the new version for that module, update the version 117# in that module to the new one. 118# 119# $file - Perl module file whose version should be updated 120# $version - The new version number 121# 122# Returns: undef 123# Throws: Text exception on I/O failure or inability to find version 124sub _update_module_version { 125 my ($file, $version) = @_; 126 127 # The old-style syntax may require different quoting. If the version 128 # starts with v, use it without quotes. Otherwise, quote it to prevent 129 # removal of trailing zeroes. 130 my $old_version = $version; 131 if ($old_version !~ m{ \A v }xms) { 132 $old_version = "'$old_version'"; 133 } 134 135 # Scan for the version and replace it. 136 open(my $in, q{<}, $file) or die "$0: cannot open $file: $!\n"; 137 open(my $out, q{>}, "$file.new") 138 or die "$0: cannot create $file.new: $!\n"; 139 SCAN: 140 while (defined(my $line = <$in>)) { 141 if ($line =~ s{ $REGEX_VERSION_PACKAGE }{$1$version$3}xms 142 || $line =~ s{ $REGEX_VERSION_OLD }{$1$old_version$3}xms) 143 { 144 print {$out} $line or die "$0: cannot write to $file.new: $!\n"; 145 last SCAN; 146 } 147 print {$out} $line or die "$0: cannot write to $file.new: $!\n"; 148 } 149 150 # Copy the rest of the input file to the output file. 151 print {$out} <$in> or die "$0: cannot write to $file.new: $!\n"; 152 close($out) or die "$0: cannot flush $file.new: $!\n"; 153 close($in) or die "$0: error reading from $file: $!\n"; 154 155 # All done. Rename the new file over top of the old file. 156 rename("$file.new", $file) 157 or die "$0: cannot rename $file.new to $file: $!\n"; 158 return; 159} 160 161# Act as a test suite. Find all of the Perl modules under the provided root, 162# if any, and check that the version for each module matches the version. 163# Reports results with Test::More and sets up a plan based on the number of 164# modules found. 165# 166# $root - Directory under which to look for Perl modules 167# $version - The version all those modules should have 168# 169# Returns: undef 170# Throws: Text exception on fatal errors 171sub test_module_versions { 172 my ($root, $version) = @_; 173 my @modules = _module_files($root); 174 175 # Output the plan. Skip the test if there were no modules found. 176 if (@modules) { 177 plan tests => scalar(@modules); 178 } else { 179 plan skip_all => 'No Perl modules found'; 180 return; 181 } 182 183 # For each module, get the module version and compare. 184 for my $module (@modules) { 185 my $module_version = _module_version($module); 186 is($module_version, $version, "Version for $module"); 187 } 188 return; 189} 190 191# Update the versions of all modules to the current distribution version. 192# 193# $root - Directory under which to look for Perl modules 194# $version - The version all those modules should have 195# 196# Returns: undef 197# Throws: Text exception on fatal errors 198sub update_module_versions { 199 my ($root, $version) = @_; 200 my @modules = _module_files($root); 201 for my $module (@modules) { 202 _update_module_version($module, $version); 203 } 204 return; 205} 206 2071; 208__END__ 209 210=for stopwords 211Allbery sublicense MERCHANTABILITY NONINFRINGEMENT rra-c-util versioning 212 213=head1 NAME 214 215Test::RRA::ModuleVersion - Check Perl module versions for consistency 216 217=head1 SYNOPSIS 218 219 use Test::RRA::ModuleVersion 220 qw(test_module_versions update_module_versions); 221 222 # Ensure all modules under perl/lib have a version of 3.12. 223 test_module_versions('perl/lib', '3.12'); 224 225 # Update the version of those modules to 3.12. 226 update_module_versions('perl/lib', 3.12'); 227 228=head1 DESCRIPTION 229 230This module provides functions to test and update the versions of Perl 231modules. It helps with enforcing consistency of versioning across all modules 232in a Perl distribution or embedded in a larger project containing non-Perl 233code. The calling script provides the version with which to be consistent 234and the root directory under which modules are found. 235 236=head1 FUNCTIONS 237 238None of these functions are imported by default. The ones used by a script 239should be explicitly imported. 240 241=over 4 242 243=item test_module_versions(ROOT, VERSION) 244 245Tests the version of all Perl modules under ROOT to ensure they match VERSION, 246reporting the results with Test::More. If the test configuration loaded by 247Test::RRA::Config contains a @MODULE_VERSION_EXCLUDE variable, the module 248files listed there will be ignored for this test. This function also sets up 249a plan based on the number of modules, so should be the only testing function 250called in a test script. 251 252=item update_module_versions(ROOT, VERSION) 253 254Update the version of all Perl modules found under ROOT to VERSION, except for 255any listed in a @MODULE_VERSION_EXCLUDE variable set in the test configuration 256loaded by Test::RRA::Config. 257 258=back 259 260=head1 AUTHOR 261 262Russ Allbery <eagle@eyrie.org> 263 264=head1 COPYRIGHT AND LICENSE 265 266Copyright 2016, 2018-2020, 2022 Russ Allbery <eagle@eyrie.org> 267 268Permission is hereby granted, free of charge, to any person obtaining a copy 269of this software and associated documentation files (the "Software"), to deal 270in the Software without restriction, including without limitation the rights 271to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 272copies of the Software, and to permit persons to whom the Software is 273furnished to do so, subject to the following conditions: 274 275The above copyright notice and this permission notice shall be included in all 276copies or substantial portions of the Software. 277 278THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 279IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 280FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 281AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 282LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 283OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 284SOFTWARE. 285 286=head1 SEE ALSO 287 288Test::More(3), Test::RRA::Config(3) 289 290This module is maintained in the rra-c-util package. The current version 291is available from L<https://www.eyrie.org/~eagle/software/rra-c-util/>. 292 293=cut 294 295# Local Variables: 296# copyright-at-end-flag: t 297# End: 298