# -*- cperl -*-
# $Author: ddumont $
# $Date: 2009-06-22 14:02:02 +0200 (Mon, 22 Jun 2009) $
# $Revision: 978 $

use warnings FATAL => qw(all);

use ExtUtils::testlib;
use Test::More;
use Config::Model;
use Config::Model::ValueComputer ;

BEGIN { plan tests => 59; }

use strict;

my $arg = shift || '';

my $trace = $arg =~ /t/ ? 1 : 0 ;
$::verbose          = 1 if $arg =~ /v/;
$::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");

my $model = Config::Model->new(legacy => 'ignore',) ;
$model ->create_config_class 
  (
   name => "RSlave",
   element 
   => [ 
       recursive_slave 
       => {
	   type => 'hash',
	   index_type => 'string',
	   cargo_type => 'node',
	   config_class_name => 'RSlave' ,
	  },
       big_compute
       => {
	   type => 'hash',
	   index_type => 'string',
	   cargo_type => 'leaf',
	   cargo_args 
	   => {
	       value_type => 'string',
	       compute    => ['macro is $m, my idx: &index, '
			      .'my element &element, '
			      .'upper element &element($up), '
			      .'up idx &index($up)',
			      'm'  => '!  macro',
			      up => '-'
			     ]
	      },
	  },
       big_replace
       => {
	   type => 'leaf',
	   value_type => 'string',
	   compute    => [
			  'trad idx $replace{&index($up)}',
			  up      => '-',
			  replace => {
				      l1 => 'level1',
				      l2 => 'level2'
				     }
			 ]
	  },
       macro_replace
       => {
	   type => 'hash',
	   index_type => 'string',
	   cargo_type => 'leaf',
	   cargo_args 
	   => {
	       value_type => 'string',
	       compute    => [
			      'trad macro is $macro{$m}',
			      'm'     => '!  macro',
			      macro => {
					A => 'macroA',
					B => 'macroB',
					C => 'macroC'
				       }
			     ]
	      },
	  }
      ],
   );

$model -> create_config_class 
  (
   name => "Slave",

   'element'
   =>  [
	[qw/X Y Z/] => {
			type => 'leaf',
			value_type => 'enum',
			choice     => [qw/Av Bv Cv/],
			warp       => {
				       follow => '- - macro',
				       rules => { A => { default => 'Av' },
						  B => { default => 'Bv' }
						}
				      }
		       },
	'recursive_slave'
	=> {
	    type => 'hash',
            index_type => 'string',
	    cargo_type => 'node',
	    config_class_name => 'RSlave',
	   },
	W => {
	      type => 'leaf',
	      value_type => 'enum',
	      level => 'hidden',
	      warp => {
		       follow => '- - macro',
		       'rules' 
		       => {
			   A => {
				 default    => 'Av',
				 level      => 'normal',
				 experience => 'beginner',
				 choice     => [qw/Av Bv Cv/],
				},
			   B => {
				 default    => 'Bv',
				 level      => 'normal',
				 experience => 'advanced',
				 choice     => [qw/Av Bv Cv/]
				}
			  }
		      },
	     },
	Comp => {
		 type => 'leaf',
		 value_type => 'string',
		 compute    => [ 'macro is $m', 'm' => '- - macro' ],
		},
       ]
  );

