# -*- cperl -*-

use warnings;
use strict;

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

Test::Log::Log4perl->ignore_priority("info");

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

# minimal set up to get things working
$model->create_config_class(
    name    => "Master",
    element => [
        [qw/my_hash my_hash2 my_hash3/] => {
            type       => 'hash',
            index_type => 'string',
            cargo      => { type => 'leaf', value_type => 'string' },
        },

        choice_list => {
            type   => 'check_list',
            choice => [ 'A' .. 'Z' ],
            help   => { A => 'A help', E => 'E help' },
        },

        ordered_checklist => {
            type    => 'check_list',
            choice  => [ 'A' .. 'Z' ],
            ordered => 1,
            help    => { A => 'A help', E => 'E help' },
        },

        ordered_checklist_refer_to => {
            type     => 'check_list',
            refer_to => '- ordered_checklist',
            ordered  => 1,
        },

        choice_list_with_default => {
            type         => 'check_list',
            choice       => [ 'A' .. 'Z' ],
            default_list => [ 'A', 'D' ],
            help         => { A => 'A help', E => 'E help' },
        },

        choice_list_with_upstream_default => {
            type                  => 'check_list',
            choice                => [ 'A' .. 'Z' ],
            upstream_default_list => [ 'A', 'D' ],
            help                  => { A => 'A help', E => 'E help' },
        },

        choice_list_with_default_and_upstream_default => {
            type                  => 'check_list',
            choice                => [ 'A' .. 'Z' ],
            default_list          => [ 'A', 'C' ],
            upstream_default_list => [ 'A', 'D' ],
            help                  => { A => 'A help', E => 'E help' },
        },

        macro => {
            type       => 'leaf',
            value_type => 'enum',
            choice     => [qw/AD AH AZ/],
        },

        'warped_choice_list' => {
            type  => 'check_list',
            level => 'hidden',
            warp  => {
                follow => '- macro',
                rules  => {
                    AD => {
                        choice       => [ 'A' .. 'D' ],
                        level        => 'normal',
                        default_list => [ 'A', 'B' ]
                    },
                    AH => {
                        choice => [ 'A' .. 'H' ],
                        level  => 'normal',
                    },
                } }
        },

        refer_to_list => {
            type     => 'check_list',
            refer_to => '- my_hash'
        },

        warped_refer_to_list => {
            type     => 'check_list',
            refer_to => '- warped_choice_list',
            level    => 'hidden',
            warp     => {
                follow => '- macro',
                rules  => {
                    AD => {
                        choice => [ 'A' .. 'D' ],
                        level  => 'normal',
                    },
                },
            },
        },

        refer_to_2_list => {
            type     => 'check_list',
            refer_to => '- my_hash + - my_hash2   + - my_hash3'
        },

        refer_to_check_list_and_choice => {
            type              => 'check_list',
            computed_refer_to => {
                formula   => '- refer_to_2_list + - $var',
                variables => { var => '- indirection ' },
            },
            choice => [qw/A1 A2 A3/],
        },

        indirection => { type => 'leaf', value_type => 'string' },

        dumb_list => {
            type  => 'list',
            cargo => { type => 'leaf', value_type => 'string' }
        },
        refer_to_dumb_list => {
            type     => 'check_list',
            refer_to => '- dumb_list + - my_hash',
        },
        'Ciphers',
        {
            'ordered'               => '1',
            'upstream_default_list' => [
                '3des-cbc',   'aes128-cbc', 'aes128-ctr',   'aes192-cbc',
                'aes192-ctr', 'aes256-cbc', 'aes256-ctr',   'arcfour',
                'arcfour128', 'arcfour256', 'blowfish-cbc', 'cast128-cbc'
            ],
            'type' => 'check_list',
            'description' =>
                'Specifies the ciphers allowed for protocol version 2 in order of preference. By default, all ciphers are allowed.',
            'choice' => [
                'aes128-cbc', '3des-cbc',   'blowfish-cbc', 'cast128-cbc',
                'arcfour128', 'arcfour256', 'arcfour',      'aes192-cbc',
                'aes256-cbc', 'aes128-ctr', 'aes192-ctr',   'aes256-ctr'
            ]
        },

    ] );

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

