scip/Config-General
1
0
Fork 0
mirror of https://codeberg.org/scip/Config-General.git synced 2025-12-17 20:51:00 +01:00
Code Issues Packages Projects Releases Wiki Activity

2.33

Browse Source 
- fixed rt.cpan.org#26333 - just return $con if env var
	  is undefined.

	- applied part of a patch supplied by Vincent Rivellino <vince@cuz.cx>
	  which turns off explicit empty block support if in
	  apache compatibility mode, see next.

	- added new option -ApacheCompatible, which makes the
	  module behave really apache compatible by setting the
	  required options.

	- a little bit re-organized the code, most of the stuff
	  in new() is now outsourced into several extra subs to
	  make maintenance of the code easier. The old new() sub
	  in fact was a nightmare.

	- fixed a bug reported by Otto Hirr <otto.hirr@olabinc.com>:
	  the _store() sub used sort() to sort the keys, which conflicts
	  with sorted hashes (eg. tied using Tie::IxHash).

	- fixed tie bug reported by King, Jason <kingj@newsltd.com.au>,
	  loading of the tie module didn't work.



git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@59 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:39:07 +00:00
parent 72fdf51f16
commit a644abce36
4 changed files with 297 additions and 212 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
Changelog
View File

@@ -1,3 +1,28 @@
2.33
- fixed rt.cpan.org#26333 - just return $con if env var
is undefined.
- applied part of a patch supplied by Vincent Rivellino <vince@cuz.cx>
which turns off explicit empty block support if in
apache compatibility mode, see next.
- added new option -ApacheCompatible, which makes the
module behave really apache compatible by setting the
required options.
- a little bit re-organized the code, most of the stuff
in new() is now outsourced into several extra subs to
make maintenance of the code easier. The old new() sub
in fact was a nightmare.
- fixed a bug reported by Otto Hirr <otto.hirr@olabinc.com>:
the _store() sub used sort() to sort the keys, which conflicts
with sorted hashes (eg. tied using Tie::IxHash).
- fixed tie bug reported by King, Jason <kingj@newsltd.com.au>,
loading of the tie module didn't work.
2.32 2.32
- fixed rt.cpan.org#24232 - import ENV vars only if defined - fixed rt.cpan.org#24232 - import ENV vars only if defined

375
General.pm
View File

