From 57244f6eeab80ae0f1341297fa5937ed46a8cf0d Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Sat, 10 Oct 2009 16:35:18 +0000 Subject: [PATCH] 2.30 - applied patch by Branislav Zahradnik 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 . git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@56 be1acefe-a474-0410-9a34-9b3221f2030f --- Changelog | 13 ++++++++ General.pm | 74 ++++++++++++++++++++++++++++++++++++++--- General/Extended.pm | 65 +++++++++++++++++++++++++++++++----- General/Interpolated.pm | 8 +++-- README | 2 +- 5 files changed, 147 insertions(+), 15 deletions(-) diff --git a/Changelog b/Changelog index 36cca75..36da504 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,16 @@ + 2.30 + - fixed rt.cpan.org bug #7957, added · + + - applied patch by Branislav Zahradnik + 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 . + 2.29 - applied patch by brian@kronos.com via rt.cpan.org #11211. diff --git a/General.pm b/General.pm index 64407eb..f91b2ee 100644 --- a/General.pm +++ b/General.pm @@ -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 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: + + + Index index.awk + + +you will get such an error message from the parser: + + EndBlock "" has no StartBlock statement (level: 1, chunk 10)! + +This is caused by the fact that the config chunk below will be +internally converted to: + + + Index index.awk + + +Now there is one '' too much. The proper solution is +to use quotation to circumvent this error: + + + Index index.awk + + +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 =head1 VERSION -2.29 +2.30 =cut diff --git a/General/Extended.pm b/General/Extended.pm index 18b60ac..d18028c 100644 --- a/General/Extended.pm +++ b/General/Extended.pm @@ -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 below. +If the key points to a list of hashes, a list of objects will be +returned. Given the following example config: + + + + +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 one!) from the config which is referenced by @@ -540,7 +589,7 @@ Thomas Linden =head1 VERSION -2.00 +2.01 =cut diff --git a/General/Interpolated.pm b/General/Interpolated.pm index 23856d8..43c455b 100644 --- a/General/Interpolated.pm +++ b/General/Interpolated.pm @@ -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 =head1 VERSION -2.05 +2.06 =cut diff --git a/README b/README index 3168741..1f30d33 100644 --- a/README +++ b/README @@ -104,4 +104,4 @@ AUTHOR VERSION - 2.29 + 2.30