view release on metacpan or  search on metacpan

t/lib/Test/RRA/ModuleVersion.pm  view on Meta::CPAN

our $REGEX_VERSION_PACKAGE = qr{
    (                           # prefix ($1)
        \A \s*                  # whitespace
        package \s+             # package keyword
        [\w\:\']+ \s+           # package name
    )
    ( v? [\d._]+ )              # the version number itself ($2)
    (                           # suffix ($3)
        \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
#
# Returns: List of file names
sub _module_files {
    my ($dir) = @_;
    return if !-d $dir;
    my @files;
    my %ignore = map { $_ => 1 } @MODULE_VERSION_IGNORE;
    my $wanted = sub {
        if ($_ eq 'blib') {
            $File::Find::prune = 1;
            return;
        }
        if (m{ [.] pm \z }xms && !$ignore{$File::Find::name}) {
            push(@files, $File::Find::name);
        }
        return;
    };
    find($wanted, $dir);
    return @files;
}

# Given a module file, read it for the version value 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);
    while (defined(my $line = <$data>)) {
        if ($line =~ $REGEX_VERSION_PACKAGE) {
            my ($prefix, $version, $suffix) = ($1, $2, $3);
            close($data);
            return $version;
        }
    }
    close($data);
    die "$0: cannot find version number in $file\n";
}

# 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) = @_;

    # Scan for the version and replace it.
    open(my $in, q{<}, $file);
    open(my $out, q{>}, "$file.new");
  SCAN:
    while (defined(my $line = <$in>)) {
        if ($line =~ s{ $REGEX_VERSION_PACKAGE }{$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);
    close($in);

    # All done.  Rename the new file over top of the old file.
    rename("$file.new", $file);
    return;
}

# Act as a test suite.  Find all of the Perl modules under the provided root,
# if any, and check that the version for each module matches the version.
# Reports results with Test::More and sets up a plan based on the number of
# modules found.
#
# $root    - Directory under which to look for Perl modules
# $version - The version all those modules should have
#
# Returns: undef
#  Throws: Text exception on fatal errors
sub test_module_versions {
    my ($root, $version) = @_;
    my @modules = _module_files($root);

    # 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, $version, "Version for $module");
    }
    return;
}

# Update the versions of all modules to the current distribution version.