# -*- cperl -*-

use warnings FATAL => qw(all);

use ExtUtils::testlib;
use Test::More;
use Test::Exception;
use Test::Warn ;
use Test::Differences ;
use Test::Memory::Cycle;
use Config::Model;
use Config::Model::AnyId;
use Log::Log4perl qw(:easy :levels) ;

use strict;

my $arg = shift || '';

my $log = 0 ;

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

my $home = $ENV{HOME} || "";
my $log4perl_user_conf_file = "$home/.log4config-model";

if ($log and -e $log4perl_user_conf_file ) {
    Log::Log4perl::init($log4perl_user_conf_file);
}
else {
    Log::Log4perl->easy_init($log ? $WARN: $ERROR);
}

my $model = Config::Model -> new ( ) ;

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

ok(1,"compiled");

my @element = (

    # Value constructor args are passed in their specific array ref
    cargo => {
        type       => 'leaf',
        value_type => 'string'
    },
);

# minimal set up to get things working
$model->create_config_class(
    name    => "Master",
    element => [
        bounded_list => {
            type       => 'list',
            list_class => 'Config::Model::ListId',    # default

            max   => 123,
            cargo => {
                type       => 'leaf',
                value_type => 'string'
            },
        },
        plain_list                => { type => 'list', @element },
        list_with_auto_created_id => {
            type            => 'list',
            auto_create_ids => 4,
            @element
        },
        olist => {
            type  => 'list',
            cargo => {
                type              => 'node',
                config_class_name => 'Slave'
            },
        },
        list_with_default_with_init_leaf => {
            type              => 'list',
            default_with_init => {
                0 => 'def_1 stuff',
                1 => 'def_2 stuff'
            },
            @element,
        },
        list_with_default_with_init_node => {
            type              => 'list',
            default_with_init => {
                0 => 'X=Bv Y=Cv',
                1 => 'X=Av'
            },
            cargo => {
                type              => 'node',
                config_class_name => 'Slave'
            },
        },
        map { 
              ("list_with_".$_."_duplicates" => { type => 'list', duplicates => $_ , @element, },);
            } qw/warn allow forbid suppress/ ,
    ]
);

$model->create_config_class(
    name    => "Bogus",
    element => [
        list_with_wrong_auto_create => {
            type            => 'list',
            auto_create_ids => ['foo'],
            @element
        },
        list_with_wrong_duplicates => {
            type              => 'list',
            duplicates => 'forbid',
            cargo => {
                type              => 'node',
                config_class_name => 'Slave'
            },
        },
        list_with_yada_duplicates => { 
            type => 'list', 
            duplicates => 'yada' ,
            @element, 
        },
    ]
);

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

ok(1,"config classes created") ;

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;

eq_or_diff( [ $root->fetch_element('olist')->fetch_all_indexes ],
    [], "check index list of empty list" );

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

my $b = $root->fetch_element('bounded_list');
ok( $b, "bounded list created" );
is($inst->needs_save,0,"verify instance needs_save status after element creation") ;

is( $b->fetch_with_id(1)->store('foo'), 1, "stored in 1" );
is( $b->fetch_with_id(0)->store('baz'), 1, "stored in 0" );
is( $b->fetch_with_id(2)->store('bar'), 1, "stored in 2" );
is($inst->needs_save,3,"verify instance needs_save status after storing into element") ;
print  join("\n", $inst->list_changes("\n")),"\n" if $trace;

throws_ok { $b->fetch_with_id(124)->store('baz'); }
qr/Index 124 > max_index limit 123/, 'max error caught';

my $bogus_root = $model->instance( root_class_name => 'Bogus' )->config_root;
throws_ok { $bogus_root->fetch_element('list_with_wrong_auto_create'); }
qr/Wrong auto_create argument for list/, 'wrong auto_create caught';

eq_or_diff( [ $b->fetch_all_indexes ], [ 0, 1, 2 ], "check ids" );

$b->delete(1);
is( $b->fetch_with_id(1)->fetch, undef, "check deleted id" );

is( $b->index_type, 'integer', 'check list index_type' );
is( $b->max_index,  123,       'check list max boundary' );

