- applied patch by Branislav Zahradnik
	   <brano@blueorange.sk> which adds -InterPolateEnv.
	   This allows to use environment variables too. It
	   implies -InterPolateVars.

	 - added object list capability for the ::Extended::obj()
	   method. If a certain key points to an array of
	   hashrefs, then the whole arrayref is returned.
	   Suggested by Alan Hodgkinson <alan@softxs.ch>.


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@56 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:35:18 +00:00
parent ef504ee7f4
commit 57244f6eea
5 changed files with 147 additions and 15 deletions

View File

@@ -1,3 +1,16 @@
2.30
- fixed rt.cpan.org bug #7957, added <20>
- applied patch by Branislav Zahradnik
<brano@blueorange.sk> which adds -InterPolateEnv.
This allows to use environment variables too. It
implies -InterPolateVars.
- added object list capability for the ::Extended::obj()
method. If a certain key points to an array of
hashrefs, then the whole arrayref is returned.
Suggested by Alan Hodgkinson <alan@softxs.ch>.
2.29
- applied patch by brian@kronos.com via rt.cpan.org
#11211.

View File

@@ -26,7 +26,7 @@ use Carp::Heavy;
use Carp;
use Exporter;
$Config::General::VERSION = "2.29";
$Config::General::VERSION = "2.30";
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@@ -41,6 +41,8 @@ sub new {
# define default options
my $self = {
SlashIsDirectory => 0,
AllowMultiOptions => 1,
MergeDuplicateOptions => 0,
@@ -66,6 +68,8 @@ sub new {
InterPolateVars => 0,
InterPolateEnv => 0,
ExtendedAccess => 0,
SplitPolicy => 'guess', # also possible: whitespace, equalsign and custom
@@ -212,8 +216,10 @@ sub new {
$self->{StoreDelimiter} = " " if(!$self->{StoreDelimiter});
}
if ($self->{InterPolateVars}) {
#
if ($self->{InterPolateVars} || $self->{InterPolateEnv}) {
# InterPolateEnv implies InterPolateVars
$self->{InterPolateVars} = 1;
# we are blessing here again, to get into the ::InterPolated namespace
# for inheriting the methods available overthere, which we doesn't have.
#
@@ -485,6 +491,18 @@ sub _read {
# transform explicit-empty blocks to conforming blocks
if (/\s*<([^\/]+?.*?)\/>$/) {
my $block = $1;
if ($block !~ /\"/) {
if ($block !~ /\s[^\s]/) {
# fix of bug 7957, add quotation to pure slash at the
# end of a block so that it will be considered as directory
# unless the block is already quoted or contains whitespaces
# and no quotes.
if ($this->{SlashIsDirectory}) {
push @{$this->{content}}, '<' . $block . '"/">';
next;
}
}
}
my $orig = $_;
$orig =~ s/\/>$/>/;
$block =~ s/\s\s*.*$//;
@@ -1413,6 +1431,13 @@ Example:
If set to a true value, variable interpolation will be done on your config
input. See L<Config::General::Interpolated> for more informations.
=item B<-InterPolateEnv>
If set to a true value, environment variables can be used in
configs.
This implies B<-InterPolateVars>.
=item B<-ExtendedAccess>
If set to a true value, you can use object oriented (extended) methods to
@@ -1487,6 +1512,47 @@ character within configurations.
By default it is turned off.
=item B<-SlashIsDirectory>
If you turn on this parameter, a single slash as the last character
of a named block will be considered as a directory name.
By default this flag is turned off, which makes the module somewhat
incompatible to apache configs, since such a setup will be normally
considered as an explicit empty block, just as XML defines it.
For example, if you have the following config:
<Directory />
Index index.awk
</Directory>
you will get such an error message from the parser:
EndBlock "</Directory>" has no StartBlock statement (level: 1, chunk 10)!
This is caused by the fact that the config chunk below will be
internally converted to:
<Directory><Directory />
Index index.awk
</Directory>
Now there is one '</Directory>' too much. The proper solution is
to use quotation to circumvent this error:
<Directory "/">
Index index.awk
</Directory>
However, a raw apache config comes without such quotes. In this
case you may consider to turn on B<-SlashIsDirectory>.
Please note that this is a new option (incorporated in version 2.30),
it may lead to various unexpected sideeffects or other failures.
You've been warned.
=back
@@ -2070,7 +2136,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
2.29
2.30
=cut

View File

@@ -23,7 +23,7 @@ use vars qw(@ISA @EXPORT);
use strict;
$Config::General::Extended::VERSION = "2.00";
$Config::General::Extended::VERSION = "2.01";
sub new {
@@ -39,23 +39,51 @@ sub obj {
# or an empty object if the content of $key is empty.
#
my($this, $key) = @_;
# just create the empty object, just in case
my $empty = $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => {}, %{$this->{Params}} );
if (exists $this->{config}->{$key}) {
if (!$this->{config}->{$key} || ref($this->{config}->{$key}) ne "HASH") {
if (!$this->{config}->{$key}) {
# be cool, create an empty object!
return $empty
}
elsif (ref($this->{config}->{$key}) eq "ARRAY") {
my @objlist;
foreach my $element (@{$this->{config}->{$key}}) {
if (ref($element) eq "HASH") {
push @objlist,
$this->SUPER::new( -ExtendedAccess => 1,
-ConfigHash => $element,
%{$this->{Params}} );
}
else {
if ($this->{StrictObjects}) {
croak "element in list \"$key\" does not point to a hash reference!\n";
}
# else: skip this element
}
}
return \@objlist;
}
elsif (ref($this->{config}->{$key}) eq "HASH") {
return $this->SUPER::new( -ExtendedAccess => 1,
-ConfigHash => $this->{config}->{$key}, %{$this->{Params}} );
}
else {
# nothing supported
if ($this->{StrictObjects}) {
croak "key \"$key\" does not point to a hash reference!\n";
}
else {
# be cool, create an empty object!
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => {}, %{$this->{Params}} );
return $empty;
}
}
else {
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => $this->{config}->{$key}, %{$this->{Params}} );
}
}
else {
# even return an empty object if $key does not exist
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => {}, %{$this->{Params}} );
return $empty;
}
}
@@ -388,6 +416,27 @@ operations, i.e.:
See the discussion on B<AUTOLOAD METHODS> below.
If the key points to a list of hashes, a list of objects will be
returned. Given the following example config:
<option>
name = max
</option>
<option>
name = bea
</option>
you could write code like this to access the list the OOP way:
my $objlist = $conf->obj("option");
foreach my $option (@{$objlist}) {
print $option->name;
}
Please note that the list will be returned as a reference to an array.
Empty elements or non-hash elements of the list, if any, will be skipped.
=item hash('key')
This method returns a hash(if it B<is> one!) from the config which is referenced by
@@ -540,7 +589,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
2.00
2.01
=cut

View File

@@ -8,7 +8,7 @@
#
package Config::General::Interpolated;
$Config::General::Interpolated::VERSION = "2.05";
$Config::General::Interpolated::VERSION = "2.06";
use strict;
use Carp;
@@ -89,6 +89,10 @@ sub _interpolate {
if (exists $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var}) {
$con . $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var};
}
elsif ($this->{InterPolateEnv}) {
# may lead to vulnerabilities, by default flag turned off
$con . $ENV{$var};
}
else {
if ($this->{StrictVars}) {
croak "Use of uninitialized variable (\$$var) while loading config entry: $key = $value\n";
@@ -299,7 +303,7 @@ See L<http://www.perl.com/perl/misc/Artistic.html>
=head1 VERSION
2.05
2.06
=cut

2
README
View File

@@ -104,4 +104,4 @@ AUTHOR
VERSION
2.29
2.30