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

use warnings;

use ExtUtils::testlib;
use Test::More tests => 18;
use Test::Memory::Cycle;
use Config::Model;
use Data::Dumper;
use Log::Log4perl qw(:easy :levels);

use strict;

my $arg = shift || '';
my ( $log, $show ) = (0) x 2;

my $trace = $arg =~ /t/ ? 1 : 0;
$log     = 1 if $arg =~ /l/;
$show    = 1 if $arg =~ /s/;

Log::Log4perl->easy_init( $log ? $TRACE : $WARN );

Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;

ok( 1, "Compilation done" );

my @element = (

    # Value constructor args are passed in their specific array ref
    cargo => { type => 'node', config_class_name => 'Slave' },
);

# minimal set up to get things working
my $model = Config::Model->new();
$model->create_config_class(
    name    => "Master",
    element => [
        'plain_hash' => {
            type => 'hash',
            class => 'Config::Model::HashId',    # default
            index_type => 'integer',

            @element
        },
        'bounded_hash' => {
            type => 'hash',
            class => 'Config::Model::HashId',    # default
            index_type => 'integer',

            # hash boundaries
            min    => 1,
            max    => 123,
            max_nb => 2,
            @element
        },
        'hash_with_default_and_init' => {
            type              => 'hash',
            index_type        => 'string',
            default_with_init => {
                'def_1' => 'X=Av Y=Bv',
                'def_2' => 'Y=Av Z=Cv'
            },
            @element
        },
    ],
);

$model->create_config_class(
    name    => "Slave",
    element => [
        [qw/X Y Z/] => {
            type       => 'leaf',
            value_type => 'enum',
            choice     => [qw/Av Bv Cv/]
        },
    ] );

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

my $root = $inst->config_root;

my $b = $root->fetch_element('bounded_hash');
ok( $b, "bounded hash created" );

is( $b->name, 'Master bounded_hash id', "check hash id name" );

my $b1 = $b->fetch_with_id(1);
isa_ok( $b1, 'Config::Model::Node', "fetched element id 1" );

is( $b1->config_class_name, 'Slave', 'check config_class_name' );

my $h_with_def = $root->fetch_element('hash_with_default_and_init');
my $res        = [ $h_with_def->fetch_all_indexes ];

#print Dumper( $res ) ;

is_deeply( $res, [qw/def_1 def_2/], 'check default items' );

#print $root->dump_tree ;
is(
    $root->dump_tree,
    'bounded_hash:1 -
hash_with_default_and_init:def_1
  X=Av
  Y=Bv -
hash_with_default_and_init:def_2
  Y=Av
  Z=Cv - -
', "check default items with children setup"
);

is( $h_with_def->fetch_with_id('def_1')->index_value, 'def_1', 'check index_value prior to move' );

$h_with_def->move( 'def_1', 'moved_1' );

is( $h_with_def->fetch_with_id('moved_1')->index_value, 'moved_1', 'check index_value after move' );

$res = [ $h_with_def->fetch_all_indexes ];
is_deeply( $res, [qw/def_2 moved_1/], 'check moved items keys' );

#print $root->dump_tree ;
is(
    $root->dump_tree,
    'bounded_hash:1 -
hash_with_default_and_init:def_2
  Y=Av
  Z=Cv -
hash_with_default_and_init:moved_1
  X=Av
  Y=Bv - -
', "check moved items with children setup"
);

$root->load("plain_hash:2 X=Av Y=Av Z=Cv");
my $ph = $root->fetch_element('plain_hash');
ok( $ph->copy( 2, 3 ), "node copy in hash" );
is( $ph->fetch_with_id(2)->dump_tree, $ph->fetch_with_id(3)->dump_tree, "compare copied values" );

ok( $ph->move( 2, 4 ), "node move in hash" );
is(
    $ph->fetch_with_id(4)->dump_tree,
    $ph->fetch_with_id(3)->dump_tree,
    "compare copied then moved values"
);

is_deeply( [ $ph->fetch_all_indexes ], [ 3, 4 ], "compare indexes after move" );
memory_cycle_ok($model);