my $root = $inst->config_root;

my $cl = $root->fetch_element('choice_list');

# check get_choice
is_deeply( [ $cl->get_choice ], [ 'A' .. 'Z' ], "check_get_choice" );

is( $inst->needs_save, 0, "verify instance needs_save status after creation" );

ok( 1, "test get_checked_list for empty check_list" );
my @got = $cl->get_checked_list;
is( scalar @got, 0, "test nb of elt in check_list " );
is_deeply( \@got, [], "test get_checked_list after set_checked_list" );

my %expect;

my $hr = $cl->get_checked_list_as_hash;
is_deeply( $hr, \%expect, "test get_checked_list_as_hash for empty checklist" );

# check help
is( $cl->get_help('A'), 'A help', "test help" );

is( $inst->needs_save, 0, "verify instance needs_save status after reading meta data" );

subtest 'test _store method' => sub {
    # test with the polymorphic 'store' method
    my @test_args = (
        [ [ 'S', 1, 'yes' ], 1, ['S'] ],
        [ [ 'A', 1, 'yes' ], 2, ['A','S'] ],
        [ [ 'A', 0, 'yes' ], 1, ['S'] ],
        [ [ 'bug', 1, 'skip' ], 1, ['S'] ],
    );

    foreach my $test_arg_ref ( @test_args) {
        my ($args, $nb, $expect) = @$test_arg_ref;
        $cl->_store( @$args );
        ok( 1, "test _store method with @$args" );
        @got = $cl->get_checked_list;
        is( scalar @got, $nb, "test nb of elt in check_list after _store" );
        is_deeply( \@got, $expect, "test get_checked_list after _store" );
        $inst->clear_changes;
    }
};

subtest 'test _store warning' => sub {
    my $foo = Test::Log::Log4perl->expect(
        ignore_priority => 'info',
        [ 'User', warn => qr/Unknown check_list item/ ]
        );
    $cl->_store('bug-skipped', 1, 'skip');
};

throws_ok { $cl->_store('bug-error', 1, 'yes') } qr/wrong value/, 'test _store error';

subtest 'test store method' => sub {
    # test with the polymorphic 'store' method
    my @store_args = (
        [ 'S,T,O,R,E' ],
        [ value => 'S,T ,  O, R, E' ],
        [ 'S,O,T,R,E', check => 'yes' ],
        [ value => 'S,T ,  O, R, E', check => 'yes' ],
        [ 'S,T,O,R,E,bug', check => 'skip' ],
    );

    foreach my $test_arg ( @store_args) {
        $cl->store( @$test_arg );
        ok( 1, "test store method with @$test_arg" );
        @got = $cl->get_checked_list;
        is( scalar @got, 5, "test nb of elt in check_list after set" );
        is_deeply( \@got, [sort qw/S T O R E/], "test get_checked_list after set" );
        $inst->clear_changes;
    }
};

$cl->clear;

subtest "test set method and reported changes" => sub {
    my @set_args = (
        # set string,  changes , content after changes
        [ 'A,B'    =>  'A:1 B:1',qw/A B/],
        [ 'A,B,C'  =>  'C:1',    qw/A B C/],
        [ 'A,C,D'  =>  'B:0 D:1',    qw/A C D/],
    );

    while (@set_args) {
        my $test = shift @set_args;
        my ($set_string, $expected_changes, @expected_content) = @$test;
        $cl->set( '', $set_string );
        ok( 1, "test set method with $set_string" );
        @got = $cl->get_checked_list;
        is_deeply( \@got, \@expected_content, "test get_checked_list content after set" );

        is( $inst->needs_save, !!$expected_changes, "verify instance needs_save after set" );
        print join( "\n", $inst->list_changes("\n") ), "\n" if $trace;
        eq_or_diff([$inst->list_changes], ["choice_list: set_checked_list $expected_changes"],
                   "check change message after set check list to $set_string");
        $inst->clear_changes;
    }
};

