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

use warnings FATAL => qw(all);

use ExtUtils::testlib;
use Test::More tests => 19;
use Test::Memory::Cycle;
use Config::Model ;

use strict;

my $arg = shift || '';

my $trace = $arg =~ /t/ ? 1 : 0 ;
$::debug            = 1 if $arg =~ /d/;
Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;

use Log::Log4perl qw(:easy) ;
Log::Log4perl->easy_init($arg =~ /l/ ? $TRACE: $WARN);

ok(1,"Compilation done");

# minimal set up to get things working
my $model = Config::Model->new(legacy => 'ignore',) ;
$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' ,
			 refer_to => [ '  ! host:$h if ', h => '- host' ]
		       },
	       ip => { type => 'leaf',
		       value_type => 'string',
		       compute    => [
				      '$ip',
				      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_and_choice => { type => 'leaf',
				    value_type => 'reference' ,
				    refer_to => [ '! host ' ],
				    choice => [qw/foo bar/]
				  },
	       dumb_list => { type => 'list',
			      cargo_type => 'leaf',
			      cargo_args => {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"
	 ) ;

eval { $root->fetch_element("refer_to_wrong_path") ; } ;
ok($@,"fetching refer_to_wrong_path") ;
print "normal error: $@" if $trace;

eval { $root->fetch_element("refer_to_unknown_elt") } ;
ok($@,"fetching refer_to_unknown_elt") ;
print "normal error: $@" if $trace;
memory_cycle_ok($model);