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.11 - heavy change in the variable interpolation code.

Browse Source 
Peter Sergeant <pete@clueball.com> reported this
	   mis-behavior. The problem was that the whole hash
	   was feeded to ::Interpolated.pm, but as we all
	   know, perl hashes doesn't preserve the order. So,
	   in our case the module sometimes was unable to
	   resolve variablenames, because they were stored
	   in a different location as it occured in the config.
	   The change is, that Config::General now calls
	   ::Interpolate.pm (new sub: _interpolate()) itself
	   directly on a per-key/value pair basis. The internal
	   varstack is now stored on $this globally. So, now
	   a variable will be known when it occurs. period :-


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

16
Changelog
View File

@@ -1,8 +1,24 @@
2.11 - heavy change in the variable interpolation code.
Peter Sergeant <pete@clueball.com> reported this
mis-behavior. The problem was that the whole hash
was feeded to ::Interpolated.pm, but as we all
know, perl hashes doesn't preserve the order. So,
in our case the module sometimes was unable to
resolve variablenames, because they were stored
in a different location as it occured in the config.
The change is, that Config::General now calls
::Interpolate.pm (new sub: _interpolate()) itself
directly on a per-key/value pair basis. The internal
varstack is now stored on $this globally. So, now
a variable will be known when it occurs. period :-)
2.10 - added -StrictVars documentation section to the POD,
which was missing.
- fixed a formatting error in the POD documentation.
2.09 - added bugfix in '#' comment parsing. If current state
was within a block, then /^ #/ was not ignored as
comment but instead added as variable. Reported by

34
General.pm
View File

