File: backend_ini.t

package info (click to toggle)
libconfig-model-perl 2.021-3%2Bdeb7u1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 3,104 kB
  • sloc: perl: 20,550; makefile: 11
file content (151 lines) | stat: -rw-r--r-- 4,093 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
# -*- cperl -*-

use ExtUtils::testlib;
use Test::More ;
use Test::Memory::Cycle;
use Config::Model;
use File::Path;
use File::Copy ;
use Data::Dumper ;
use Log::Log4perl qw(:easy) ;

use warnings;
no warnings qw(once);

use strict;


my $arg = shift || '';

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

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);
}
Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;

plan tests => 65;

ok(1,"compiled");

# pseudo root where config files are written by config-model
my $wr_root = 'wr_root/';

# set_up data
my @with_semi_column_comment = my @with_hash_comment = <DATA> ;
# change delimiter comments
map {s/#/;/;} @with_semi_column_comment ;
my %test_setup = ( IniTest  => [ \@with_hash_comment , 'class1' ], 
                   IniTest2 => [ \@with_semi_column_comment, 'class1' ],
                   AutoIni  => [ \@with_hash_comment, 'class1' ],
                   MyClass  => [ \@with_hash_comment, 'any_ini_class:class1' ]
                 );

foreach my $test_class (sort keys %test_setup) {
    my $model = Config::Model -> new () ;
    my @orig = @{$test_setup{$test_class}[0]} ;
    my $test_path = $test_setup{$test_class}[1] ;

    # cleanup before tests
    rmtree($wr_root);

    ok(1,"Starting $test_class tests");

    my $test1 = 'ini1' ;
    my $wr_dir = $wr_root.'/'.$test1 ;
    my $conf_file = "$wr_dir/etc/test.ini" ;

    mkpath($wr_dir.'/etc', { mode => 0755 }) 
        || die "can't mkpath: $!";
    open(CONF,"> $conf_file" ) || die "can't open $conf_file: $!";
    print CONF @orig ;
    close CONF ;

    my $i_test = $model->instance(  instance_name    => 'test_inst',
                                    root_class_name  => $test_class,
                                    root_dir    => $wr_dir ,
                                    model_file       => 't/test_ini_backend_model.pl',
                                 );

    ok( $i_test, "Created $test_class instance" );


    my $i_root = $i_test->config_root ;
   
    $i_root->load("bar:0=\x{263A}") ; # utf8 smiley

    is($i_root->annotation,"some global comment","check global comment");
    is($i_root->grab($test_path)->annotation,"class1 comment",
        "check $test_path comment");

    my $lista_obj = $i_root->grab($test_path)->fetch_element('lista');
    is($lista_obj->annotation, '',"check $test_path lista comment"); 

    foreach my $i (1 .. 3) {
        my $elt = $lista_obj->fetch_with_id($i - 1) ;
        is($elt->fetch,"lista$i","check lista[$i] content");
        is($elt->annotation,
            "lista$i comment","check lista[$i] comment");
    } 

    my $orig = $i_root->dump_tree ;
    print $orig if $trace ;

    $i_test->write_back ;
    ok(1,"IniFile write back done") ;

    my $ini_file      = $wr_dir.'/etc/test.ini';
    ok(-e $ini_file, "check that config file $ini_file was written");

    # create another instance to read the IniFile that was just written
    my $wr_dir2 = $wr_root.'/ini2' ;
    mkpath($wr_dir2.'/etc',{ mode => 0755 })   || die "can't mkpath: $!";
    copy($wr_dir.'/etc/test.ini',$wr_dir2.'/etc/') 
        or die "can't copy from test1 to test2: $!";

    my $i2_test = $model->instance(instance_name    => 'test_inst2',
                                   root_class_name  => $test_class,
                                   root_dir    => $wr_dir2 ,
                                  );

    ok( $i2_test, "Created instance" );


    my $i2_root = $i2_test->config_root ;

    my $p2_dump = $i2_root->dump_tree ;

    is($p2_dump,$orig,"compare original data with 2nd instance data") ;

    memory_cycle_ok($model,"memory cycle test");

}


__DATA__
#some global comment


# foo1 comment
foo = foo1

foo = foo2 # foo2 comment

bar = bar1

baz = bazv

# class1 comment
[class1]
lista=lista1 #lista1 comment
# lista2 comment
lista    =    lista2 
# lista3 comment
lista    =    lista3