$cl->clear;
$inst->clear_changes;

my @set = sort qw/A C Z V Y/;
subtest "test get_arguments" => sub {
    my @set_args = (
        \@set,
        [ \@set ],
        [ \@set , check => 'yes' ],
    );

    foreach my $test_arg ( @set_args) {
        my ($list, $check, $args) = $cl->get_arguments(@$test_arg);
        ok( 1, "test set_checked_list" );
        eq_or_diff($list, \@set, "test passed list");
    }
};

subtest 'test set_checked_list method' => sub {
    my @set_args = (
        \@set,
        [ \@set ],
        [ \@set , check => 'yes' ],
        [ [ sort qw/A C Z V Y bug/ ] , check => 'skip' ],
    );

    foreach my $test_arg ( @set_args) {
        $cl->set_checked_list(@$test_arg);
        ok( 1, "test set_checked_list" );
        @got = $cl->get_checked_list;
        is( scalar @got, 5, "test nb of elt in check_list after set_checked_list" );
        is_deeply( \@got, \@set, "test get_checked_list after set_checked_list" );

        is( $inst->needs_save, 1, "verify instance needs_save after set_checked_list" );
        print join( "\n", $inst->list_changes("\n") ), "\n" if $trace;
        $cl->clear;
        $inst->clear_changes;
    }

};

subtest 'test set_checked_list error handling' => sub {
    # bug is not an allowed value
    throws_ok { $cl->set_checked_list(qw/A bug/ ) } qr/wrong value/, 'got exception';
};

subtest 'test behavior when skipping bad value' => sub {
    my $foo = Test::Log::Log4perl->expect(
        ignore_priority => 'info',
        ['User', warn => qr/Unknown check_list item/ ]
        );
    $cl->set_checked_list([qw/A bug/], check => 'skip');
};

$cl->clear;
$inst->clear_changes;

# test global get and set as hash
$cl->set_checked_list(@set);
$hr = $cl->get_checked_list_as_hash;
for ( 'A' .. 'Z' ) { $expect{$_} = 0 }
for (@set) { $expect{$_} = 1 }
eq_or_diff( $hr, \%expect, "test get_checked_list_as_hash" );

$expect{V} = 0;
$expect{W} = 1;
$cl->set_checked_list_as_hash(%expect);
ok( 1, "test set_checked_list_as_hash" );
@got = sort $cl->get_checked_list;
is_deeply( \@got, [ sort qw/A C Z W Y/ ], "test get_checked_list after set_checked_list_as_hash" );

$cl->clear;

# test global get and set
@got = $cl->get_checked_list;
is( scalar @got, 0, "test nb of elt in check_list after clear" );

eval { $cl->check('a'); };
ok( $@, "check 'a': which is an error" );
print "normal error:\n", $@, "\n" if $trace;

# test layered choice_list
$inst->layered_start;
my @l_set = qw/B M W/;
$cl->set_checked_list(@l_set);
$inst->layered_stop;

eq_or_diff( [ $cl->get_checked_list( mode => 'layered' ) ],  \@l_set, "check layered content" );
eq_or_diff( [ $cl->get_checked_list( mode => 'standard' ) ], \@l_set, "check standard content" );
eq_or_diff( [ $cl->get_checked_list() ], [], "check user content" );