$model -> create_config_class 
  (
   name => "Master",
   element 
   => [
       get_element => {
		    type => 'leaf',
		    value_type => 'enum',
		    choice     => [qw/m_value_element compute_element/]
		    },
       where_is_element => {
			 type => 'leaf',
			 value_type => 'enum',
			 choice     => [qw/get_element/]
			},
       macro => {
		 type => 'leaf',
		 value_type => 'enum',
		 mandatory => 1,
		 choice     => [qw/A B C D/]
		},
       macro2 => {
		  type => 'leaf',
		  value_type => 'enum', 
		  level => 'hidden',
		  warp => {  follow => '- macro',
			     'rules'
			     => [ "B"
				  => {
				      level => 'normal',
				      choice     => [qw/A B C D/]
				     },
				]
			  }
		},
       'm_value' => {
		     type => 'leaf',
		     value_type => 'enum',
		     'warp'
		     => {
			 follow => { m => '- macro' },
			 'rules' 
			 => [
			     '$m eq "A" or $m eq "D"'
			     => { choice => [qw/Av Bv/],
				  help => { Av => 'Av help'} ,
				},
			     '$m eq "B"' => { choice => [qw/Bv Cv/],
					    help   => { Bv => 'Bv help'} ,
					  },
			     '$m eq "C"' => { choice => [qw/Cv/],
					    help   => { Cv => 'Cv help' } ,
					  }
			    ]
			}
		    },
       'm_value_old' => {
		     type => 'leaf',
		     value_type => 'enum',
		     'warp'
		     => {
			 follow => '- macro',
			 'rules' 
			 => [
			     [qw/A D/] => { choice => [qw/Av Bv/],
					    help => { Av => 'Av help'} ,
					  },
			     B => { choice => [qw/Bv Cv/],
				    help   => { Bv => 'Bv help'} ,
				  },
			     C => { choice => [qw/Cv/],
				    help   => { Cv => 'Cv help' } ,
				  }
			    ]
			}
		    },
       'compute' 
       => {
	   type => 'leaf',
	   value_type => 'string',
	   compute    => [ 'macro is $m, my element is &element', 'm' => '!  macro' ]
	  },

       'var_path' 
       => {
	   type => 'leaf',
	   value_type => 'string',
	   mandatory => 1 , # will croak if value cannot be computed
	   compute
	   => [
	       'get_element is $element_table{$s}, indirect value is \'$v\'',
	       's'        => '! $where',
	       where      => '! where_is_element',
	       v          => '! $element_table{$s}',
	       element_table => {qw/m_value_element m_value compute_element compute/}
	      ]
	  },

       'class' => {
		   type => 'hash',
		   index_type => 'string',
		   cargo_type => 'leaf',
		   cargo_args => { value_type => 'string' } ,
		  },
        'warped_out_ref'
        =>{
	   type => 'leaf',
	   refer_to => '! class',
	   value_type => 'reference', 
	   level => 'hidden',
	   warp => {  follow => { m => '- macro', m2 => '- macro2'},
		      rules  => [ '$m eq "A" or $m2 eq "A"' 
				  => { 
				      level => 'normal',
				     },
				]
 		  }
	  },

       [qw/bar foo foo2/ ] => {
			       type => 'node',
			       config_class_name => 'Slave'
			      },
       'ClientAliveCheck',
       {
	'value_type' => 'boolean',
	'built_in' => '0',
	'type' => 'leaf',
       },
       'ClientAliveInterval',
       {
	'value_type' => 'integer',
	'level' => 'hidden',
	'min' => '1',
	'warp' => {
		   'follow' => {
				'c_a_check' => '- ClientAliveCheck'
			       },
		   'rules' => [
			       '$c_a_check == 1',
			       {
				'level' => 'normal'
			       }
			      ]
		  },
	'type' => 'leaf'
       },
      ]
  );

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

my $root = $inst -> config_root ;