@@ -32,7 +32,7 @@ use Carp::Heavy;
use Carp; use Carp;
use Exporter; use Exporter;
$Config::General::VERSION = 2.32; $Config::General::VERSION = 2.33;
use vars qw(@ISA @EXPORT_OK); use vars qw(@ISA @EXPORT_OK);
use base qw(Exporter); use base qw(Exporter);
@@ -48,54 +48,34 @@ sub new {
# define default options # define default options
my $self = { my $self = {
SlashIsDirectory => 0, SlashIsDirectory => 0,
AllowMultiOptions => 1, AllowMultiOptions => 1,
MergeDuplicateOptions => 0, MergeDuplicateOptions => 0,
MergeDuplicateBlocks => 0, MergeDuplicateBlocks => 0,
LowerCaseNames => 0, LowerCaseNames => 0,
ApacheCompatible => 0,
UseApacheInclude => 0, UseApacheInclude => 0,
IncludeRelative => 0, IncludeRelative => 0,
IncludeDirectories => 0, IncludeDirectories => 0,
IncludeGlob => 0, IncludeGlob => 0,
AutoLaunder => 0, AutoLaunder => 0,
AutoTrue => 0, AutoTrue => 0,
AutoTrueFlags => { AutoTrueFlags => {
true => '^(on|yes|true|1)$', true => '^(on|yes|true|1)$',
false => '^(off|no|false|0)$', false => '^(off|no|false|0)$',
}, },
DefaultConfig => {}, DefaultConfig => {},
level => 1, level => 1,
InterPolateVars => 0, InterPolateVars => 0,
InterPolateEnv => 0, InterPolateEnv => 0,
ExtendedAccess => 0, ExtendedAccess => 0,
SplitPolicy => 'guess', # also possible: whitespace, equalsign and custom SplitPolicy => 'guess', # also possible: whitespace, equalsign and custom
SplitDelimiter => 0, # must be set by the user if SplitPolicy is 'custom' SplitDelimiter => 0, # must be set by the user if SplitPolicy is 'custom'
StoreDelimiter => 0, # will be set by me unless user uses 'custom' policy StoreDelimiter => 0, # will be set by me unless user uses 'custom' policy
CComments => 1, # by default turned on CComments => 1, # by default turned on
BackslashEscape => 0, # by default turned off, allows escaping anything using the backslash BackslashEscape => 0, # by default turned off, allows escaping anything using the backslash
StrictObjects => 1, # be strict on non-existent keys in OOP mode StrictObjects => 1, # be strict on non-existent keys in OOP mode
StrictVars => 1, # be strict on undefined variables in Interpolate mode StrictVars => 1, # be strict on undefined variables in Interpolate mode
Tie => q(), # could be set to a perl module for tie'ing new hashes Tie => q(), # could be set to a perl module for tie'ing new hashes
parsed => 0, # internal state stuff for variable interpolation parsed => 0, # internal state stuff for variable interpolation
upperkey => q(), upperkey => q(),
upperkeys => [], upperkeys => [],
@@ -107,10 +87,177 @@ sub new {
# create the class instance # create the class instance
bless $self, $class; bless $self, $class;
if ($#param >= 1) { if ($#param >= 1) {
# use of the new hash interface! # use of the new hash interface!
my %conf = @param; $self->_prepare(@param);
}
elsif ($#param == 0) {
# use of the old style
$self->{ConfigFile} = $param[0];
if (ref($self->{ConfigFile}) eq 'HASH') {
$self->{ConfigHash} = delete $self->{ConfigFile};
}
}
else {
# this happens if $#param == -1,1 thus no param was given to new!
$self->{config} = $self->_hashref();
$self->{parsed} = 1;
}
# find split policy to use for option/value separation
$self->_splitpolicy();
# bless into variable interpolation module if neccessary
$self->_blessvars();
# process as usual
if (!$self->{parsed}) {
$self->_process();
}
# bless into OOP namespace if required
$self->_blessoop();
return $self;
}
sub _process {
#
# call _read() and _parse() on the given config
my($self) = @_;
if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
$self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig}); # FIXME: _hashref() ?
}
if (exists $self->{StringContent}) {
# consider the supplied string as config file
$self->_read($self->{StringContent}, 'SCALAR');
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
elsif (exists $self->{ConfigHash}) {
if (ref($self->{ConfigHash}) eq 'HASH') {
# initialize with given hash
$self->{config} = $self->{ConfigHash};
$self->{parsed} = 1;
}
else {
croak "Parameter -ConfigHash must be a hash reference!\n";
}
}
elsif (ref($self->{ConfigFile}) eq 'GLOB' || ref($self->{ConfigFile}) eq 'FileHandle') {
# use the file the glob points to
$self->_read($self->{ConfigFile});
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
else {
if ($self->{ConfigFile}) {
# open the file and read the contents in
$self->{configfile} = $self->{ConfigFile};
if ( file_name_is_absolute($self->{ConfigFile}) ) {
# look if is is an absolute path and save the basename if it is absolute
my ($volume, $path, undef) = splitpath($self->{ConfigFile});
$path =~ s#/$##; # remove eventually existing trailing slash
if (! $self->{ConfigPath}) {
$self->{ConfigPath} = [];
}
unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
}
$self->_open($self->{configfile});
# now, we parse immdediately, getall simply returns the whole hash
$self->{config} = $self->_hashref();
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
else {
# hm, no valid config file given, so try it as an empty object
$self->{config} = $self->_hashref();
$self->{parsed} = 1;
}
}
}
sub _blessoop {
#
# bless into ::Extended if neccessary
my($self) = @_;
if ($self->{ExtendedAccess}) {
# we are blessing here again, to get into the ::Extended namespace
# for inheriting the methods available overthere, which we doesn't have.
bless $self, 'Config::General::Extended';
eval {
require Config::General::Extended;
};
if ($EVAL_ERROR) {
croak $EVAL_ERROR;
}
}
# return $self;
}
sub _blessvars {
#
# bless into ::Interpolated if neccessary
my($self) = @_;
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 here.
bless $self, 'Config::General::Interpolated';
eval {
require Config::General::Interpolated;
};
if ($EVAL_ERROR) {
croak $EVAL_ERROR;
}
# pre-compile the variable regexp
$self->{regex} = $self->_set_regex();
}
# return $self;
}
sub _splitpolicy {
#
# find out what split policy to use
my($self) = @_;
if ($self->{SplitPolicy} ne 'guess') {
if ($self->{SplitPolicy} eq 'whitespace') {
$self->{SplitDelimiter} = '\s+';
if (!$self->{StoreDelimiter}) {
$self->{StoreDelimiter} = q( );
}
}
elsif ($self->{SplitPolicy} eq 'equalsign') {
$self->{SplitDelimiter} = '\s*=\s*';
if (!$self->{StoreDelimiter}) {
$self->{StoreDelimiter} = ' = ';
}
}
elsif ($self->{SplitPolicy} eq 'custom') {
if (! $self->{SplitDelimiter} ) {
croak "SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
}
}
else {
croak "Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
}
}
else {
if (!$self->{StoreDelimiter}) {
$self->{StoreDelimiter} = q( );
}
}
}
sub _prepare {
#
# prepare the class parameters, mangle them, if there
# are options to reset or to override, do it here.
my ($self, %conf) = @_;
# save the parameter list for ::Extended's new() calls # save the parameter list for ::Extended's new() calls
$self->{Params} = \%conf; $self->{Params} = \%conf;
@@ -137,7 +284,7 @@ sub new {
$self->{ConfigPath} = ref $configpath eq 'ARRAY' ? $configpath : [$configpath]; $self->{ConfigPath} = ref $configpath eq 'ARRAY' ? $configpath : [$configpath];
} }
# handle options which contains values we are needing (strings, hashrefs or the like) # handle options which contains values we need (strings, hashrefs or the like)
if (exists $conf{-String} ) { if (exists $conf{-String} ) {
if (ref(\$conf{-String}) eq 'SCALAR') { if (ref(\$conf{-String}) eq 'SCALAR') {
if ( $conf{-String}) { if ( $conf{-String}) {
@@ -203,139 +350,20 @@ sub new {
$self->{AllowMultiOptions} = 0; $self->{AllowMultiOptions} = 0;
} }
} }
}
elsif ($#param == 0) {
# use of the old style
$self->{ConfigFile} = $param[0];
if (ref($self->{ConfigFile}) eq 'HASH') {
$self->{ConfigHash} = delete $self->{ConfigFile};
}
}
else {
# this happens if $#param == -1,1 thus no param was given to new!
$self->{config} = $self->_hashref();
$self->{parsed} = 1;
}
# prepare the split delimiter if needed if ($self->{ApacheCompatible}) {
if ($self->{SplitPolicy} ne 'guess') { # turn on all apache compatibility options which has
if ($self->{SplitPolicy} eq 'whitespace') { # been incorporated during the years...
$self->{SplitDelimiter} = '\s+'; $self->{UseApacheInclude} = 1;
if (!$self->{StoreDelimiter}) { $self->{IncludeRelative} = 1;
$self->{StoreDelimiter} = q( ); $self->{IncludeDirectories} = 1;
$self->{IncludeGlob} = 1;
$self->{SpashIsDirectory} = 1;
$self->{SplitPolicy} = 'whitespace';
$self->{CComments} = 0;
$self->{BackslashEscape} = 1;
} }
} }
elsif ($self->{SplitPolicy} eq 'equalsign') {
$self->{SplitDelimiter} = '\s*=\s*';
if (!$self->{StoreDelimiter}) {
$self->{StoreDelimiter} = ' = ';
}
}
elsif ($self->{SplitPolicy} eq 'custom') {
if (! $self->{SplitDelimiter} ) {
croak "SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
}
}
else {
croak "Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
}
}
else {
if (!$self->{StoreDelimiter}) {
$self->{StoreDelimiter} = q( );
}
}
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.
#
bless $self, 'Config::General::Interpolated';
eval {
require Config::General::Interpolated;
};
if ($EVAL_ERROR) {
croak $EVAL_ERROR;
}
# pre-compile the variable regexp
$self->{regex} = $self->_set_regex();
}
# process as usual
if (!$self->{parsed}) {
if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
$self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig}); # FIXME: _hashref() ?
}
if (exists $self->{StringContent}) {
# consider the supplied string as config file
$self->_read($self->{StringContent}, 'SCALAR');
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
elsif (exists $self->{ConfigHash}) {
if (ref($self->{ConfigHash}) eq 'HASH') {
# initialize with given hash
$self->{config} = $self->{ConfigHash};
$self->{parsed} = 1;
}
else {
croak "Parameter -ConfigHash must be a hash reference!\n";
}
}
elsif (ref($self->{ConfigFile}) eq 'GLOB' || ref($self->{ConfigFile}) eq 'FileHandle') {
# use the file the glob points to
$self->_read($self->{ConfigFile});
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
else {
if ($self->{ConfigFile}) {
# open the file and read the contents in
$self->{configfile} = $self->{ConfigFile};
if ( file_name_is_absolute($self->{ConfigFile}) ) {
# look if is is an absolute path and save the basename if it is absolute
my ($volume, $path, undef) = splitpath($self->{ConfigFile});
$path =~ s#/$##; # remove eventually existing trailing slash
if (! $self->{ConfigPath}) {
$self->{ConfigPath} = [];
}
unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
}
$self->_open($self->{configfile});
# now, we parse immdediately, getall simply returns the whole hash
$self->{config} = $self->_hashref();
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
else {
# hm, no valid config file given, so try it as an empty object
$self->{config} = $self->_hashref();
$self->{parsed} = 1;
}
}
}
#
# Submodule handling. Parsing is already done at this point.
#
if ($self->{ExtendedAccess}) {
#
# we are blessing here again, to get into the ::Extended namespace
# for inheriting the methods available overthere, which we doesn't have.
#
bless $self, 'Config::General::Extended';
eval {
require Config::General::Extended;
};
if ($EVAL_ERROR) {
croak $EVAL_ERROR;
}
}
return $self;
}
sub getall { sub getall {
# #
@@ -555,7 +583,7 @@ sub _read {
# transform explicit-empty blocks to conforming blocks # transform explicit-empty blocks to conforming blocks
if (/\s*<([^\/]+?.*?)\/>$/) { if (!$this->{ApacheCompatible} && /\s*<([^\/]+?.*?)\/>$/) {
my $block = $1; my $block = $1;
if ($block !~ /\"/) { if ($block !~ /\"/) {
if ($block !~ /\s[^\s]/) { if ($block !~ /\s[^\s]/) {
@@ -1030,7 +1058,7 @@ sub _store {
my $config_string = q(); my $config_string = q();
foreach my $entry (sort keys %config) { foreach my $entry (keys %config) {
if (ref($config{$entry}) eq 'ARRAY') { if (ref($config{$entry}) eq 'ARRAY') {
foreach my $line (@{$config{$entry}}) { foreach my $line (@{$config{$entry}}) {
if (ref($line) eq 'HASH') { if (ref($line) eq 'HASH') {
@@ -1125,7 +1153,7 @@ sub _hashref {
$wantarray, $evaltext, $is_require, $hints, $bitmask) = caller 0; $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller 0;
if ($this->{Tie}) { if ($this->{Tie}) {
eval { eval {
eval {require $this->{Tie}}; eval qq{require $this->{Tie}};
}; };
if ($EVAL_ERROR) { if ($EVAL_ERROR) {
croak q(Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR; croak q(Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR;
@@ -1652,6 +1680,35 @@ Please note that this is a new option (incorporated in version 2.30),
it may lead to various unexpected sideeffects or other failures. it may lead to various unexpected sideeffects or other failures.
You've been warned. You've been warned.
=item B<-ApacheCompatible>
Over the past years a lot of options has been incorporated
into Config::General to be able to parse real apache configs.
The new B<-ApacheCompatible> option now makes it possible to
tweak all options in a way that apache configs can be parsed.
This is called "apache compatibility mode" - if you will ever
have problems with parsing apache configs without this option
being set, you'll get no help by me. Thanks :)
The following options will be set:
UseApacheInclude = 1
IncludeRelative = 1
IncludeDirectories = 1
IncludeGlob = 1
SpashIsDirectory = 1
SplitPolicy = 'equalsign'
CComments = 0
BackslashEscape = 1
Take a look into the particular documentation sections what
those options are doing.
Beside setting some options it also turns off support for
explicit empty blocks.
=back =back
@@ -2254,7 +2311,7 @@ Thomas Linden <tlinden |AT| cpan.org>
=head1 VERSION =head1 VERSION
2.32 2.33
=cut =cut

7
General/Interpolated.pm
View File

@@ -8,7 +8,7 @@
# #
package Config::General::Interpolated; package Config::General::Interpolated;
$Config::General::Interpolated::VERSION = "2.07"; $Config::General::Interpolated::VERSION = "2.08";
use strict; use strict;
use Carp; use Carp;
@@ -98,6 +98,9 @@ sub _interpolate {
if (defined($ENV{$var})) { if (defined($ENV{$var})) {
$con . $ENV{$var}; $con . $ENV{$var};
} }
else {
$con;
}
} }
else { else {
if ($this->{StrictVars}) { if ($this->{StrictVars}) {
@@ -309,7 +312,7 @@ See L<http://www.perl.com/perl/misc/Artistic.html>
=head1 VERSION =head1 VERSION
2.07 2.08
=cut =cut

2
README
View File

@@ -104,4 +104,4 @@ AUTHOR
VERSION VERSION
2.32 2.33