$cl->set_checked_list_as_hash( V => 1, W => 1 );
eq_or_diff( [ $cl->get_checked_list( mode => 'layered' ) ],  \@l_set, "check layered content" );
eq_or_diff( [ $cl->get_checked_list( mode => 'standard' ) ], \@l_set, "check standard content" );
eq_or_diff( [ $cl->get_checked_list( mode => 'user' ) ], [qw/B M V W/], "check user content" );
eq_or_diff( [ $cl->get_checked_list() ], [qw/V W/], "check content" );

$cl->clear_layered;
eq_or_diff( [ $cl->get_checked_list( mode => 'layered' ) ],
    [], "check layered content after clear" );

# now test with a refer_to parameter

$root->load("my_hash:X=x my_hash:Y=y");
ok( 1, "load my_hash:X=x my_hash:Y=y worked correctly" );

my $rflist = $root->fetch_element('refer_to_list');
ok( $rflist, "created refer_to_list" );

is_deeply( [ $rflist->get_choice ], [qw/X Y/], 'check simple refer choices' );

$root->load("my_hash:Z=z");
ok( 1, "load my_hash:Z=z worked correctly" );

is_deeply( [ $rflist->get_choice ], [qw/X Y Z/], 'check simple refer choices after 2nd load' );

# load hashes that are used by reference check list
$root->load("my_hash2:X2=x my_hash2:X=xy");

my $rf2list = $root->fetch_element('refer_to_2_list');
ok( $rf2list, "created refer_to_2_list" );
is_deeply( [ sort $rf2list->get_choice ], [qw/X X2 Y Z/], 'check refer_to_2_list choices' );

$root->load("my_hash3:Y2=y");
is_deeply( [ sort $rf2list->get_choice ], [qw/X X2 Y Y2 Z/], 'check refer_to_2_list choices' );

my $rtclac = $root->fetch_element('refer_to_check_list_and_choice');
ok( $rtclac, "created refer_to_check_list_and_choice" );

is_deeply( [ sort $rtclac->get_choice ],
    [qw/A1 A2 A3/], 'check refer_to_check_list_and_choice choices' );

eval { $rtclac->check('X'); };
ok( $@, "get_choice with undef 'indirection' parm: which is an error" );
print "normal error:\n", $@, "\n" if $trace;

$root->fetch_element('indirection')->store('my_hash');

is_deeply( [ sort $rtclac->get_choice ],
    [qw/A1 A2 A3 X Y Z/], 'check refer_to_check_list_and_choice choices with indirection set' );

$rf2list->check('X2');
is_deeply(
    [ sort $rtclac->get_choice ],
    [ sort qw/A1 A2 A3 X X2 Y Z/ ],
    'check X2 and test choices'
);

# load hashes that are used by reference check list
$root->load("my_hash2:X3=x");
$rf2list->check( 'X3', 'Y2' );
is_deeply( [ sort $rf2list->get_choice ],
    [qw/X X2 X3 Y Y2 Z/], 'check refer_to_2_list choices with X3' );
is_deeply(
    [ sort $rtclac->get_choice ],
    [qw/A1 A2 A3 X X2 X3 Y Y2 Z/],
    'check refer_to_check_list_and_choice choices'
);

my $dflist = $root->fetch_element('choice_list_with_default');
ok( $dflist, "created choice_list_with_default" );
@got = $dflist->get_checked_list;
is_deeply( \@got, [ 'A', 'D' ], "test default of choice_list_with_default" );
@got = $dflist->get_checked_list(mode =>'custom');
is_deeply( \@got, [  ], "test custom data  of choice_list_with_default" );
is($dflist->has_data, 0, "choice_list_with_default has no data");

$dflist->check('C');
$dflist->uncheck('D');
@got = $dflist->get_checked_list;
is_deeply( \@got, [ 'A', 'C' ], "test default of choice_list_with_default" );
is($dflist->has_data, 1, "choice_list_with_default has data");

@got = $dflist->get_checked_list('custom');
is_deeply( \@got, ['C'], "test custom of choice_list_with_default" );

