mirror of
https://codeberg.org/scip/Config-General.git
synced 2025-12-17 12:41:07 +01:00
2.15 - fixed Bug in SaveConfig***, which didn't work.
- applied patch by Robb Canfield <robb@canfield.com>, which fixes a bug in the variable interpolation scheme. It did not interpolate blocks nor blocknames. This patch fixes this. Patch slightly modified by me(interpolation on block and blocknames). - enhanced test for variable interpolation to reflect this. - added check if a named block occurs after the underlying block is already an array, which is not possible. perl cannot add a hashref to an array. i.e.: <bl> a = 1 </bl> <bl> b = 1 </bl> <bl blubber> c = 1 </bl> As you can see, "<bl>" will be an array, and "blubber" cannot be stored in any way on this array. The module croaks now if such construct occurs. git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@41 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
24
Changelog
24
Changelog
@@ -1,3 +1,27 @@
|
|||||||
|
2.15 - fixed Bug in SaveConfig***, which didn't work.
|
||||||
|
- applied patch by Robb Canfield <robb@canfield.com>,
|
||||||
|
which fixes a bug in the variable interpolation
|
||||||
|
scheme. It did not interpolate blocks nor
|
||||||
|
blocknames. This patch fixes this. Patch slightly
|
||||||
|
modified by me(interpolation on block and blocknames).
|
||||||
|
- enhanced test for variable interpolation to
|
||||||
|
reflect this.
|
||||||
|
- added check if a named block occurs after the underlying
|
||||||
|
block is already an array, which is not possible.
|
||||||
|
perl cannot add a hashref to an array. i.e.:
|
||||||
|
<bl>
|
||||||
|
a = 1
|
||||||
|
</bl>
|
||||||
|
<bl>
|
||||||
|
b = 1
|
||||||
|
</bl>
|
||||||
|
<bl blubber>
|
||||||
|
c = 1
|
||||||
|
</bl>
|
||||||
|
As you can see, "<bl>" will be an array, and "blubber"
|
||||||
|
cannot be stored in any way on this array.
|
||||||
|
The module croaks now if such construct occurs.
|
||||||
|
|
||||||
2.14 - fixed bug reported by Francisco Olarte Sanz
|
2.14 - fixed bug reported by Francisco Olarte Sanz
|
||||||
<folarte@peoplecall.com>, which caused _parse to
|
<folarte@peoplecall.com>, which caused _parse to
|
||||||
ignore blocks with the name "0":
|
ignore blocks with the name "0":
|
||||||
|
|||||||
26
General.pm
26
General.pm
@@ -17,7 +17,7 @@ use strict;
|
|||||||
use Carp;
|
use Carp;
|
||||||
use Exporter;
|
use Exporter;
|
||||||
|
|
||||||
$Config::General::VERSION = "2.14";
|
$Config::General::VERSION = "2.15";
|
||||||
|
|
||||||
use vars qw(@ISA @EXPORT);
|
use vars qw(@ISA @EXPORT);
|
||||||
@ISA = qw(Exporter);
|
@ISA = qw(Exporter);
|
||||||
@@ -493,13 +493,21 @@ sub _parse {
|
|||||||
}
|
}
|
||||||
if (! defined $block) { # not inside a block @ the moment
|
if (! defined $block) { # not inside a block @ the moment
|
||||||
if (/^<([^\/]+?.*?)>$/) { # look if it is a block
|
if (/^<([^\/]+?.*?)>$/) { # look if it is a block
|
||||||
$this->{level} += 1;
|
|
||||||
$block = $1; # store block name
|
$block = $1; # store block name
|
||||||
($grab, $blockname) = split /\s\s*/, $block, 2; # is it a named block? if yes, store the name separately
|
($grab, $blockname) = split /\s\s*/, $block, 2; # is it a named block? if yes, store the name separately
|
||||||
if ($blockname) {
|
if ($blockname) {
|
||||||
$block = $grab;
|
$block = $grab;
|
||||||
}
|
}
|
||||||
|
if ($this->{InterPolateVars}) {
|
||||||
|
# interpolate block(name), add "<" and ">" to the key, because
|
||||||
|
# it is sure that such keys does not exist otherwise.
|
||||||
|
$block = $this->_interpolate("<$block>", $block);
|
||||||
|
if ($blockname) {
|
||||||
|
$blockname = $this->_interpolate("<$blockname>", $blockname);
|
||||||
|
}
|
||||||
|
}
|
||||||
$block = lc($block) if $this->{LowerCaseNames}; # only for blocks lc(), if configured via new()
|
$block = lc($block) if $this->{LowerCaseNames}; # only for blocks lc(), if configured via new()
|
||||||
|
$this->{level} += 1;
|
||||||
undef @newcontent;
|
undef @newcontent;
|
||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
@@ -579,7 +587,12 @@ sub _parse {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else { # the first occurence of this particular named block
|
elsif (ref($config->{$block}) eq "ARRAY") {
|
||||||
|
croak "Cannot add named block <$block $blockname> to hash! Block <$block> occurs more than once.\n"
|
||||||
|
."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
# the first occurence of this particular named block
|
||||||
$config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
|
$config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
|
||||||
}
|
}
|
||||||
$this->_backlast($blockname);
|
$this->_backlast($blockname);
|
||||||
@@ -905,7 +918,7 @@ sub SaveConfig {
|
|||||||
croak "The second parameter must be a reference to a hash!";
|
croak "The second parameter must be a reference to a hash!";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
(new Config::General($hash))->save_file($file);
|
(new Config::General(-ConfigHash => $hash))->save_file($file);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -925,7 +938,7 @@ sub SaveConfigString {
|
|||||||
croak "The parameter must be a reference to a hash!";
|
croak "The parameter must be a reference to a hash!";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return (new Config::General($hash))->save_string();
|
return (new Config::General(-ConfigHash => $hash))->save_string();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -1780,7 +1793,6 @@ modify it under the same terms as Perl itself.
|
|||||||
|
|
||||||
none known yet.
|
none known yet.
|
||||||
|
|
||||||
|
|
||||||
=head1 AUTHOR
|
=head1 AUTHOR
|
||||||
|
|
||||||
Thomas Linden <tom@daemon.de>
|
Thomas Linden <tom@daemon.de>
|
||||||
@@ -1788,7 +1800,7 @@ Thomas Linden <tom@daemon.de>
|
|||||||
|
|
||||||
=head1 VERSION
|
=head1 VERSION
|
||||||
|
|
||||||
2.14
|
2.15
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|||||||
@@ -125,8 +125,6 @@ sub _var_hash_stacker {
|
|||||||
#
|
#
|
||||||
my ($this, $config) = @_;
|
my ($this, $config) = @_;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
foreach my $key (keys %{$config}) {
|
foreach my $key (keys %{$config}) {
|
||||||
if (ref($config->{$key}) eq "ARRAY" ) {
|
if (ref($config->{$key}) eq "ARRAY" ) {
|
||||||
$this->{level}++;
|
$this->{level}++;
|
||||||
@@ -148,7 +146,6 @@ sub _var_hash_stacker {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
#$this->{level}--;
|
|
||||||
return $config;
|
return $config;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -160,7 +157,6 @@ sub _var_array_stacker {
|
|||||||
my ($this, $config, $key) = @_;
|
my ($this, $config, $key) = @_;
|
||||||
|
|
||||||
my @new;
|
my @new;
|
||||||
#$this->{level}++;
|
|
||||||
|
|
||||||
foreach my $entry (@{$config}) {
|
foreach my $entry (@{$config}) {
|
||||||
if (ref($entry) eq "HASH") {
|
if (ref($entry) eq "HASH") {
|
||||||
|
|||||||
16
t/cfg.16
16
t/cfg.16
@@ -14,3 +14,19 @@ pr=$me/blubber
|
|||||||
home = $base/home/max # $base should be interpolated
|
home = $base/home/max # $base should be interpolated
|
||||||
</users>
|
</users>
|
||||||
</etc>
|
</etc>
|
||||||
|
|
||||||
|
# block(name) test
|
||||||
|
tag = dir
|
||||||
|
mono = teri
|
||||||
|
<$tag>
|
||||||
|
bl = 1
|
||||||
|
</$tag>
|
||||||
|
<$tag mono>
|
||||||
|
bl = 2
|
||||||
|
</$tag>
|
||||||
|
<text $mono>
|
||||||
|
bl = 3
|
||||||
|
</text>
|
||||||
|
<$tag $mono>
|
||||||
|
bl = 3
|
||||||
|
</$tag>
|
||||||
|
|||||||
Reference in New Issue
Block a user