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