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

use ExtUtils::testlib;
use Test::Warn;
use Test::More ;
use Test::Memory::Cycle;
use Test::Exception;
use Config::Model;
use Config::Model::Tester::Setup qw/init_test/;

use strict;
use warnings;

my ($model, $trace) = init_test();

$model->create_config_class(
    name      => 'Host',
    'element' => [
        if => {
            type              => 'hash',
            index_type        => 'string',
            cargo => {
                type        => 'node',
                config_class_name => 'If'
            },
        },
        trap => {
            type       => 'leaf',
            value_type => 'string'
        }
    ]
);

$model->create_config_class(
    name    => 'If',
    element => [
        ip => {
            type       => 'leaf',
            value_type => 'string'
        }
    ]
);

$model->create_config_class(
    name    => 'Lan',
    element => [
        node => {
            type              => 'hash',
            index_type        => 'string',
            cargo => {
                type        => 'node',
                config_class_name => 'Node',
            },
        }
    ]
);

$model->create_config_class(
    name    => 'Node',
    element => [
        host => {
            type       => 'leaf',
            value_type => 'reference',
            refer_to   => '! host'
        },
        if => {
            type       => 'leaf',
            value_type => 'reference',
            computed_refer_to   => {
                formula => '  ! host:$h if ',
                variables => { h => '- host' }
            }
        },
        ip => {
            type       => 'leaf',
            value_type => 'string',
            compute    => {
                formula => '$ip',
                variables => {
                    ip   => '! host:$h if:$card ip',
                    h    => '- host',
                    card => '- if'
                }
            }
        }
    ]
);

$model->create_config_class(
    name    => 'Master',
    element => [
        host => {
            type              => 'hash',
            index_type        => 'string',
            cargo => {
                type        => 'node',
                config_class_name => 'Host'
            }
        },
        lan => {
            type              => 'hash',
            index_type        => 'string',
            cargo => {
                type        => 'node',
                config_class_name => 'Lan'
            }
        },
        host_reference => {
            type       => 'leaf',
            value_type => 'reference',
            refer_to   => '! host ',
        },
        host_and_choice => {
            type       => 'leaf',
            value_type => 'reference',
            refer_to   => '! host ',
            choice     => [qw/foo bar/]
        },
        host_and_replace => {
            type       => 'leaf',
            value_type => 'reference',
            refer_to   => '! host ',
            replace => { 'fou' => 'Foo', 'barre' => 'Bar' },
        },
        dumb_list => {
            type       => 'list',
            cargo => {
                type => 'leaf',
                value_type => 'string'
            }
        },
        refer_to_list_enum => {
            type       => 'leaf',
            value_type => 'reference',
            refer_to   => '- dumb_list',
        },

        refer_to_wrong_path => {
            type       => 'leaf',
            value_type => 'reference',
            refer_to   => '! unknown_class unknown_elt',
        },

        refer_to_unknown_elt => {
            type       => 'leaf',
            value_type => 'reference',
            refer_to   => '! unknown_elt',
        },
    ] );

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

my $root = $inst->config_root;

ok( $root, "Created Root" );

$root->load(
    ' host:A if:eth0 ip=10.0.0.1 -
        if:eth1 ip=10.0.1.1 - -
 host:B if:eth0 ip=10.0.0.2 -
        if:eth1 ip=10.0.1.2 - - '
);

ok( 1, "host setup done" );

my $node = $root->grab('lan:A node:1');
ok( $node, "got lan:A node:1" . $node->name );

$node->load('host=A');

is( $node->grab_value('host'), 'A', "setup host=A" );

$node->load('if=eth0');

is( $node->grab_value('if'), 'eth0', "set up if=eth0 " );

# magic

is( $node->grab_value('ip'), '10.0.0.1', "got ip 10.0.0.1" );

$root->load(
    ' lan:A node:2 host=B if=eth0  - -
  lan:B node:1 host=A if=eth1  -
           node:2 host=B if=eth1  - -

'
);

ok( 1, "lan setup done" );

is( $root->grab_value('lan:A node:1 ip'), '10.0.0.1', "got ip 10.0.0.1" );
is( $root->grab_value('lan:A node:2 ip'), '10.0.0.2', "got ip 10.0.0.2" );
is( $root->grab_value('lan:B node:1 ip'), '10.0.1.1', "got ip 10.0.1.1" );
is( $root->grab_value('lan:B node:2 ip'), '10.0.1.2', "got ip 10.0.1.2" );

#print distill_root( object => $root );
#print dump_root( object => $root );

my $hac = $root->fetch_element('host_and_choice');
is_deeply(
    [ $hac->get_choice ],
    [ 'A', 'B', 'bar', 'foo' ],
    "check that default choice and refer_to add up"
);

# choice needs to be recomputed for references
$root->load("host~B");
is_deeply(
    [ $hac->get_choice ],
    [ 'A', 'bar', 'foo' ],
    "check that default choice and refer_to follow removed elements"
);

# test reference to list values
$root->load("dumb_list=a,b,c,d,e");

my $rtle = $root->fetch_element("refer_to_list_enum");
is_deeply( [ $rtle->get_choice ], [qw/a b c d e/], "check choice of refer_to_list_enum" );

throws_ok { $root->fetch_element("refer_to_wrong_path"); } 'Config::Model::Exception::Model',"fetching refer_to_wrong_path" ;

throws_ok { $root->fetch_element("refer_to_unknown_elt") } 'Config::Model::Exception::Model',"fetching refer_to_unknown_elt" ;

warning_like { $root->fetch_element("host_reference")->store(value => 'Foo', check => 'skip') } qr/skipping value/,"store unknown host (skip mode)";

throws_ok { $root->fetch_element("host_reference")->store('Foo') } "Config::Model::Exception::WrongValue","store unknown host (failure mode)";

$root->load("host:Foo - host:Bar");
$root->fetch_element("host_reference")->store('Foo');
ok(scalar $root->fetch_element("host_reference")->check, "check reference to Foo host");

$root->load("host_and_replace=fou");
is($root->grab_value("host_and_replace"),'Foo',"check replaced host fou->Foo");

$root->load("host~Foo");
ok( !$root->fetch_element("host_reference")->check, "check reference to removed Foo host");

# todo: need an exclude parameter (to avoid cycle in config_class_name)

memory_cycle_ok($model,"test memory cycle");

done_testing;