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

2.40

Browse Source 
- fixed SplitDelimiter parser regex, it does no more consider
	  non-whitespaces (\S+?) as the option name but anything
	  before the delimiter (.+?), this fixes bug rt.cpan.org#36607,
	  the fix of 2.39 were not sufficient. Thanks to
	  Jeffrey Ratcliffe for pointing it out.

	- added new parameter -SaveSorted. The default value is 0,
	  that means configs will be saved unsorted (as always),
	  however if you want to save it sorted, turn this parameter
	  to 1. Thanks to Herbert Breunung for the hint.

	- added complexity test, which checks a combination
	  of various complex features of the parser.


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@66 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:44:49 +00:00
parent 5f92f52e0a
commit d6b03e1ef7
6 changed files with 254 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
Changelog
View File

@@ -1,3 +1,18 @@
2.40
- fixed SplitDelimiter parser regex, it does no more consider
non-whitespaces (\S+?) as the option name but anything
before the delimiter (.+?), this fixes bug rt.cpan.org#36607,
the fix of 2.39 were not sufficient. Thanks to
Jeffrey Ratcliffe for pointing it out.
- added new parameter -SaveSorted. The default value is 0,
that means configs will be saved unsorted (as always),
however if you want to save it sorted, turn this parameter
to 1. Thanks to Herbert Breunung for the hint.
- added complexity test, which checks a combination
of various complex features of the parser.
2.39
- fixed rt.cpan.org#35122. This one was one of the most
intriguing bugs I've ever observed in my own code. The

40
General.pm
View File

