The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- cperl -*-

use warnings FATAL => qw(all);

use ExtUtils::testlib;
use Test::More tests => 63;
use Test::Differences;
use Test::Memory::Cycle;
use Config::Model;
use Storable qw/dclone/;

use strict;

my $arg = shift || '';

my $trace = $arg =~ /t/ ? 1 : 0;
Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;

use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init( $arg =~ /l/ ? $TRACE : $WARN );

ok( 1, "Compilation done" );

my @m1 = qw/A1 B1/;
my @m2 = qw/A2 B2 C2/;
my @m3 = qw/A3 B3/;
my @rules;

foreach my $c1 (@m1) {
    foreach my $c2 (@m2) {
        foreach my $c3 (@m3) {
            push @rules, [ $c1, $c2, $c3 ], { default => "m$c1$c2$c3" };
        }
    }
}

#use Data::Dumper; print Dumper \@rules ;

# minimal set up to get things working
my $model = Config::Model->new( legacy => 'ignore', );
my $model_data = {
    name      => 'Master',
    'element' => [
        macro1 => {
            type       => 'leaf',
            value_type => 'enum',
            choice     => \@m1
        },
        macro2 => {
            type       => 'leaf',
            value_type => 'enum',
            choice     => \@m2
        },
        macro3 => {
            type       => 'leaf',
            value_type => 'enum',
            choice     => \@m3
        },
        m1 => {
            type       => 'leaf',
            value_type => 'string',
            'warp'     => {
                follow => [ '- macro1', ' - macro2', '- macro3' ],
                rules  => \@rules
            }
        },
        'm2' => {
            type       => 'leaf',
            value_type => 'string',
            default    => 'unsatisfied',
            'warp'     => {
                follow  => [ '- macro1', ' - macro2', '- macro3' ],
                'rules' => [
                    [ 'A1', 'A2', 'A3' ] => { default => '3xA' },
                    [ 'B1', [ 'B2', 'C2' ], 'B3' ] => { default => '3x[BC]' },
                ]
            },
        },
        'm3' => {
            type       => 'leaf',
            value_type => 'string',
            default    => 'unsatisfied',
            'warp'     => {
                follow  => '- macro2',
                'rules' => [
                    [ 'B2', 'A2' ] => { default => 'A2 B2 rule' },
                    'C2' => { default => 'C2 rule' },
                ]
            },
        },
        'm4' => {
            type       => 'leaf',
            value_type => 'string',
            default    => 'unsatisfied',
            'warp'     => {
                follow => {
                    m1 => '- macro1',
                    m2 => ' - macro2',
                    m3 => '- macro3'
                },
                'rules' => [
                    '$m1 eq "A1" and $m2 eq "A2" and $m3 eq "A3"' => { default => '3xA' },
                    '($m1 eq "B1") and ($m2 eq "B2" or $m2 eq "C2") and ($m3 eq "B3")' =>
                        { default => '3x[BC]' },
                ]
            },
        },
    ] };

my $copy = dclone $model_data ;

$model->create_config_class(%$copy);

my $inst = $model->instance(
    root_class_name => 'Master',
    instance_name   => 'test1'
);
ok( $inst, "created dummy instance" );

my $root = $inst->config_root;

use Config::Model::Warper;

eq_or_diff( [ Config::Model::Warper::_dclone_key('foo') ],
    ['foo'], "Test _dclone_key (single key)" );

#use Devel::TraceCalls;
#trace_calls {Class => "Config::Model::Value",};
#trace_calls {Class => "Config::Model::WarpedThing",};

foreach my $c1 (@m1) {
    ok( $root->load("macro1=$c1"), "Setting Root macro1 to $c1" );
    foreach my $c2 (@m2) {
        ok( $root->load("macro2=$c2"), "Setting Root macro2 to $c2" );
        foreach my $c3 (@m3) {
            ok( $root->load("macro3=$c3"), "Setting Root macro3 to $c3" );

            my $vm1 = $root->grab_value('m1');
            is( $vm1, "m$c1$c2$c3", "Reading Root slot m1: $vm1" );

            my $index = "$c1$c2$c3";
            my $m2_val =
                  $index eq 'A1A2A3'    ? '3xA'
                : $index =~ /B1[BC]2B3/ ? '3x[BC]'
                :                         'unsatisfied';
            is( $root->grab_value('m2'), $m2_val, "Reading Root slot m2" );
            is( $root->grab_value('m4'), $m2_val, "Reading Root slot m4" );
        }
    }
}

my @test =
    ( [ "macro2=A2", "A2 B2 rule" ], [ "macro2=C2", "C2 rule" ], [ "macro2=B2", "A2 B2 rule" ], );

foreach my $u_test (@test) {
    my ( $load, $exp ) = @$u_test;
    $root->load($load);
    is( $root->grab_value('m3'), $exp, "test m3 with $load" );
}

memory_cycle_ok($model);