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
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More 'no_plan';
use File::Spec::Functions qw(catfile);
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
my $class = 'ConfigReader::Simple';
my $method = 'get';
use_ok( $class );
can_ok( $class, $method );
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
my @Directives = qw( Test1 Test2 Test3 Test4 );
my $config = $class->new( "t/example.config", \@Directives );
isa_ok( $config, $class );
# get things that do exist
is( $config->get( 'Test3' ), 'foo', 'Test3 has right value' );
is( $config->Test3, 'foo' );
is( $config->get( 'Test2' ), 'Test 2 value', 'Test2 has right value' );
is( $config->Test2, 'Test 2 value' );
# get things that do exist, but look like false values to perl
is( $config->get( 'Zero' ), '0', 'Zero has right value as string' );
is( $config->get( 'Zero' ), 0,, 'Zero has right value as number' );
is( $config->get( 'Undef' ), '', 'Undef has right value (empty)' );
# get long lines
is( $config->get( 'Test10' ), 'foo bar baz', 'Continuation line has right value');
is( $config->Test10, 'foo bar baz') ;
# get things that do not exist
# using get
my $value = not defined $config->get( 'Test' );
ok( $value, 'Test has no value with get()' );
$value = not defined $config->Test;
ok( $value, 'Test has no value with AUTOLOAD' );
$value = not defined $config->get( 'Test5' );
ok( $value, 'Test5 has no value with get()' );
$value = not defined $config->Test5;
ok( $value, 'Test5 has no value with AUTOLOAD' );
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# # # # # Now try it with multiple files
$config = $class->new_multiple(
Files => [ qw( t/global.config t/example.config ) ] );
isa_ok( $config, $class );
# get things that do exist
is( $config->get( 'Test3' ), 'foo',
'Test3 has right value with AUTOLOAD' );
is( $config->get( 'Scope' ), 'Global',
'Scope has right value with AUTOLOAD' );
is( $config->get( 'Test2' ), 'Test 2 value',
'Test2 has right value with AUTOLOAD' );
is( $config->get( 'Test10'), 'foo bar baz',
'Test10 has right value with AUTOLOAD' );
# try it one at a time
{
my $config = $class->new( "t/example.config" );
is( $config->get( 'Test3' ), 'foo',
'Test3 has right value with get(), before global' );
is( $config->get( 'Test2' ), 'Test 2 value',
'Test2 has right value with get(), before global' );
is( $config->get( 'Test10' ), 'foo bar baz',
'Test10 has right value with get), before global' );
my $global = catfile( qw( t global.config ) );
ok( -e $global, "$global exists" );
ok( $config->add_config_file( $global), "Added $global" );
is( $config->get( 'Scope' ), 'Global',
"Scope has right value after adding $global" );
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# # # # # Now try it with multiple files with one missing
$config = $class->new_multiple(
Files => [ qw( t/missing.config t/global.config ) ] );
isa_ok( $config, $class );
# get things that do exist
is( $config->get( 'Scope' ), 'Global',
'Scope has right value with AUTOLOAD, missing file' );
# config should be undef
$config = eval {
no strict 'refs';
${ "${class}::Die" } = 1;
$class->new_multiple(
Files => [ qw( t/missing.config t/example.config ) ] );
};
like( $@, qr|\QCould not open configuration file [t/missing.config]| );
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# # # # # Now try it with a string
{
my $string = <<'STRING';
TestA Lear
TestB MacBeth
TestC Richard
STRING
$config = $class->new_string(
Strings => [ \$string ] );
isa_ok( $config, $class );
is( $config->get( 'TestA' ), 'Lear',
'TestA has right value (from string)' );
is( $config->get( 'TestB' ), 'MacBeth',
'TestB has right value (from string)' );
is( $config->get( 'TestC' ), 'Richard',
'TestC has right value (from string)' );
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# # # # # Now try it with a string with a continuation line
{
my $string = <<'STRING';
TestA King \
Lear
TestB MacBeth
TestC Richard
STRING
$config = $class->new_string(
Strings => [ \$string ] );
isa_ok( $config, $class );
is( $config->get( 'TestA' ), 'King Lear',
'TestA has right value (from string)' );
is( $config->get( 'TestB' ), 'MacBeth',
'TestB has right value (from string)' );
is( $config->get( 'TestC' ), 'Richard',
'TestC has right value (from string)' );
}
|
