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
|
#============================================================= -*-perl-*-
#
# t/core/config.t
#
# Test the Badger::Config module.
#
# Copyright (C) 2008 Andy Wardley. All Rights Reserved.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#========================================================================
use strict;
use warnings;
use lib qw( ./lib ../lib ../../lib );
use Badger::Config;
use Badger::Test
tests => 20,
debug => 'Badger::Config',
args => \@ARGV;
my $pkg = 'Badger::Config';
my $config = $pkg->new({ x => 10, y => 20 });
is( $config->x, 10, 'x is 10' );
is( $config->y, 20, 'y is y0' );
eval { $config->z };
like( $@, qr/Invalid method 'z' called on Badger::Config/, 'bad method' );
$config = $pkg->new( data => { x => 10, y => 20 }, items => 'a b c' );
is( $config->x, 10, 'x is 10' );
is( $config->y, 20, 'y is y0' );
ok( ! $config->a, 'a is undefined' );
ok( ! $config->b, 'b is undefined' );
ok( ! $config->c, 'c is undefined' );
#-----------------------------------------------------------------------
# test get() method
#-----------------------------------------------------------------------
package Wibble;
sub wobble {
return 'wubble';
}
package main;
$config = $pkg->new({
foo => {
bar => {
baz => [ 'wig', { wam => 'bam' } ],
},
},
yip => 'pee',
hoo => 'ray',
wibble => bless({ }, 'Wibble'),
});
ok( $config, 'got config with nested data' );
is( $config->get('yip'), 'pee', 'yippee' );
is( $config->get('hoo'), 'ray', 'hooray' );
is( $config->get('foo.bar.baz.0'), 'wig', 'wig' );
is( $config->get(['foo', 'bar','baz', 1, 'wam']), 'bam', 'wam bam' );
is( $config->get('wibble', 'wobble'), 'wubble', 'wibble wobble' );
#-----------------------------------------------------------------------
# examples from docs
#-----------------------------------------------------------------------
$config = Badger::Config->new(
user => {
name => {
given => 'Arthur',
family => 'Dent',
},
email => [
'arthur@dent.org',
'dent@heart-of-gold.com',
],
},
things => sub {
return ['The Book', 'Towel', sub { return { babel => 'fish' } } ]
},
);
is( $config->get('user', 'name', 'given'), 'Arthur', 'Arthur' );
is( $config->get('user.name.family'), 'Dent', 'Dent' );
is( $config->get(['user', 'email', '0']), 'arthur@dent.org', 'arthur@dent.org' );
is( $config->get([qw(user email 1)]), 'dent@heart-of-gold.com', 'dent@heart-of-gold.com' );
is( $config->get('things.2.babel'), 'fish', 'babel fish' );
# a trivial object class
package Example;
use base 'Badger::Base';
sub wibble {
return 'wobble';
}
package main;
$config = Badger::Config->new(
function => sub {
return {
object => Example->new(),
}
}
);
is( $config->get('function.object.wibble'), 'wobble', 'wobble' );
__END__
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4:
|