@got = $dflist->get_checked_list('standard');
is_deeply( \@got, [ 'A', 'D' ], "test standard of choice_list_with_default" );

@got = $dflist->get_checked_list('backend');
is_deeply( \@got, [ 'A', 'C' ], "fetch with backend mode for choice_list_with_default" );

my $warp_list;
eval { $warp_list = $root->fetch_element('warped_choice_list'); };
ok( $@, "fetch_element without warp set (macro=undef): which is an error" );
print "normal error:\n", $@, "\n" if $trace;

# force read of hidden element
$warp_list = $root->fetch_element( name => 'warped_choice_list', accept_hidden => 1 );

ok( $warp_list, "created warped_choice_list" );

eval { $warp_list->get_choice; };
ok( $@, "get_choice without warp set (macro=undef): which is an error" );
print "normal error:\n", $@, "\n" if $trace;

$root->load("macro=AD");

is_deeply(
    [ $warp_list->get_choice ],
    [ 'A' .. 'D' ],
    'check warp_list choice after setting macro=AD'
);

@got = $warp_list->get_checked_list;
is_deeply( \@got, [ 'A', 'B' ], "test default of warped_choice_list" );

$root->load("macro=AH");

is_deeply(
    [ $warp_list->get_choice ],
    [ 'A' .. 'H' ],
    'check warp_list choice after setting macro=AH'
);

@got = $warp_list->get_checked_list;
is_deeply( \@got, [], "test default of warped_choice_list after setting macro=AH" );

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

my $rtl = $root->fetch_element("refer_to_dumb_list");
is_deeply( [ $rtl->get_choice ], [qw/X Y Z a b c d e/], "check choice of refer_to_dumb_list" );

# test check list with built_in default
my $wud = $root->fetch_element("choice_list_with_upstream_default");
@got = $wud->get_checked_list();
is_deeply( \@got, [], "test default of choice_list_with_upstream_default" );
is($wud->has_data, 0, "test checklist has data");

@got = $wud->get_checked_list('upstream_default');
is_deeply( \@got, [qw/A D/], "test upstream_default of choice_list_with_upstream_default" );

# test check list with upstream_default *and* default (should override)
$inst->clear_changes;
my $wudad = $root->fetch_element("choice_list_with_default_and_upstream_default");
is( $inst->needs_save, 0, "check needs_save after reading a default value" );
@got = $wudad->get_checked_list('default');
is_deeply( \@got, [qw/A C/], "test default of choice_list_with_default_and_upstream_default" );
is( $inst->needs_save, 0, "check needs_save after reading a default value" );

@got = $wudad->get_checked_list();
is_deeply( \@got, [qw/A C/], "test choice_list_with_default_and_upstream_default" );
is( $inst->needs_save, 1, "check needs_save after reading a default value" );

is_deeply( $wudad->fetch(), 'A,C', "test fetch choice_list_with_default_and_upstream_default" );
is( $inst->needs_save, 1, "check needs_save after reading a default value" );

### test preset feature

my $pinst = $model->instance(
    root_class_name => 'Master',
    instance_name   => 'preset_test'
);
ok( $pinst, "created dummy preset instance" );

my $p_root = $pinst->config_root;

$pinst->preset_start;
ok( $pinst->preset, "instance in preset mode" );

my $p_cl = $p_root->fetch_element('choice_list');
$p_cl->set_checked_list(qw/H C L/);    # acid burn test :-)

$pinst->preset_stop;
is( $pinst->preset, 0, "instance in normal mode" );

is( $p_cl->fetch, "C,H,L", "choice_list: read preset list" );

$p_cl->check(qw/A S H/);
is( $p_cl->fetch,             "A,C,H,L,S", "choice_list: read completed preset LIST" );
is( $p_cl->fetch('preset'),   "C,H,L",     "choice_list: read preset value as preset_value" );
is( $p_cl->fetch('standard'), "C,H,L",     "choice_list: read preset value as standard_value" );
is( $p_cl->fetch('custom'),   "A,C,H,L,S", "choice_list: read custom_value" );

