# -*- cperl -*-

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

use warnings;
use strict;
use lib "t/lib";

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

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

my $root = $inst->config_root;
ok( $root, "Config root created" );

$inst->preset_start;

$root->fetch_element( name => 'hidden_string', accept_hidden => 1 )->store('hidden value');

my $step = 'std_id:ab X=Bv ' . '! lista:=a,b listb:=b ';
ok( $root->load( step => $step ), "preset data in tree with '$step'" );

$inst->preset_stop;

$step =
      'std_id:ab X=Bv - std_id:bc X=Av - std_id:"b d " X=Av '
    . '- a_string="toto \"titi\" tata" another_string="foobar" a_string2=dod@foo.com '
    . 'a_string_to_test_newline="foo\nbar\\\\nbaz" '
    . 'lista:=a,b,c,d olist:0 X=Av - olist:1 X=Bv - listb:=b,"c c2",d listc:="dod@foo.com" '
    . '! hash_a:X2=x hash_a:Y2=xy  hash_b:X3=xy my_check_list=X2,X3 hash_b:comment_test="#"'
    . ' hash_a:"~"="~/bar" ';
ok( $root->load( step => $step ), "set up data in tree" );

eq_or_diff(
    [ sort $root->fetch_element('std_id')->fetch_all_indexes ],
    [ 'ab', 'b d ', 'bc' ],
    "check std_id keys"
);

eq_or_diff( [ sort $root->fetch_element('lista')->fetch_all_values( mode => 'custom' ) ],
    [qw/c d/], "check lista custom values" );

my $cds = $root->dump_tree;

print "cds string:\n$cds" if $trace;

subtest "test round trip" => sub {
    my $load_inst = $model->instance(
        root_class_name => 'Master',
        model_file      => 'dump_load_model.pl',
        instance_name   => 'round_trip'
    );
    my $round_root = $load_inst->config_root;
    ok($round_root->load($cds), "test round trip: load");
    my $new_cds = $round_root->dump_tree;
    eq_or_diff(
        [ split /\n/, $new_cds ],
        [ split /\n/, $cds ],
        "test round trip: dump "
    )
};

my $orig_expect = <<'EOF' ;
std_id:ab -
std_id:"b d "
  X=Av -
std_id:bc
  X=Av -
lista:=c,d
listb:="c c2",d
listc:="dod@foo.com"
hash_a:X2=x
hash_a:Y2=xy
hash_a:"~"="~/bar"
hash_b:X3=xy
hash_b:comment_test="#"
olist:0
  X=Av -
olist:1
  X=Bv -
a_string="toto \"titi\" tata"
a_string2=dod@foo.com
a_string_to_test_newline="foo
bar\\nbaz"
another_string=foobar
my_check_list=X2,X3 -
EOF

$cds =~ s/\s+\n/\n/g;
eq_or_diff(
    [ split /\n/, $cds ],
    [ split /\n/, $orig_expect ],
    "check dump of only customized values "
);

$cds = $root->dump_tree( mode => 'user' );
print "cds string:\n$cds" if $trace;

my $expect = <<'EOF' ;
std_id:ab
  X=Bv
  DX=Dv -
std_id:"b d "
  X=Av
  DX=Dv -
std_id:bc
  X=Av
  DX=Dv -
lista:=a,b,c,d
listb:=b,"c c2",d
listc:="dod@foo.com"
hash_a:X2=x
hash_a:Y2=xy
hash_a:"~"="~/bar"
hash_b:X3=xy
hash_b:comment_test="#"
olist:0
  X=Av
  DX=Dv -
olist:1
  X=Bv
  DX=Dv -
string_with_def="yada yada"
a_uniline="yada yada"
a_string="toto \"titi\" tata"
a_string2=dod@foo.com
a_string_to_test_newline="foo
bar\\nbaz"
another_string=foobar
int_v=10
my_check_list=X2,X3 -
EOF

$cds =~ s/\s+\n/\n/g;
eq_or_diff( [ split /\n/, $cds ], [ split /\n/, $expect ], "check dump of all values " );

my $listb = $root->fetch_element('listb');
$listb->clear;

$cds = $root->dump_tree( mode => 'user' );
print "cds string:\n$cds" if $trace;

$expect = <<'EOF' ;
std_id:ab
  X=Bv
  DX=Dv -
std_id:"b d "
  X=Av
  DX=Dv -
std_id:bc
  X=Av
  DX=Dv -
lista:=a,b,c,d
listc:="dod@foo.com"
hash_a:X2=x
hash_a:Y2=xy
hash_a:"~"="~/bar"
hash_b:X3=xy
hash_b:comment_test="#"
olist:0
  X=Av
  DX=Dv -
olist:1
  X=Bv
  DX=Dv -
string_with_def="yada yada"
a_uniline="yada yada"
a_string="toto \"titi\" tata"
a_string2=dod@foo.com
a_string_to_test_newline="foo
bar\\nbaz"
another_string=foobar
int_v=10
my_check_list=X2,X3 -
EOF

