scip/Config-General
1
0
Fork 0
mirror of https://codeberg.org/scip/Config-General.git synced 2025-12-16 20:21:01 +01:00
Code Issues Packages Projects Releases Wiki Activity

1.22: - added a new option to new(): -LowerCaseNames, which

Browse Source 
lowercases all option-names (feature request)


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@10 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:10:12 +00:00
parent 93316ddc2e
commit 1ffbf95665
4 changed files with 86 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
General.pm
View File

@@ -6,10 +6,14 @@
# given file and return it as hash
# structure
#
# Copyright (c) 2000 Thomas Linden <tom@daemon.de>.
# Copyright (c) 2000-2001 Thomas Linden <tom@daemon.de>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
# Changes from 1.21: - added a new option to new(): -LowerCaseNames, which
# lowercases all option-names (feature request)
# Changes from 1.20: - lines with just one "#" became an option array named
# "#" with empty entries, very weird, fixed
# Changes from 1.19: - added an if(exists... to new() for checking of the
# existence of -AllowMultiOptions.
# - use now "local $_" because it caused weird results
@@ -26,7 +30,7 @@ use FileHandle;
use strict;
use Carp;
$Config::General::VERSION = "1.20";
$Config::General::VERSION = "1.22";
sub new {
#
@@ -50,6 +54,11 @@ sub new {
$self->{NoMultiOptions} = 1;
}
}
if (exists $conf{-LowerCaseNames}) {
if ($conf{-LowerCaseNames}) {
$self->{LowerCaseNames} = 1;
}
}
}
elsif ($#param == 0) {
# use of the old style
@@ -210,6 +219,7 @@ sub _parse {
if ($blockname) {
$block = $grab;
}
$block = lc($block) if $this->{LowerCaseNames}; # only for blocks lc(), if configured via new()
undef @newcontent;
next;
}
@@ -217,6 +227,7 @@ sub _parse {
croak "EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
}
else { # insert key/value pair into actual node
$option = lc($option) if $this->{LowerCaseNames};
if ($this->{NoMultiOptions}) { # configurable via special method ::NoMultiOptions()
if (exists $config->{$option}) {
croak "Option $config->{$option} occurs more than once (level: $this->{level}, chunk $chunk)!\n";
@@ -244,7 +255,7 @@ sub _parse {
}
elsif (/^<\/(.+?)>$/) {
if ($block_level) { # this endblock is not the one we are searching for, decrement and push
$block_level--; # if it is 0 the the endblock was the one we searched for, see below
$block_level--; # if it is 0, then the endblock was the one we searched for, see below
push @newcontent, $_; # push onto new content stack
}
else { # calling myself recursively, end of $block reached, $block_level is 0
@@ -388,6 +399,7 @@ Possible ways to call B<new()>:
$conf = new Config::General(
-file => "rcfile",
-AllowMultiOptions => "no"
-LowerCaseNames => "yes"
);
$conf = new Config::General(
@@ -410,6 +422,9 @@ still supported. Possible parameters are:
-hash - a hash reference.
-AllowMultiOptions - if the value is "no", then multiple
identical options are disallowed.
-LowerCaseNames - if true (1 or "yes") then all options found
in the config will be converted to lowercase.
This allows you to provide case-in-sensitive configs
=item NoMultiOptions()
@@ -542,6 +557,32 @@ The hash which the method B<getall> returns look like that:
'user' => 'hans'
};
If you have turned on B<-LowerCaseNames> (see new()) then blocks as in the
following example:
<Dir>
<AttriBUTES>
Owner root
</attributes>
</dir>
would produce the following hash structure:
$VAR1 = {
'dir' => {
'attributes' => {
'owner => "root",
}
}
};
As you can see, the keys inside the config hash are normalized.
Please note, that the above config block would result in a
valid hash structure, even if B<-LowerCaseNames> is not set!
This is because I<Config::General> does not
use the blocknames to check if a block ends, instead it uses an internal
state counter, which indicates a block end.
If the module cannot find an end-block statement, then this block will be ignored.
@@ -740,7 +781,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
1.20
1.22
=cut

29
t/cfg.7
View File

@@ -1,27 +1,8 @@
<cops>
<officer randall>
# Case insensitive block test
<Cops>
<OFFICER randall>
name stein
age 25
</officer>
<officer gordon>
name bird
age 31
</officer>
</cops>
domain b0fh.org
domain l0pht.com
domain infonexus.com
message <<EOF
yes. we are not here. you
can reach us somewhere in
outerspace.
EOF
command = ssh -f -g orpheus.0x49.org \
-l azrael -L:34777samir.okir.da.ru:22 \
-L:31773:shane.sol1.rocket.de:22 \
'exec sleep 99999990'
user = tom
passwd = sakkra
<db>
host = blah.blubber
</db>
</copS>

27
t/cfg.8 Normal file
View File

@@ -0,0 +1,27 @@
<cops>
<officer randall>
name stein
age 25
</officer>
<officer gordon>
name bird
age 31
</officer>
</cops>
domain b0fh.org
domain l0pht.com
domain infonexus.com
message <<EOF
yes. we are not here. you
can reach us somewhere in
outerspace.
EOF
command = ssh -f -g orpheus.0x49.org \
-l azrael -L:34777samir.okir.da.ru:22 \
-L:31773:shane.sol1.rocket.de:22 \
'exec sleep 99999990'
user = tom
passwd = sakkra
<db>
host = blah.blubber
</db>

15
t/run.t
View File

@@ -4,17 +4,18 @@
# the Conf.pm source directory.
# Under normal circumstances every test should run.
BEGIN { $| = 1; print "1..7\n";}
BEGIN { $| = 1; print "1..8\n";}
use lib "blib/lib";
use Config::General;
use Data::Dumper;
print "ok\n";
print STDERR "\n1 .. ok # loading Config::General\n";
foreach (2..6) {
foreach (2..7) {
&p("t/cfg." . $_, $_);
}
my $conf = new Config::General("t/cfg.7");
my $conf = new Config::General("t/cfg.8");
my %hash = $conf->getall;
$conf->save("t/cfg.out", %hash);
@@ -25,14 +26,14 @@ my $a = \%hash;
my $b = \%copyhash;
# now see if the saved hash is still the same as the
# one we got from cfg.7
# one we got from cfg.8
if (&comp($a,$b)) {
print "ok\n";
print STDERR "7 .. ok # Writing Config Hash to disk and compare with original\n";
print STDERR "8 .. ok # Writing Config Hash to disk and compare with original\n";
}
else {
print "7 not ok\n";
print STDERR "7 .. not ok\n";
print "8 not ok\n";
print STDERR "8 .. not ok\n";
}