#!/usr/bin/perl
#
# Check or update the version of embedded Perl modules.
#
# Examines all module files (*.pm) under the perl/lib directory, if it exists,
# and verifies that their $VERSION is set to the same value as the current
# version number as determined by the NEWS file at the top level of the source
# tree (or the current directory if not being run as a test).
#
# When given the --update option, instead fixes all of the Perl modules found
# to have the correct version.

use 5.006;
use strict;
use warnings;

use Carp qw(croak);
use File::Find qw(find);
use Getopt::Long qw(GetOptions);
use Test::More;

# SOURCE may not be set if we're running this script manually to update
# version numbers.  Only load the Test::RRA modules if it is set, enabling us
# to find those modules.
BEGIN {
    if ($ENV{SOURCE}) {
        unshift(@INC, "$ENV{SOURCE}/tap/perl");
        require Test::RRA;
        require Test::RRA::Automake;
    }
}

# A regular expression matching a $VERSION string in a module.  $1 will
# contain all of the line contents prior to the actual version string, $2 will
# contain the version itself, and $3 will contain the rest of the line.
our $REGEX_VERSION = qr{
    (                           # prefix ($1)
        \A .*                   # any prefix, such as "our"
        [\$*]                   # scalar or typeglob
        [\w\:\']*\b             # optional package name
        VERSION\b               # version variable
        \s* = \s*               # assignment
        [\"\']?                 # optional leading quote
    )
    ( [\d._]+ )                 # the version number itself ($2)
    (                           # suffix ($3)
        [\"\']?                 # optional trailing quote
        \s*
        ;
    )
}xms;

# Find all the Perl modules shipped in this package, if any, and returns the
# list of file names.
#
# $dir - The root directory to search, perl/lib by default
#
# Returns: List of file names
sub module_files {
    my ($dir) = @_;
    $dir ||= 'perl/lib';
    return if !-d $dir;
    my @files;
    my $wanted = sub {
        if ($_ eq 'blib') {
            $File::Find::prune = 1;
            return;
        }
        if ($_ =~ m{ [.] pm \z }xms) {
            push(@files, $File::Find::name);
        }
        return;
    };
    find($wanted, $dir);
    return @files;
}

# Given a module file, read it for the $VERSION string and return the value.
#
# $file - File to check, which should be a Perl module
#
# Returns: The version of the module
#  Throws: Text exception on I/O failure or inability to find $VERSION
sub module_version {
    my ($file) = @_;
    open(my $data, q{<}, $file) or die "$0: cannot open $file: $!\n";
    while (defined(my $line = <$data>)) {
        if ($line =~ $REGEX_VERSION) {
            my ($prefix, $version, $suffix) = ($1, $2, $3);
            close($data) or die "$0: error reading from $file: $!\n";
            return $version;
        }
    }
    close($data) or die "$0: error reading from $file: $!\n";
    die "$0: cannot find version number in $file\n";
}

# Return the current version and, optionally, the package name from the NEWS
# file.  Munges the version to be appropriate for Perl if necessary.
#
# Returns: Scalar: The version number of the latest version in NEWS
#          List: The version number and the package name
# Throws: Text exception if NEWS is not found or doesn't contain a version
sub news_version {
    my ($package, $version);
    open(my $news, q{<}, 'NEWS') or die "$0: cannot open NEWS: $!\n";
  SCAN:
    while (defined(my $line = <$news>)) {
        ## no critic (RegularExpressions::ProhibitEscapedMetacharacters)
        if ($line =~ m{ \A ([\w\s-]+) \s ([\d.]+) \s \( }xms) {
            ($package, $version) = ($1, $2);
            last SCAN;
        }
        ## use critic
    }
    close($news) or die "$0: error reading from NEWS: $!\n";
    if (!defined($version)) {
        die "$0: cannot find version number in NEWS\n";
    }

    # Munge the version for Perl purposes by ensuring that each component
    # has two digits and by dropping the second period.
    $version =~ s{ [.] (\d) (?= [.] | \z ) }{.0$1}xmsg;
    $version =~ s{ ([.] \d+) [.] (\d+) }{$1$2}xms;

    # Return the appropriate value based on context.
    return wantarray ? ($version, $package) : $version;
}

# Given a module file and the new version for that module, update the version
# in that module to the new one.
#
# $file    - Perl module file whose version should be updated
# $version - The new version number
#
# Returns: undef
#  Throws: Text exception on I/O failure or inability to find $VERSION
sub update_module_version {
    my ($file, $version) = @_;
    open(my $in, q{<}, $file) or die "$0: cannot open $file: $!\n";
    open(my $out, q{>}, "$file.new")
      or die "$0: cannot create $file.new: $!\n";

    # Scan for the version and replace it.
  SCAN:
    while (defined(my $line = <$in>)) {
        if ($line =~ s{ $REGEX_VERSION }{$1$version$3}xms) {
            print {$out} $line or die "$0: cannot write to $file.new: $!\n";
            last SCAN;
        }
        print {$out} $line or die "$0: cannot write to $file.new: $!\n";
    }

    # Copy the rest of the input file to the output file.
    print {$out} <$in> or die "$0: cannot write to $file.new: $!\n";
    close($out) or die "$0: cannot flush $file.new: $!\n";
    close($in)  or die "$0: error reading from $file: $!\n";

    # All done.  Rename the new file over top of the old file.
    rename("$file.new", $file)
      or die "$0: cannot rename $file.new to $file: $!\n";
    return;
}

# Act as a test suite.  Find all of the Perl modules in the package, if any,
# and check that the version for each module matches the version from the NEWS
# file.  Reports results with Test::More and sets up a plan based on the
# number of modules found.
#
# Returns: undef
#  Throws: Text exception on fatal errors
sub test_versions {
    my ($news_version, $package) = news_version();

    # For rra-c-util, check the TAP modules instead of a perl directory.
    my $dir = ($package eq 'rra-c-util') ? 'tests/tap/perl' : 'perl/lib';
    my @modules = module_files($dir);

    # Output the plan.  Skip the test if there were no modules found.
    if (@modules) {
        plan tests => scalar(@modules);
    } else {
        plan skip_all => 'No Perl modules found';
        return;
    }

    # For each module, get the module version and compare.
    for my $module (@modules) {
        my $module_version = module_version($module);
        is($module_version, $news_version, "Version for $module");
    }
    return;
}

# Update the versions of all modules to the current version from the NEWS
# file.
#
# Returns: undef
#  Throws: Text exception on fatal errors
sub update_versions {
    my ($version, $package) = news_version();
    my $dir = ($package eq 'rra-c-util') ? 'tests/tap/perl' : 'perl/lib';
    my @modules = module_files($dir);
    for my $module (@modules) {
        update_module_version($module, $version);
    }
    return;
}

# If SOURCE is set, skip the test unless automated testing is enabled and use
# automake_setup to change directories to the top of the source tree.  We
# don't do this unconditionally since we want to support being run with the
# --update option outside of the test suite.
if ($ENV{SOURCE}) {
    Test::RRA::skip_unless_automated('Module version tests');
    Test::RRA::Automake::automake_setup();
}

# Main routine.  We run as either a test suite or as a script to update all of
# the module versions, selecting based on whether we got the -u / --update
# command-line option.
my $update;
Getopt::Long::config('bundling', 'no_ignore_case');
GetOptions('update|u' => \$update) or exit 1;
if ($update) {
    update_versions();
} else {
    test_versions();
}
exit 0;
__END__

=for stopwords
Allbery sublicense MERCHANTABILITY NONINFRINGEMENT rra-c-util

=head1 NAME

module-version-t - Check or update versions of embedded Perl modules

=head1 SYNOPSIS

B<module-version-t> [B<--update>]

=head1 REQUIREMENTS

Perl 5.6.2 or later.

=head1 DESCRIPTION

This script has a dual purpose as either a test script or a utility
script.  The intent is to assist with maintaining consistent versions
between a larger primarily C project and any embedded Perl modules.

As a test, it reads the current version of a package from the F<NEWS> file
and then looks for any Perl modules in F<perl/lib>.  (As a special
exception, if the package name as determined from the F<NEWS> file is
C<rra-c-util>, it looks for Perl modules in F<tests/tap/perl> instead.)
If it finds any, it checks that the version number of the Perl module
matches the version number of the package from the F<NEWS> file.  These
test results are reported with Test::More, suitable for any TAP harness.

As a utility script, when run with the B<--update> option, it similarly
finds all Perl modules in F<perl/lib> (or F<tests/tap/perl> per above) and
then rewrites their version setting to match the version of the package as
determined from the F<NEWS> file.

=head1 OPTIONS

=over 4

=item B<-u>, B<--update>

Rather than test the Perl modules for the correct version, update all
Perl modules found in the tree under F<perl/lib> to the current version
from the NEWS file.

=back

=head1 AUTHOR

Russ Allbery <eagle@eyrie.org>

=head1 COPYRIGHT AND LICENSE

Copyright 2013 The Board of Trustees of the Leland Stanford Junior
University

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.

=head1 SEE ALSO

This module is maintained in the rra-c-util package.  The current version
is available from L<http://www.eyrie.org/~eagle/software/rra-c-util/>.

=cut