$b->push( 'toto', 'titi' );
is( $b->fetch_with_id(2)->fetch, 'bar',  "check last item of table" );
is( $b->fetch_with_id(3)->fetch, 'toto', "check pushed toto item" );
is( $b->fetch_with_id(4)->fetch, 'titi', "check pushed titi item" );

$b->push_x(
    values     => [ 'toto', 'titi' ],
    check      => 'no',
    annotation => ['toto comment']
);
is( $b->fetch_with_id(5)->fetch, 'toto', "check pushed toto item with push_x" );
is( $b->fetch_with_id(5)->annotation,
    'toto comment', "check pushed toto annotation with push_x" );
is( $b->fetch_with_id(6)->fetch, 'titi', "check pushed titi item with push_x" );

$b->push_x(
    values     => 'toto2',
    check      => 'no',
    annotation => 'toto2 comment'
);

is( $b->fetch_with_id(7)->fetch, 'toto2', "check pushed toto2 item with push_x" );
is( $b->fetch_with_id(7)->annotation,
    'toto2 comment', "check pushed toto2 annotation with push_x" );

my @all = $b->fetch_all_values;
eq_or_diff( \@all, [qw/baz bar toto titi toto titi toto2/], "check fetch_all_values" );

my $lac = $root->fetch_element('list_with_auto_created_id');
eq_or_diff(
    [ $lac->fetch_all_indexes ],
    [ 0 .. 3 ],
    "check list_with_auto_created_id"
);

map { is( $b->fetch_with_id($_)->index_value, $_, "Check index value $_" ); }
  ( 0 .. 4 );

$b->move( 3, 4 );
is( $b->fetch_with_id(3)->fetch, undef,  "check after move idx 3 in 4" );
is( $b->fetch_with_id(4)->fetch, 'toto', "check after move idx 3 in 4" );
map {
    is( $b->fetch_with_id($_)->index_value, $_, "Check moved index value $_" );
} ( 0 .. 4 );

$b->fetch_with_id(3)->store('titi');
$b->swap( 3, 4 );

map {
    is( $b->fetch_with_id($_)->index_value, $_,
        "Check swapped index value $_" );
} ( 0 .. 4 );

is( $b->fetch_with_id(3)->fetch, 'toto', "check value after swap" );
is( $b->fetch_with_id(4)->fetch, 'titi', "check value after swap" );

$b->remove(3);
is( $b->fetch_with_id(3)->fetch, 'titi', "check after remove" );

# test move swap with node list
my $ol = $root->fetch_element('olist');

my @set = ( [qw/X Av/], [qw/X Bv/], [qw/Y Av/], [qw/Z Cv/], [qw/Z Av/], );

my $i = 0;
foreach my $item (@set) {
    my ( $e, $v ) = @$item;
    $ol->fetch_with_id( $i++ )->fetch_element($e)->store($v);
}

$inst->clear_changes ;

$ol->move( 3, 4 );
is($inst->needs_save,1,"verify instance needs_save status after move") ;
print scalar $inst->list_changes,"\n" if $trace ;
$inst->clear_changes ;

is( $ol->fetch_with_id(3)->fetch_element('Z')->fetch,
    undef, "check after move idx 3 in 4" );
is( $ol->fetch_with_id(4)->fetch_element('Z')->fetch,
    'Cv', "check after move idx 3 in 4" );
map {
    is( $ol->fetch_with_id($_)->index_value, $_, "Check moved index value $_" );
} ( 0 .. 4 );

$ol->swap( 0, 2 );
is($inst->needs_save,1,"verify instance needs_save status after move") ;
print scalar $inst->list_changes,"\n" if $trace ;
$inst->clear_changes ;

is( $ol->fetch_with_id(0)->fetch_element('X')->fetch,
    undef, "check after move idx 0 in 2" );
is( $ol->fetch_with_id(0)->fetch_element('Y')->fetch, 'Av',
    "check after move" );

is( $ol->fetch_with_id(2)->fetch_element('Y')->fetch,
    undef, "check after move" );
is( $ol->fetch_with_id(2)->fetch_element('X')->fetch, 'Av',
    "check after move" );

map {
    is( $ol->fetch_with_id($_)->index_value, $_, "Check moved index value $_" );
} ( 0 .. 4 );
print $root->dump_tree( experience => 'beginner' ) if $trace;