$cds =~ s/\s+\n/\n/g;
eq_or_diff(
    [ split /\n/, $cds ],
    [ split /\n/, $expect ],
    "check dump of all values after listb is cleared"
);

# check empty strings

my $a_s = $root->fetch_element('a_string');
$a_s->store("");

$expect = <<'EOF' ;
std_id:ab
  X=Bv
  DX=Dv -
std_id:"b d "
  X=Av
  DX=Dv -
std_id:bc
  X=Av
  DX=Dv -
lista:=a,b,c,d
listc:="dod@foo.com"
hash_a:X2=x
hash_a:Y2=xy
hash_a:"~"="~/bar"
hash_b:X3=xy
hash_b:comment_test="#"
olist:0
  X=Av
  DX=Dv -
olist:1
  X=Bv
  DX=Dv -
string_with_def="yada yada"
a_uniline="yada yada"
a_string=""
a_string2=dod@foo.com
a_string_to_test_newline="foo
bar\\nbaz"
another_string=foobar
int_v=10
my_check_list=X2,X3 -
EOF

$cds = $root->dump_tree( mode => 'user' );
print "cds string:\n$cds" if $trace;

$cds =~ s/\s+\n/\n/g;
eq_or_diff(
    [ split /\n/, $cds ],
    [ split /\n/, $expect ],
    "check dump of all values after a_string is set to ''"
);

# check preset values

$cds = $root->dump_tree( mode => 'preset' );
print "cds string:\n$cds" if $trace;

$expect = <<'EOF' ;
std_id:ab
  X=Bv -
std_id:"b d " -
std_id:bc -
lista:=a,b
olist:0 -
olist:1 - -
EOF

$cds =~ s/\s+\n/\n/g;
eq_or_diff( [ split /\n/, $cds ], [ split /\n/, $expect ], "check dump of all preset values" );

# shake warp stuff
my $tm = $root->fetch_element('tree_macro');
for ( qw/XY XZ mXY XY mXY XZ/ ) { $tm->store($_); }

$cds = $root->dump_tree( mode => 'user', skip_auto_write => 'cds_file' );
print "cds string:\n$cds" if $trace;

like( $cds, qr/hidden value/, "check that hidden value is shown (macro=XZ)" );

# check that list of undef is not shown
for ( 0 .. 3 ) { $listb->fetch_with_id($_)->store(undef) }

$cds = $root->dump_tree( mode => 'user' );
print "Empty listb dump:\n$cds" if $trace;

unlike( $cds, qr/listb/, "check that listb containing undef values is not shown" );

# reload test

my $reload_root = $model->instance(
    root_class_name => 'Master',
    instance_name   => 'reload_test'
)->config_root;

$reload_root->load($orig_expect);
my $reloaded_dump = $reload_root->dump_tree;
eq_or_diff(
    [ split /\n/, $reloaded_dump ],
    [ split /\n/, $orig_expect ],
    "check dump of tree load with dump result"
);

# annotation tests

my $root2 = $model->instance(
    root_class_name => 'Master',
    instance_name   => 'test2'
)->config_root;

$step = ' std_id:ab#std_id_ab_note 
                                    X=Bv X#std_id_ab_X_note 
      - std_id#std_id_note std_id:bc X=Av X#std_id_bc_X_note '
    . '- a_string="toto \"titi\" tata" a_string#a_string_note another_string="foobar"'
    . 'lista#lista_note lista:=a,b,c,d lista:1#lista_1_note olist#o_list_note olist:0#olist_0_note X=Av - olist:1#olist1_c X=Bv - listb:=b,"c c2",d '
    . '! hash_a:X2=x#hash_a_X2 hash_a:Y2=xy#"hash_a Y2 note"  hash_b:X3=xy#hash_b_X3
     my_check_list=X2,X3 plain_object#"plain comment" aa2=aa2_value';
ok( $root2->load( step => $step ), "set up data in tree annotation" );

is( $root2->fetch_element('std_id')->annotation, 'std_id_note', "check annotation for std_id" );
is( $root2->grab('std_id:ab')->annotation, 'std_id_ab_note', "check annotation for std_id:ab" );
is( $root2->grab('olist:0')->annotation,   'olist_0_note',   "check annotation for olist:0" );

my $expect_count = scalar grep { /#/ } split //, $step;

$cds = $root2->dump_tree( mode => 'user' );
print "Dump with annotations:\n$cds" if $trace;

is( ( scalar grep { /#/ } split //, $cds ),
    $expect_count, "check that $expect_count annotations are found" );

my $root3 = $model->instance(
    root_class_name => 'Master',
    instance_name   => 'test3'
)->config_root;

ok(
    $root3->load( step => $cds ),
    "set up data in tree with dumped data+annotation"
);

my $cds2 = $root3->dump_tree( mode => 'user' );
print "Dump second instance with annotations:\n$cds2" if $trace;

is( $cds2, $cds, "check both dumps" );

memory_cycle_ok( $model, "memory cycles" );

done_testing;