view release on metacpan or  search on metacpan

lib/Config/Model/Tester.pm  view on Meta::CPAN

#
# This file is part of Config-Model-Tester
#
# This software is Copyright (c) 2013-2020, 2026 by Dominique Dumont.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
package Config::Model::Tester 4.010;
# ABSTRACT: Test framework for Config::Model

use warnings;
use strict;
use locale;
use utf8;
use v5.20;

use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;

use Test::More;
use Log::Log4perl 1.11 qw(:easy :levels);
use Path::Tiny;
use File::Copy::Recursive qw(fcopy rcopy dircopy);

use Test::Warn;
use Test::Exception;
use Test::File::Contents ;
use Test::Differences;
use Test::Memory::Cycle ;

use Config::Model::Tester::Setup qw/init_test setup_test_dir/;

# use eval so this module does not have a "hard" dependency on Config::Model
# This way, Config::Model can build-depend on Config::Model::Tester without
# creating a build dependency loop.
eval {
    require Config::Model;
    require Config::Model::Lister;
    require Config::Model::Value;
    require Config::Model::BackendMgr;
} ;

## no critic (Modules::ProhibitAutomaticExportation)
use vars qw/@ISA @EXPORT/;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(run_tests);

$File::Copy::Recursive::DirPerms = oct(755);

sub setup_test {
    my ( $test_group, $t_name, $wr_root, $trace, $test_suite_data, $t_data ) = @_;

    # cleanup before tests
    $wr_root->remove_tree();
    $wr_root->mkpath( { mode => oct(755) } );
    my ($conf_dir, $conf_file_name, $home_for_test)
        = @$test_suite_data{qw/conf_dir conf_file_name home_for_test/};

    if ($conf_dir and $home_for_test) {
        $conf_dir =~ s!~/!$home_for_test/!;
        $test_suite_data->{conf_dir} = $conf_dir;
    }

    my $wr_dir    = $wr_root->child($test_group)->child('test-' . $t_name);
    my $wr_dir2   = $wr_root->child($test_group)->child('test-' . $t_name.'-w');
    $wr_dir->mkpath;
    $wr_dir2->mkpath;

    my $conf_file ;
    $conf_file = $wr_dir->child($conf_dir,$conf_file_name)
        if $conf_dir and $conf_file_name;

    my $ex_dir = $t_data->{data_from_group} // $test_group;
    my $ex_path = path('t')->child('model_tests.d', "$ex_dir-examples");
    my $ex_data = $ex_path->child($t_data->{data_from} // $t_name);

    my @file_list;

    if (my $setup = $t_data->{setup}) {
        foreach my $file (keys %$setup) {
            my $map = $setup->{$file} ;
            my $destination_str
                = ref ($map) eq 'HASH' ? $map->{$^O} // $map->{default}
                : ref ($map) eq 'ARRAY' ? $map->[-1]
                :                        $map;
            if (not defined $destination_str) {