is( $ol->fetch_with_id(0)->fetch_element('X')->fetch,
    undef, "check before move" );
$ol->remove(0);
print $root->dump_tree( experience => 'beginner' ) if $trace;
is( $ol->fetch_with_id(0)->fetch_element('X')->fetch, 'Bv',
    "check after move" );

# test store
my @test = (
    [ a1         => ['a1'] ],
    [ '"a","b"'  => [qw/a b/] ],
    [ 'a,b'      => [qw/a b/] ],
    [ '"a\"a",b' => [qw/a"a b/] ],
    [ '"a,a",b'  => [ 'a,a', 'b' ] ],
    [ '",a1"'    => [',a1'] ],
);
foreach my $l (@test) {
    $b->load( $l->[0] );
    eq_or_diff( [ $b->fetch_all_values ], $l->[1], "test store $l->[0]" );
}

throws_ok { $b->load('a,,b'); } "Config::Model::Exception::Load",
  "fails load 'a,,b'";

# test preset mode
$inst->preset_start;
my $pl = $root->fetch_element('plain_list');

$pl->fetch_with_id(0)->store('prefoo');
$pl->fetch_with_id(1)->store('prebar');
$inst->preset_stop;
ok( 1, "filled preset values" );

eq_or_diff(
    [ $pl->fetch_all_values ],
    [ 'prefoo', 'prebar' ],
    "check that preset values are read"
);
$pl->fetch_with_id(2)->store('bar');

eq_or_diff(
    [ $pl->fetch_all_values ],
    [ 'prefoo', 'prebar', 'bar' ],
    "check that values are read"
);

eq_or_diff( [ $pl->fetch_all_values( mode => 'custom' ) ],
    ['bar'], "check that custom values are read" );

# test default_with_init on leaf
my $lwdwil = $root->fetch_element('list_with_default_with_init_leaf');
# note: calling fetch_all_indexes is required to trigger creation of default_with_init keys
eq_or_diff([$lwdwil->fetch_all_indexes],[0,1],"check default keys");
is($lwdwil->fetch_with_id(0)->fetch,'def_1 stuff',"test default_with_init leaf 0") ;
is($lwdwil->fetch_with_id(1)->fetch,'def_2 stuff',"test default_with_init leaf 1") ;

# test default_with_init on node
my $lwdwin = $root->fetch_element('list_with_default_with_init_node');
eq_or_diff([$lwdwin->fetch_all_indexes],[0,1],"check default keys");
is($lwdwin->fetch_with_id(0)->fetch_element('X')->fetch,'Bv',"test default_with_init node 0") ;
is($lwdwin->fetch_with_id(0)->fetch_element('Y')->fetch,'Cv',"test default_with_init node 0") ;
is($lwdwin->fetch_with_id(1)->fetch_element('X')->fetch,'Av',"test default_with_init node 0") ;

throws_ok { $bogus_root->fetch_element('list_with_wrong_duplicates'); } "Config::Model::Exception::Model",
  "fails duplicates with node cargo";

throws_ok { $bogus_root->fetch_element('list_with_yada_duplicates'); } "Config::Model::Exception::Model",
  "fails yada duplicates";

foreach my $what (qw/forbid warn suppress/) {
    my $lwd = $root->fetch_element('list_with_'.$what.'_duplicates');
    $lwd->push(qw/string1 string2/);
    $lwd->push('string1'); # does not trigger duplicate issues, yet
    $lwd->push('string1'); # does not trigger duplicate issues, yet
    
    # there we go
    if ($what eq 'forbid') {
        is($lwd->needs_check, 1, "verify needs_check is true") ;
        throws_ok { $lwd->fetch_all_values ; } "Config::Model::Exception::WrongValue", 
            "fails forbidden duplicates" ;
        is($lwd->needs_check, 0, "verify needs_check after fetch_all_values") ;
        throws_ok { $lwd->fetch_all_values ; } "Config::Model::Exception::WrongValue", 
            "fails forbidden duplicates even if needs_check is false" ;
        is($lwd->needs_check, 0, "verify again needs_check after fetch_all_values") ;
        $lwd->delete(2) ;
        is($lwd->needs_check, 1, "verify needs_check after list content modif") ;
    }
    elsif ($what eq 'warn') {
        warnings_like { $lwd->fetch_all_values ; } qr/Duplicated/ ,
            "warns with duplicated values" ;
        is($lwd->has_fixes, 2,"check nb of fixes") ;
        $inst->apply_fixes ;
        warnings_like { $lwd->fetch_all_values ; } [] , # no warning accepted
            "no longer warns with duplicated values" ;
    }
    else {
        $lwd->check_content ; 
    }
    is ($lwd->fetch_with_id(0)->fetch,'string1',
        "check that original values is untouched after $what duplicates");
}

# test preset clear stuff
# done after auto_create_ids tests, because preset_clear or layered_clear
# also clean up auto_create_ids (if there's no data in there)
$pl->clear ;
eq_or_diff( [ $pl->fetch_all_indexes ], [ ] ,"check that preset stuff was cleared");

$inst->preset_start;
$pl->fetch_with_id(0)->store('prefoo');
$pl->fetch_with_id(1)->store('prebar');
$inst->preset_stop;
eq_or_diff( [ $pl->fetch_all_indexes ], [0,1] ,"check preset indexes");
$pl->fetch_with_id(1)->store('bar');
$inst->preset_clear ;
eq_or_diff( [ $pl->fetch_all_indexes ], [0] ,"check that only preset stuff was cleared");
is($pl->fetch_with_id(0)->fetch,'bar',"check that bar was moved from 1 to 0");

# test layered stuff
$pl->clear ;
$inst->layered_start;
$pl->fetch_with_id(0)->store('prefoo');
$pl->fetch_with_id(1)->store('prebar');
$inst->layered_stop;
eq_or_diff( [ $pl->fetch_all_indexes ], [0,1] ,"check layered indexes");
$pl->fetch_with_id(1)->store('bar');
$inst->layered_clear ;
eq_or_diff( [ $pl->fetch_all_indexes ], [0] ,"check that only layered stuff was cleared");
is($pl->fetch_with_id(0)->fetch,'bar',"check that bar was moved from 1 to 0");
$pl->clear ;

# test sort
@set = qw/j h g f/ ;
$pl->store_set(@set);
$inst->clear_changes ;
$pl->sort;
eq_or_diff( [ $pl->fetch_all_values ], [sort @set] ,"check sort result");
is($inst->c_count, 1, "check that sort has triggered a change") ;
$pl->sort;
is($inst->c_count, 1, "check that redundant sort has not triggered a change") ;

# test unshift
@set = qw/j h g f/ ;
$pl->store_set(qw/a b/);
$pl->unshift(qw/1 2 3 4/);
eq_or_diff( [ $pl->fetch_all_values ], [qw/1 2 3 4 a b/] ,"check unshift result");
eq_or_diff( [ $pl->fetch_all_indexes ], [(0..5)] ,"check that indexes are reset correctly");

# test insert_at
$pl->store_set(qw/a b/);
$pl->insert_at(qw/1 d e/);
eq_or_diff( [ $pl->fetch_all_values ], [qw/a d e b/] ,"check insert_at result");
eq_or_diff( [ $pl->fetch_all_indexes ], [(0..3)] ,"check that indexes are reset correctly");

# test insert_before
$pl->store_set(qw/foo baz/);
$pl->insert_before( qw/baz bar1 bar2/);
eq_or_diff( [ $pl->fetch_all_values ], [qw/foo bar1 bar2 baz/] ,"check insert_before result");

$pl->insert_before( qr/z/ , qw/bar3 bar4/);
eq_or_diff( [ $pl->fetch_all_values ], [qw/foo bar1 bar2 bar3 bar4 baz/] ,"check insert_before with regexp result");

# test insort
my @set1 = qw/c1 e i1 j1 p1/ ;
my @set2 = qw/a2 z2 d2 e b2 k2/ ;
$pl->store_set(@set1);
$pl->sort;
$pl->insort( @set2 );
eq_or_diff( [ $pl->fetch_all_values ], [sort(@set1, @set2)] ,"check insort result");

memory_cycle_ok($model,"memory cycles");

done_testing;