view release on metacpan or  search on metacpan

t/lib/Test/DocKnot/Spin.pm  view on Meta::CPAN

# Helper functions for testing spin.
#
# SPDX-License-Identifier: MIT

##############################################################################
# Modules and declarations
##############################################################################

package Test::DocKnot::Spin v3.0.0;

use 5.024;
use autodie;
use warnings;

use Cwd qw(getcwd);
use Encode qw(encode);
use Exporter qw(import);
use File::Compare qw(compare);
use File::Find qw(find);
use Path::Iterator::Rule ();
use Path::Tiny qw(path);
use Test::RRA qw(is_file_contents);
use YAML::XS ();

use Test::More;

our @EXPORT_OK = qw(fix_pointers is_spin_output is_spin_output_tree);

##############################################################################
# Test functions
##############################################################################

# Replace pointers in a spin input tree containing relative paths with
# absolute paths.  This is used after copying an input tree to a temporary
# directory when it contains references to other files in the same source
# tree.  Fix permissions as we go to allow writes since when building a
# distribution the original file may be read-only.
#
# $tree - Path::Tiny pointing to a tree of files containing pointers
# $base - Base path of the original input tree as a Path::Tiny object
sub fix_pointers {
    my ($tree, $base) = @_;
    my $rule = Path::Iterator::Rule->new()->name('*.spin')->file();
    my $iter = $rule->iter("$tree", { follow_symlinks => 0 });
    while (defined(my $file = $iter->())) {
        chmod(0644, $file);
        my $data_ref = YAML::XS::LoadFile($file);
        my $path = path($data_ref->{path});
        my $top = path($file)->parent()->relative($tree)->absolute($base);
        $data_ref->{path} = $path->absolute($top)->realpath()->stringify();
        YAML::XS::DumpFile($file, $data_ref);
    }
    return;
}

# Compare an output file with expected file contents, with modifications for
# things that are expected to vary on each run, such as timestamps and version
# numbers.
#
# $output_file - The file of spin output
# $expected    - The expected output
# $message     - The descriptive message of the test
sub is_spin_output {
    my ($output_file, $expected, $message) = @_;
    my $results = path($output_file)->slurp_utf8();

    # Map dates to %DATE% and ignore the different output when the
    # modification date is the same as the generation date.
    $results =~ s{
        [ ] \d{4}-\d\d-\d\d (?: [ ] \d\d:\d\d:\d\d [ ] -0000 )?
    }{ %DATE%}gxms;
    $results =~ s{
        \w{3}, [ ] \d\d [ ] \w{3} [ ] \d{4} [ ] \d\d:\d\d:\d\d [ ] [-+]\d{4}
    }{%DATE%}gxms;
    $results =~ s{
        Last [ ] modified [ ] \w+ [ ] \d{1,2}, [ ] \d{4}
    }{Last modified %DATE%}gxms;
    $results =~ s{
        Last [ ] modified [ ] and \s+ (<a[^>]+>spun</a>) [ ] [%]DATE[%]
    }{Last $1\n  %DATE% from thread modified %DATE%}gxms;
    $results =~ s{
        %DATE% [ ] from [ ] (Markdown|POD) [ ] modified [ ] %DATE%
    }{%DATE% from thread modified %DATE%}gxms;
    $results =~ s{
        (<guid [ ] isPermaLink="false">) \d+ (</guid>)
    }{$1%DATE%$2}gxms;

    # Map the DocKnot version number to %VERSION%.
    $results =~ s{ DocKnot [ ] v? [\d.]+ }{DocKnot %VERSION%}xmsg;

    # Check the results against the expected file.
    is_file_contents(encode('utf-8', $results), $expected, $message);
    return;
}

# Compare a spin output tree with an expected output tree, with the same
# modification logic as is_spin_output.
#
# $output   - The output tree
# $expected - The expected output tree
# $message  - The descriptive message for the test
#
# Returns: The number of tests run.
sub is_spin_output_tree {
    my ($output, $expected, $message) = @_;
    my (%seen, @missing);