is_deeply( [$root->get_element_name(for => 'beginner')],
	   [qw'get_element where_is_element macro compute var_path class bar foo foo2
	       ClientAliveCheck'], 
	   "Elements of Master"
	 );

# query the model instead of the instance
is_deeply( [$model->get_element_name(class => 'Slave',
				     for => 'beginner')
	   ],
	   [qw'X Y Z recursive_slave Comp'], 
	   "Elements of Slave from the model"
	 );

my $slave = $root-> fetch_element('bar') ;
ok($slave,"Created slave(bar)");

is_deeply( [$slave->get_element_name(for => 'beginner')],
	   [qw'X Y Z recursive_slave Comp'], 
	   "Elements of Slave from the object"
	 );
my $result ;
eval { $result = $slave->fetch_element('W')->fetch ;} ;
ok($@,"reading slave->W (undef value_type error)") ;
print "normal error: $@" if $trace;

is($slave->fetch_element('X')->fetch , undef,
  "reading slave->X (undef)") ;

is($root->fetch_element('macro')->store('B'), 'B',
   "setting master->macro to B") ;

is_deeply( [$root->get_element_name(for => 'beginner')],
	   [qw'get_element where_is_element macro macro2 m_value
	   m_value_old compute var_path class bar foo foo2
	   ClientAliveCheck'],
	   "Elements of Master when macro = B" );

is($root->fetch_element('macro2')->store('A'), 'A',
   "setting master->macro2 to A") ;

is_deeply( [$root->get_element_name(for => 'beginner')],
	   [qw'get_element where_is_element macro macro2 
	       m_value m_value_old compute var_path class warped_out_ref bar 
	       foo foo2 ClientAliveCheck'], 
	   "Elements of Master when macro = B macro2 = A"
	 );

$root->fetch_element('class')->fetch_with_id('foo')->store('foo_v') ;
$root->fetch_element('class')->fetch_with_id('bar')->store('bar_v') ;

is($root->fetch_element('warped_out_ref')->store('foo'), 'foo',
   "setting master->warped_out_ref to foo") ;

is($root->fetch_element('macro')->store('A'), 'A',
   "setting master->macro to A") ;

map {is($slave->fetch_element($_)->fetch , 'Av',
	"reading slave->$_ (Av)") ; } qw/X Y Z/;

is($root->fetch_element('macro')->store('C'), 'C',
   "setting master->macro to C") ;

is($root->fetch_element('m_value')->get_help('Cv') , 'Cv help',
   'test m_value help with macro=C') ;

is($slave->fetch_element('X')->fetch , undef,
  "reading slave->X (undef)") ;

$root->fetch_element('macro')->store('A') ;

is($root->fetch_element('m_value')->store('Av') , 'Av',
   'test m_value with macro=A') ;

is($root->fetch_element('m_value_old')->store('Av') , 'Av',
   'test m_value_old with macro=A') ;

is($root->fetch_element('m_value')->get_help('Av') , 'Av help',
   'test m_value help with macro=A') ;

is($root->fetch_element('m_value')->get_help('Cv') , undef ,
   'test m_value help with macro=A') ;

$root->fetch_element('macro')->store('D') ;

is($root->fetch_element('m_value')->fetch , 'Av',
   'test m_value with macro=D') ;

is($root->fetch_element('m_value_old')->fetch , 'Av',
   'test m_value_old with macro=D') ;

$root->fetch_element('macro')->store('A') ;

is_deeply( [$slave->get_element_name(for => 'beginner')],
	   [qw/X Y Z recursive_slave W Comp/], 
	   "Slave elements from the object (W pops in when macro is set to A)"
	 );
$root->fetch_element('macro')->store('B') ;

is_deeply( [$slave->get_element_name(for => 'beginner')],
	   [qw/X Y Z recursive_slave Comp/], 
	   "Slave elements from the object (W's out when macro is set to B)"
	 );
is_deeply( [$slave->get_element_name(for => 'advanced')],
	   [qw/X Y Z recursive_slave W Comp/], 
	   "Slave elements from the object for advanced level"
	 );

map {is($slave->fetch_element($_)->fetch , 'Bv',
	"reading slave->$_ (Bv)") ; } qw/X Y Z/;

is($slave->fetch_element('Y')->store('Cv'), 'Cv',
   'Set slave->Y to Cv');


# testing warp in warp out
$root->fetch_element('macro')->store('C') ;
is( $slave->is_element_available(name => 'W', experience => 'advanced'),
    0, " test W is not available") ;
$root->fetch_element('macro')->store('B') ;
is( $slave->is_element_available(name => 'W', experience => 'advanced'),
    1, " test W is available") ;

$root->fetch_element('macro')->store('C') ;

map {is($slave->fetch_element($_)->fetch , undef,
	"reading slave->$_ (undef)") ; } qw/X Z/;
is($slave->fetch_element('Y')->fetch , 'Cv',
	"reading slave->Y (Cv)") ;

is($slave->fetch_element('Comp')->fetch , 'macro is C',
	"reading slave->Comp") ;

is($root->fetch_element('m_value')->store('Cv'), 'Cv',
   'set m_value to Cv'
  );

my $rslave1  = $slave  ->fetch_element('recursive_slave')->fetch_with_id('l1');
my $rslave2  = $rslave1->fetch_element('recursive_slave')->fetch_with_id('l2') ;
my $big_compute_obj 
             = $rslave2->fetch_element('big_compute')    ->fetch_with_id('b1');

isa_ok($big_compute_obj,'Config::Model::Value',
       'Created new big compute object'
      ) ;

my $txt   = 'macro is $m, my idx: &index, my element &element, ';
my $rules = {
    m   => '! macro',
    up  => '-',
    up2 => '- -',
};

my $parser = new Parse::RecDescent ($Config::Model::ValueComputer::compute_grammar) ;

# the 2 next tests are used to check what going on before trying the
# real test below. But beware, the error messages for these 2 tests
# might be misleading.
my $str_r = $parser->pre_compute( $txt, 1, $big_compute_obj, $rules );
is( $$str_r, 'macro is $m, my idx: b1, my element big_compute, ' ,
  "testing pre_compute with & and &index on \$big_compute_obj");

$txt .= 'upper elements &element($up2) &element($up), up idx &index($up2) &index($up)';

$str_r = $parser->pre_compute( $txt, 1, $big_compute_obj, $rules );

is( $$str_r,
          'macro is $m, my idx: b1, my element big_compute, '
        . 'upper elements recursive_slave recursive_slave, up idx l1 l2',
  "testing pre_compute with &element(stuff) and &index(\$stuff)");

my $bc_val  
  = $rslave2->fetch_element('big_compute')->fetch_with_id("test_1")->fetch;

is( $bc_val,
    'macro is C, my idx: test_1, my element big_compute, upper element recursive_slave, up idx l2',
    'reading slave->big_compute(test1)'
);


is( $big_compute_obj->fetch,
    'macro is C, my idx: b1, my element big_compute, upper element recursive_slave, up idx l2',
    'reading slave->big_compute(b1)'
);

is( $rslave1->fetch_element('big_replace')->fetch(),
    'trad idx level1',
    'reading rslave1->big_replace(br1)');

is( $rslave2->fetch_element('big_replace')->fetch(),
    'trad idx level2',
    'reading rslave2->big_replace(br1)');

is( $rslave1->fetch_element('macro_replace')->fetch_with_id('br1')->fetch,
    'trad macro is macroC',
    'reading rslave1->macro_replace(br1)');

is( $rslave2->fetch_element('macro_replace')->fetch_with_id('br1')->fetch,
    'trad macro is macroC',
    'reading rslave2->macro_replace(br1)');

is( $root->fetch_element('compute')->fetch(),
    'macro is C, my element is compute',
    'reading root->compute');

my @masters = $root->fetch_element('macro')->get_depend_slave();
my @names = sort map { $_->name } @masters;
print "macro controls:\n\t", join( "\n\t", @names ), "\n"
    if $trace;

is( scalar @masters, 14,'reading macro slaves' );

is_deeply( \@names ,
	   [
	    'Master compute',
	    'Master m_value',
	    'Master m_value_old',
	    'Master macro2',
	    'Master warped_out_ref',
	    'bar Comp',
	    'bar W',
	    'bar X',
	    'bar Y',
	    'bar Z',
	    'bar recursive_slave:l1 macro_replace:br1',
	    'bar recursive_slave:l1 recursive_slave:l2 big_compute:b1',
	    'bar recursive_slave:l1 recursive_slave:l2 big_compute:test_1',
	    'bar recursive_slave:l1 recursive_slave:l2 macro_replace:br1',
	   ],
	   "check names of values using 'macro' element" );

Config::Model::Exception::Any->Trace(1);

eval { $root->fetch_element('var_path')->fetch; };
like( $@, qr/'! where_is_element' is undef/,
      'reading var_path while where_is_element variable is undef');

# set one variable of the formula
$root->fetch_element('where_is_element')->store('get_element');

eval { $root->fetch_element('var_path')->fetch; };
like( $@, qr/'! where_is_element' is 'get_element'/,
    'reading var_path while where_is_element is defined');
like( $@, qr/Mandatory value is not defined/,
    'reading var_path while get_element variable is undef');

# set the other variable of the formula
$root->fetch_element('get_element')->store('m_value_element');

is($root->fetch_element('var_path')->fetch(),
   'get_element is m_value, indirect value is \'Cv\'',
   "reading var_path through m_value element");

# modify the other variable of the formula
$root->fetch_element('get_element')->store('compute_element');

is($root->fetch_element('var_path')->fetch(),
   'get_element is compute, indirect value is \'macro is C, my element is compute\'',
   "reading var_path through compute element");

$root->fetch_element('ClientAliveCheck')-> store (0) ;

eval { $root->fetch_element('ClientAliveInterval')->fetch; };
like( $@, qr/unavailable element/,
    'reading ClientAliveInterval when ClientAliveCheck is 0');


$root->fetch_element('ClientAliveCheck')-> store (1) ;
$root->fetch_element('ClientAliveInterval')-> store (10) ;
is($root->fetch_element('ClientAliveInterval')-> fetch,10,"check ClientAliveInterval") ;
