# -*- cperl -*-
use ExtUtils::testlib;
use Test::More tests => 33;
use Test::Memory::Cycle;
use Config::Model;
use Config::Model::Value;
use Log::Log4perl qw(get_logger :levels);
use warnings;
no warnings qw(once);
use strict;
use Data::Dumper;
# use Config::Model::ObjTreeScanner;
use vars qw/$model/;
$model = Config::Model->new( legacy => 'ignore', );
my $arg = shift || '';
my $trace = $arg =~ /t/ ? 1 : 0;
my $log = $arg =~ /l/ ? 1 : 0;
Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
my $home = $ENV{HOME} || "";
my $log4perl_user_conf_file = "$home/.log4config-model";
if ( $log and -r $log4perl_user_conf_file ) {
Log::Log4perl::init($log4perl_user_conf_file);
}
else {
Log::Log4perl->easy_init($WARN);
}
ok( 1, "compiled" );
my @models = $model->load( Master => 't/big_model.pm' );
is_deeply(
\@models,
[qw/SubSlave2 SubSlave X_base_class2 X_base_class SlaveZ SlaveY Master/],
"check list of model declared in t/big_model.pm (taking order into account)"
);
$model->augment_config_class(
name => 'Master',
element => [
warn_if => {
type => 'leaf',
value_type => 'string',
warn_if_match => { 'foo' => { fix => '$_ = uc;' } },
},
warn_unless => {
type => 'leaf',
value_type => 'string',
warn_unless_match => { foo => { msg => '', fix => '$_ = "foo".$_;' } },
},
] );
my $inst = $model->instance(
root_class_name => 'Master',
instance_name => 'test1'
);
ok( $inst, "created dummy instance" );
my $root = $inst->config_root;
Config::Model::Exception::Any->Trace(1) if $trace =~ /e/;
my $step = qq!
warn_if=foobar
std_id:ab X=Bv -
std_id:ab2 -
std_id:bc X=Av -
std_id:"a b" X=Av -
std_id:"a b.c" X=Av -
tree_macro=mXY
hash_a:toto=toto_value
hash_a:titi=titi_value
hash_a:"ti ti"="ti ti value"
ordered_hash:z=1
ordered_hash:y=2
ordered_hash:x=3
lista=a,b,c,d
olist:0 X=Av -
olist:1 X=Bv -
my_reference="titi"
warp warp2 aa2="foo bar"
!;
$Config::Model::Value::nowarning = 1;
ok( $root->load( step => $step ), "set up data in tree" );
my @expected = (
[ '', 'lista' ],
[ '', 'lista:0' ],
[ 'back', 'lista:1' ],
[ '', 'lista:0' ],
[ 'for', 'lista' ],
[ '', 'lista:0' ],
[ '', 'lista:1' ],
[ '', 'lista:2' ],
[ '', 'lista:3' ],
[ '', 'hash_a' ],
[ '', 'hash_a:"ti ti"' ],
[ '', 'hash_a:titi' ],
[ '', 'hash_a:toto' ],
[ '', 'tree_macro' ],
[ '', 'a_string' ],
[ 'back', 'int_v' ],
[ '', 'a_string' ],
[ '', 'tree_macro' ],
[ '', 'hash_a:toto' ],
[ 'for', 'hash_a:titi' ],
[ '', 'hash_a:toto' ],
[ '', 'tree_macro' ],
[ '', 'a_string' ],
[ '', 'int_v' ],
[ 'back', 'warn_if' ],
[ 'bail', 'int_v' ],
);
my $steer = sub {
my ( $iter, $item ) = @_;
my ( $dir, $expect ) = @$item;
$iter->bail_out if $dir eq 'bail';
$iter->go_forward if $dir eq 'for';
$iter->go_backward if $dir eq 'back';
return @$item;
};
my $leaf_element_cb = sub {
my ( $iter, $data_r, $node, $element, $index, $leaf_object ) = @_;
print "test: leaf_element_cb called for ", $leaf_object->location, "\n"
if $trace;
my ( $dir, $expect ) = $steer->( $iter, shift @expected );
is( $leaf_object->location, $expect, "leaf_element_cb got $expect and '$dir'" );
};
my $int_cb = sub {
my ( $iter, $data_r, $node, $element, $index, $leaf_object ) = @_;
print "test: int_cb called for ", $leaf_object->location, "\n"
if $trace;
my ( $dir, $expect ) = $steer->( $iter, shift @expected );
is( $leaf_object->location, $expect, "int_cb got $expect and '$dir'" );
};
my $hash_element_cb = sub {
my ( $iter, $data_r, $node, $element, @keys ) = @_;
print "test: hash_element_cb called for ", $node->location, " element $element\n"
if $trace;
my $obj = $node->fetch_element($element);
my ( $dir, $expect ) = $steer->( $iter, shift @expected );
is( $obj->location, $expect, "hash_element_cb got $expect and '$dir'" );
};
my $list_element_cb = sub {
my ( $iter, $data_r, $node, $element, @idx ) = @_;
print "test: list_element_cb called for ", $node->location, " element $element\n"
if $trace;
my $obj = $node->fetch_element($element);
my ( $dir, $expect ) = $steer->( $iter, shift @expected );
is( $obj->location, $expect, "list_element_cb got $expect and '$dir'" );
};
my $iterator = $inst->iterator(
leaf_cb => $leaf_element_cb,
integer_value_cb => $int_cb,
hash_element_cb => $hash_element_cb,
list_element_cb => $list_element_cb,
call_back_on_warning => 1,
call_back_on_important => 1,
);
ok( $iterator, "created iterator helper" );
$iterator->start;
is_deeply( \@expected, [], "iterator explored all items" );
memory_cycle_ok($model);