@@ -32,7 +32,7 @@ use Carp::Heavy;
use Carp;
use Exporter;
$Config::General::VERSION = 2.39;
$Config::General::VERSION = 2.40;
use vars qw(@ISA @EXPORT_OK);
use base qw(Exporter);
@@ -80,7 +80,8 @@ sub new {
Tie => q(), # could be set to a perl module for tie'ing new hashes
parsed => 0, # internal state stuff for variable interpolation
files => {}, # which files we have read, if any
UTF8 => 0
UTF8 => 0,
SaveSorted => 0
};
# create the class instance
@@ -661,7 +662,7 @@ sub _read {
}
else {
# no guess, use one of the configured strict split policies
if (/^\s*(\S+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) {
if (/^\s*(.+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) {
$hier = $1; # the actual here-doc variable name
$hierend = $3; # the here-doc identifier, i.e. "EOF"
next;
@@ -1160,6 +1161,31 @@ sub _store {
my $config_string = q();
if($this->{SaveSorted}) {
# ahm, well this might look strange because the two loops
# are obviously the same, but I don't know how to call
# a foreach() with sort and without sort() on the same
# line (I think it's impossible)
foreach my $entry (sort keys %config) {
if (ref($config{$entry}) eq 'ARRAY') {
foreach my $line (sort @{$config{$entry}}) {
if (ref($line) eq 'HASH') {
$config_string .= $this->_write_hash($level, $entry, $line);
}
else {
$config_string .= $this->_write_scalar($level, $entry, $line);
}
}
}
elsif (ref($config{$entry}) eq 'HASH') {
$config_string .= $this->_write_hash($level, $entry, $config{$entry});
}
else {
$config_string .= $this->_write_scalar($level, $entry, $config{$entry});
}
}
}
else {
foreach my $entry (keys %config) {
if (ref($config{$entry}) eq 'ARRAY') {
foreach my $line (@{$config{$entry}}) {
@@ -1178,6 +1204,7 @@ sub _store {
$config_string .= $this->_write_scalar($level, $entry, $config{$entry});
}
}
}
return $config_string;
}
@@ -1832,6 +1859,11 @@ explicit empty blocks.
If turned on, all files will be opened in utf8 mode. This may
not work properly with older versions of perl.
=item B<-SaveSorted>
If you want to save configs in a sorted manner, turn this
parameter on. It is not enabled by default.
=back
@@ -2462,7 +2494,7 @@ Thomas Linden <tlinden |AT| cpan.org>
=head1 VERSION
2.39
2.40
=cut

28
t/complex.cfg Normal file
View File

@@ -0,0 +1,28 @@
# complexity test
var1 = zero # comment
var2 = zeppelin /* another comment */
/*
to be ignored
*/
line = a\
long line
var3 = blah
set = $var3
ignore = \$set
quote = this should be 'kept: $set' and not be '$set!'
host = gw.intx.foo
cmd = mart@${host}:22
onflag = yes
offflag = No
<<include complex/n*.cfg>>
a [[weird]] heredoc = <<EOF
has to
work
too!
EOF
auch <20>tzendes = muss gehen
someflags = LOCK | RW | TAINT
imported = got $this from $default config
<hansa>
<<include complex/n2.cfg>>
</hansa>

16
t/complex/n1.cfg Normal file
View File

@@ -0,0 +1,16 @@
<a>
<b>
x = 9323
z = 000
<m $x>
g = $z
long = another long \
line
</m>
/*
please ignore this */
</b>
<b>
z = rewe
</b>
</a>

17
t/complex/n2.cfg Normal file
View File

@@ -0,0 +1,17 @@
<Directory />
mode = 755
</Directory>
<Files "~/*.pl">
Options = +Indexes
</Files>
nando = 11111
<z1>
blak = $nando
nando = 9999
</z1>
<x5>
klack = $nando
</x5>
<block 0>
value = 0
</block>

130
t/run.t
View File

@@ -8,7 +8,7 @@
use Data::Dumper;
use Test::More tests => 47;
use Test::More tests => 49;
#use Test::More qw(no_plan);
### 1
@@ -487,3 +487,131 @@ my $expect46 = {
'foo' => 'bar'
};
is_deeply($expect46, \%conf46, "Variables inside single quotes");
# complexity test
# check the combination of various features
my $conf47 = new Config::General(
-ConfigFile => "t/complex.cfg",
-InterPolateVars => 1,
-DefaultConfig => { this => "that", default => "imported" },
-MergeDuplicateBlocks => 1,
-MergeDuplicateOptions => 1,
-StrictVars => 1,
-SplitPolicy => 'custom',
-SplitDelimiter => '\s*=\s*',
-IncludeGlob => 1,
-IncludeAgain => 1,
-IncludeRelative => 1,
-AutoTrue => 1,
-FlagBits => { someflags => { LOCK => 1, RW => 2, TAINT => 3 } },
-StoreDelimiter => ' = ',
-SlashIsDirectory => 1,
-SaveSorted => 1
);
my %conf47 = $conf47->getall();
my $expect47 = {
'var3' => 'blah',
'z1' => {
'blak' => '11111',
'nando' => '9999'
},
'a' => {
'b' => {
'm' => {
'9323' => {
'g' => '000',
'long' => 'another long line'
}
},
'x' => '9323',
'z' => 'rewe'
}
},
'onflag' => 1,
'var2' => 'zeppelin',
'ignore' => '\\$set',
'quote' => 'this should be \'kept: $set\' and not be \'$set!\'',
'x5' => {
'klack' => '11111'
},
'set' => 'blah',
'line' => 'along line',
'this' => 'that',
'imported' => 'got that from imported config',
'someflags' => {
'RW' => 2,
'LOCK' => 1,
'TAINT' => 3
},
'var1' => 'zero',
'offflag' => 0,
'cmd' => 'mart@gw.intx.foo:22',
'default' => 'imported',
'host' => 'gw.intx.foo',
'nando' => '11111',
'auch <20>tzendes' => 'muss gehen',
'Directory' => {
'/' => {
'mode' => '755'
}
},
'hansa' => {
'z1' => {
'blak' => '11111',
'nando' => '9999'
},
'Directory' => {
'/' => {
'mode' => '755'
}
},
'block' => {
'0' => {
'value' => 0
}
},
'x5' => {
'klack' => '11111'
},
'Files' => {
'~/*.pl' => {
'Options' => '+Indexes'
}
},
'nando' => '11111'
},
'block' => {
'0' => {
'value' => 0
}
},
'Files' => {
'~/*.pl' => {
'Options' => '+Indexes'
}
},
'a [[weird]] heredoc' => 'has to
work
too!'
};
is_deeply($expect47, \%conf47, "complexity test");
# check if sorted save works
$conf47->save_file("t/complex.out", \%conf47);
open T, "<t/complex.out";
my $got47 = join '', <T>;
close T;
my $sorted = qq(
imported = got that from imported config
line = along line
nando = 11111
offflag = 0
onflag = 1);
if ($got47 =~ /\Q$sorted\E/) {
pass("Testing sorted save");
}
else {
fail("Testing sorted save");
}