@@ -17,7 +17,7 @@ use strict;
use Carp;
use Exporter;
$Config::General::VERSION = "2.10";
$Config::General::VERSION = "2.11";
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@@ -179,6 +179,22 @@ sub new {
$self->{StoreDelimiter} = " " if(!$self->{StoreDelimiter});
}
if ($self->{InterPolateVars}) {
#
# we are blessing here again, to get into the ::InterPolated namespace
# for inheriting the methods available overthere, which we doesn't have.
#
bless($self, "Config::General::Interpolated");
eval {
require Config::General::Interpolated;
};
if ($@) {
croak $@;
}
# pre-compile the variable regexp
$self->{regex} = $self->_set_regex();
}
# process as usual
if (!$self->{parsed}) {
if (exists $self->{StringContent}) {
@@ -222,16 +238,6 @@ sub new {
#
# Submodule handling. Parsing is already done at this point.
#
if ($self->{InterPolateVars}) {
eval {
require Config::General::Interpolated;
};
if ($@) {
croak $@;
}
$self->{regex} = Config::General::Interpolated::_set_regex();
$self->{config} = Config::General::Interpolated::_vars($self, $self->{config}, {});
}
if ($self->{ExtendedAccess}) {
#
# we are blessing here again, to get into the ::Extended namespace
@@ -590,6 +596,10 @@ sub _parse_value {
# avoid "Use of uninitialized value"
$value = '' unless defined $value;
if ($this->{InterPolateVars}) {
$value = $this->_interpolate($option, $value);
}
# make true/false values to 1 or 0 (-AutoTrue)
if ($this->{AutoTrue}) {
if ($value =~ /$this->{AutoTrueFlags}->{true}/io) {
@@ -1714,7 +1724,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
2.10
2.11
=cut

104
General/Interpolated.pm
View File

@@ -1,5 +1,5 @@
package Config::General::Interpolated;
$Config::General::Interpolated::VERSION = "1.5";
$Config::General::Interpolated::VERSION = "2.0";
use strict;
use Carp;
@@ -10,7 +10,7 @@ use Exporter ();
# Import stuff from Config::General
use vars qw(@ISA @EXPORT);
@ISA = qw(Config::General Exporter);
@EXPORT=qw(_set_regex _vars);
sub new {
#
@@ -33,13 +33,13 @@ sub _set_regex {
# <autrijus@autrijus.org>, and I made some modifications.
# thanx, autrijus. :)
my $regex = qr{
(^|[^\\]) # can be the beginning of the line
# but can't begin with a '\'
(^|[^\\]) # $1: can be the beginning of the line
# but can't begin with a '\'
\$ # dollar sign
(\{)? # $1: optional opening curly
([a-zA-Z_]\w*) # $2: capturing variable name
(\{)? # $2: optional opening curly
([a-zA-Z_]\w*) # $3: capturing variable name
(
?(2) # $3: if there's the opening curly...
?(2) # $4: if there's the opening curly...
\} # ... match closing curly
)
}x;
@@ -47,76 +47,38 @@ sub _set_regex {
}
sub _interpolate {
#
# interpolate a scalar value and keep the result
# on the varstack.
#
# called directly by Config::General::_parse_value()
#
my ($this, $key, $value) = @_;
sub _vars {
my ($this, $config, $stack) = @_;
my %varstack;
$stack = {} unless defined $stack; # make sure $stack is assigned.
# collect values that don't need to be substituted first
while (my ($key, $value) = each %{$config}) {
$varstack{$key} = $value
unless ref($value) or $value =~ /$this->{regex}/;
$value =~ s{$this->{regex}}{
my $con = $1;
my $var = $3;
if (exists $this->{varstack}->{$var}) {
$con . $this->{varstack}->{$var};
}
my $sub_interpolate = sub {
my ($value) = @_;
# this is a scalar
if ($value =~ m/^'/ and $value =~ m/'$/) {
# single-quote, remove it and don't do variable interpolation
$value =~ s/^'//; $value =~ s/'$//;
else {
if ($this->{StrictVars}) {
croak "Use of uninitialized variable \$" . $var . "\n";
}
else {
$value =~ s{$this->{regex}}{
my $con = $1;
my $var = $3;
my $v = $varstack{$var} || $stack->{$var};
if (defined $v) {
$con . $v;
}
else {
if ($this->{StrictVars}) {
croak "Use of uninitialized variable \$" . $var . "\n";
}
else {
# be cool
$con;
}
}
}egx;
}
return $value;
};
# interpolate variables
while (my ($key, $value) = each %{$config}) {
if (my $reftype = ref($value)) {
next unless $reftype eq 'ARRAY';
# we encounter multiple options
@{$value} = map { $sub_interpolate->($_) } @{$value};
}
else {
$value = $sub_interpolate->($value);
$config->{$key} = $value;
$varstack{$key} = $value;
# be cool
$con;
}
}
}egx;
$this->{varstack}->{$key} = $value;
return $value;
};
# traverse the hierarchy part
while (my ($key, $value) = each %{$config}) {
# this is not a scalar recursive call to myself
if (ref($value) eq 'HASH') {
# called via Gonfig::General procedural
_vars($this, $value, {%{$stack}, %varstack});
}
}
return $config;
}
1;
@@ -132,7 +94,7 @@ Config::General::Interpolated - Parse variables within Config files
use Config::General;
$conf = new Config::General(
-CinfigFile => 'configfile',
-ConfigFile => 'configfile',
-InterPolateVars => 1
);
@@ -222,7 +184,7 @@ See L<http://www.perl.com/perl/misc/Artistic.html>
=head1 VERSION
1.5
2.0
=cut

7
README
View File

@@ -80,10 +80,11 @@ UPDATE
COPYRIGHT
Config::General
Config::General::Extended
Copyright (c) 2000-2002 Thomas Linden <tom@daemon.de>
Copyright (c) 2000-2002 by Thomas Linden <tom@daemon.de>
Config::General::Interpolated
Copyright (c) 2001 Wei-Hon Chen <plasmaball@pchome.com.tw>
Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>
Copyright (c) 2002 by Thomas Linden <tom@daemon.de>.
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
@@ -103,4 +104,4 @@ AUTHOR
VERSION
2.10
2.11