$p_cl->set_checked_list(qw/A S H E/);
is( $p_cl->fetch,           "A,E,H,S", "choice_list: read overridden preset LIST" );
is( $p_cl->fetch('custom'), "A,E,H,S", "choice_list: read custom_value after override" );

my $wrtl = $p_root->fetch_element( name => 'warped_refer_to_list', accept_hidden => 1 );
ok( $wrtl, "created warped_refer_to_list (hidden)" );

my $ocl = $root->fetch_element('ordered_checklist');
@got = $ocl->get_checked_list();
is_deeply( \@got, [], "test default of ordered_checklist" );

@set = qw/A C Z V Y/;
$ocl->set_checked_list(@set);
@got = $ocl->get_checked_list;
is_deeply( \@got, \@set, "test ordered_checklist after set_checked_list" );

$ocl->swap(qw/A Y/);
@got = $ocl->get_checked_list;
is_deeply( \@got, [qw/Y C Z V A/], "test ordered_checklist after swap" );

$ocl->move_up(qw/Y/);
@got = $ocl->get_checked_list;
is_deeply( \@got, [qw/Y C Z V A/], "test ordered_checklist after move_up Y" );

$ocl->move_up(qw/V/);
@got = $ocl->get_checked_list;
is_deeply( \@got, [qw/Y C V Z A/], "test ordered_checklist after move_up V" );

$ocl->move_down(qw/A/);
@got = $ocl->get_checked_list;
is_deeply( \@got, [qw/Y C V Z A/], "test ordered_checklist after move_down A" );

$ocl->move_down(qw/C/);
@got = $ocl->get_checked_list;
is_deeply( \@got, [qw/Y V C Z A/], "test ordered_checklist after move_down C" );

$ocl->check('B');
@got = $ocl->get_checked_list;
is_deeply( \@got, [qw/Y V C Z A B/], "test ordered_checklist after check B" );

$ocl->move_up(qw/B/);
$ocl->uncheck('B');
@got = $ocl->get_checked_list;
is_deeply( \@got, [qw/Y V C Z A/], "test ordered_checklist after move_up B uncheck B" );

$ocl->check('B');
@got = $ocl->get_checked_list;
is_deeply( \@got, [qw/Y V C Z B A/], "test ordered_checklist after check B" );

is( $root->grab_value( $ocl->location ), "Y,V,C,Z,B,A", "test grab_value" );

my $oclrt = $root->fetch_element('ordered_checklist_refer_to');
@got = $oclrt->get_choice();
is_deeply( \@got, [qw/Y V C Z B A/], "test default of ordered_checklist_refer_to" );

my $ciphers     = $root->fetch_element('Ciphers');
my @cipher_list = qw/aes192-cbc aes128-cbc 3des-cbc blowfish-cbc aes256-cbc/;
$ciphers->set_checked_list(@cipher_list);
eq_or_diff( [ $ciphers->get_checked_list ], \@cipher_list, "check cipher list" );

# test warp in layered mode
my $layered_i = $model->instance(
    root_class_name => 'Master',
    instance_name   => 'test_layered'
);
ok( $layered_i, "created layered instance" );
my $l_root = $layered_i->config_root;
$layered_i->layered_start;

my $locl = $l_root->fetch_element('ordered_checklist');
$locl->set_checked_list(@set);

my $loclrt = $root->fetch_element('ordered_checklist_refer_to');
@got = $loclrt->get_choice();
is_deeply( \@got, [qw/Y V C Z B A/], "test default of ordered_checklist_refer_to in layered mode" );

$inst->apply_fixes;
ok( 1, "apply_fixes works" );

print join( "\n", $inst->list_changes("\n") ), "\n" if $trace;

memory_cycle_ok( $model, "memory cycle" );

done_testing;