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
|
use Test::More tests => 19;
use Test::Output;
my $class = 'ConfigReader::Simple';
use_ok( $class );
my @Directives = qw( Test1 Test2 Test3 Test4 );
my $config = $class->new( "t/example.config", \@Directives );
isa_ok( $config, $class );
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# set things that do exist
foreach my $pair (
[ qw(Test1 Foo)] , [ qw(Pagagena Papageno) ], [ qw(Tamino Pamina) ] )
{
my $key = $pair->[0];
my $value = $pair->[1];
$config->set( $key, $value );
is( $config->get( $key ), $value,
"$key has the right value with get" );
is( $config->$key, $value,
"$key has the right value with autoload" );
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Setting things to references should fail: With $Die set
{
no warnings 'once';
local $ConfigReader::Simple::Die = 1;
my $config = $class->new;
isa_ok( $config, $class );
my $rc = eval { $class->set( 'Cat', \ 'Buster' ) };
my $at = $@;
ok( length $at, '$@ is set while trying to set with a scalar reference' );
like( $at, qr/must be a simple scalar/ );
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Setting things to references should fail: With $Die not set, $Warn set
{
no warnings 'once';
local $ConfigReader::Simple::Die = undef;
local $ConfigReader::Simple::Warn = 1;
local $SIG{__WARN__} = sub { print STDERR @_ };
my $config = $class->new;
isa_ok( $config, $class );
stderr_like
{ $class->set( 'Cat', \ 'Buster' ) }
qr/must be a simple scalar/,
'set complains when $Warn is set and given a reference';
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Setting things to references should fail: With $Die not set, $Warn not set
{
no warnings 'once';
local $ConfigReader::Simple::Die = undef;
local $ConfigReader::Simple::Warn = undef;
local $SIG{__WARN__} = sub { print STDERR @_ };
my $config = $class->new;
isa_ok( $config, $class );
stderr_like
{ $class->set( 'Cat', \ 'Buster' ) }
qr/^$/,
'set silent when $Warn, $Die are unset and given a reference';
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# unset things that do exist
{
my $directive = 'Test2';
ok( $config->unset( $directive ), "Unset thing that exists [$directive]" );
my $not_defined = not defined $config->$directive;
ok( $not_defined, "Unset thing [$directive] still has value" );
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# unset things that do not exist
{
my $directive = 'Tenor';
my $value = not $config->unset( $directive );
ok( $value, 'Unset thing that does not exist [$directive]' );
$value = not $config->exists( $directive );
ok( $value, 'Unset thing that did not exist [$directive] exists' );
}
|
