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.31

Browse Source 
- applied patches by Jason Rhinelander <jagerman@jagerman.com>:
	  	o bugfix: multiple levels if include files didn't
		  work properly.

		o new option -IncludeDirectories, which allows
		  to include all files of a directory. The directory
		  must be specified by -ConfigFile as usual.

		o new option -IncludeGlob, which allows to
		  use globs (wildcards) to include multiple files.

		o -ConfigPath can be speciefied using a single
		  scalar value instead of an array if there is only
		  one path.

		o bugfix: quotes from quoted block names were
		  not removed properly.

		o fixes and updates for tests (make test) for
		  the above patches.
	   
	   Thanks a lot Jason.

	 - fixed number of tests in run.t

	 - applied suggestion by Eric Kisiel <eric.kisiel@adelphia.com>:
	   ::Extended::keys() returns an empty hash if the
	   referring object is not hash.

	 - fixed bug #14770, "Use of uninitialized value.." during
	   environment variable interpolation.


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@57 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:36:29 +00:00
parent 57244f6eea
commit 80bcb7ddae
10 changed files with 251 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
Changelog
View File

@@ -1,6 +1,38 @@
2.31
- applied patches by Jason Rhinelander <jagerman@jagerman.com>:
o bugfix: multiple levels if include files didn't
work properly.
o new option -IncludeDirectories, which allows
to include all files of a directory. The directory
must be specified by -ConfigFile as usual.
o new option -IncludeGlob, which allows to
use globs (wildcards) to include multiple files.
o -ConfigPath can be speciefied using a single
scalar value instead of an array if there is only
one path.
o bugfix: quotes from quoted block names were
not removed properly.
o fixes and updates for tests (make test) for
the above patches.
Thanks a lot Jason.
- fixed number of tests in run.t
- applied suggestion by Eric Kisiel <eric.kisiel@adelphia.com>:
::Extended::keys() returns an empty hash if the
referring object is not hash.
- fixed bug #14770, "Use of uninitialized value.." during
environment variable interpolation.
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

120
General.pm
View File

@@ -5,7 +5,7 @@
# config values from a given file and
# return it as hash structure
#
# Copyright (c) 2000-2005 Thomas Linden <tom@daemon.de>.
# Copyright (c) 2000-2006 Thomas Linden <tom@daemon.de>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
@@ -14,6 +14,7 @@ package Config::General;
use FileHandle;
use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath);
use File::Glob qw/:glob/;
use strict;
# on debian with perl > 5.8.4 croak() doesn't work anymore without this.
@@ -26,7 +27,7 @@ use Carp::Heavy;
use Carp;
use Exporter;
$Config::General::VERSION = "2.30";
$Config::General::VERSION = "2.31";
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@@ -52,6 +53,8 @@ sub new {
UseApacheInclude => 0,
IncludeRelative => 0,
IncludeDirectories => 0,
IncludeGlob => 0,
AutoLaunder => 0,
@@ -111,13 +114,16 @@ sub new {
$self->{ConfigFile} = delete $conf{-file} if(exists $conf{-file});
$self->{ConfigHash} = delete $conf{-hash} if(exists $conf{-hash});
# store search path for relative configs, if any
$self->{ConfigPath} = delete $conf{-ConfigPath} if(exists $conf{-ConfigPath});
# store input, file, handle, or array
$self->{ConfigFile} = delete $conf{-ConfigFile} if(exists $conf{-ConfigFile});
$self->{ConfigHash} = delete $conf{-ConfigHash} if(exists $conf{-ConfigHash});
# store search path for relative configs, if any
if (exists $conf{-ConfigPath}) {
my $configpath = delete $conf{-ConfigPath};
$self->{ConfigPath} = ref $configpath eq 'ARRAY' ? $configpath : [$configpath];
}
# handle options which contains values we are needing (strings, hashrefs or the like)
if (exists $conf{-String} ) {
if ($conf{-String}) {
@@ -325,18 +331,42 @@ sub files {
sub _open {
#
# open the config file
# open the config file, or expand a directory or glob
#
my($this, $configfile) = @_;
my $fh = new FileHandle;
if( ! -e $configfile && defined($this->{ConfigPath}) ) {
# try to find the file within ConfigPath
foreach my $dir (@{$this->{ConfigPath}}) {
if( -e catfile($dir, $configfile) ) {
$configfile = catfile($dir, $configfile);
last; # found it
};
if ($this->{IncludeGlob} and $configfile =~ /[*?\[\{\\]/) {
# Something like: *.conf (or maybe dir/*.conf) was included; expand it and
# pass each expansion through this method again.
my @include = grep -f, bsd_glob($configfile, GLOB_BRACE | GLOB_QUOTE);
if (@include == 1) {
$configfile = $include[0];
}
else { # Multiple results or no expansion results (which is fine, include foo/* shouldn't fail if there isn't anything matching)
local $this->{IncludeGlob};
for (@include) {
$this->_open($_);
}
return;
}
}
if (!-e $configfile) {
my $found;
if (defined($this->{ConfigPath})) {
# try to find the file within ConfigPath
foreach my $dir (@{$this->{ConfigPath}}) {
if( -e catfile($dir, $configfile) ) {
$configfile = catfile($dir, $configfile);
$found = 1;
last; # found it
}
}
}
if (!$found) {
my $path_message = defined $this->{ConfigPath} ? ' within ConfigPath: ' . join('.', @{$this->{ConfigPath}}) : '';
croak qq{The file "$configfile" does not exist$path_message!};
}
}
@@ -346,7 +376,22 @@ sub _open {
$/ = "\n";
}
if (-e $configfile) {
if (-d $configfile and $this->{IncludeDirectories}) {
# A directory was included; include all the files inside that directory in ASCII order
local *INCLUDEDIR;
opendir INCLUDEDIR, $configfile or croak "Could not open directory $configfile!($!)\n";
my @files = sort grep -f "$configfile/$_", readdir INCLUDEDIR;
closedir INCLUDEDIR;
local $this->{CurrentConfigFilePath} = $configfile;
for (@files) {
unless ($this->{files}->{"$configfile/$_"}) {
open $fh, "<$configfile/$_" or croak "Could not open $configfile/$_!($!)\n";
$this->{files}->{"$configfile/$_"} = 1;
$this->_read($fh);
}
}
}
elsif (-e _) {
if (exists $this->{files}->{$configfile} ) {
# do not read the same file twice, just return
# FIXME: should we croak here, when some "debugging" is enabled?
@@ -357,19 +402,10 @@ sub _open {
$this->{files}->{$configfile} = 1;
my ($volume, $path, undef) = splitpath($configfile);
$this->{'CurrentConfigFilePath'} = catpath($volume, $path, '');
my ($volume, $path, undef) = splitpath($configfile);
local $this->{CurrentConfigFilePath} = catpath($volume, $path, '');
$this->_read($fh);
undef $this->{'CurrentConfigFilePath'};
}
}
else {
if (defined $this->{ConfigPath}) {
croak "The file \"$configfile\" does not exist within ConfigPath: " . join(":", @{$this->{ConfigPath}}) . "!\n";
}
else {
croak "The file \"$configfile\" does not exist!\n";
}
}
}
@@ -583,7 +619,7 @@ sub _parse {
# parse the contents of the file
#
my($this, $config, $content) = @_;
my(@newcontent, $block, $blockname, $grab, $chunk,$block_level);
my(@newcontent, $block, $blockname, $chunk,$block_level);
local $_;
my $indichar = chr(182); # <20>, inserted by _open, our here-doc indicator
@@ -620,14 +656,15 @@ sub _parse {
if (! defined $block) { # not inside a block @ the moment
if (/^<([^\/]+?.*?)>$/) { # look if it is a block
$block = $1; # store block name
if ($block =~ /^"/ && $block =~ /"$/) {
if ($block =~ /^"([^"]+)"$/) {
# quoted block, unquote it and do not split
$block =~ s/"//g;
}
else {
($grab, $blockname) = split /\s\s*/, $block, 2; # is it a named block? if yes, store the name separately
if ($blockname) {
$block = $grab;
# If it is a named block store the name separately; allow the block and name to each be quoted
if ($block =~ /^(?:"([^"]+)"|(\S+))(?:\s+(?:"([^"]+)"|(.*)))?$/) {
$block = $1 || $2;
$blockname = $3 || $4;
}
}
if ($this->{InterPolateVars}) {
@@ -1252,6 +1289,22 @@ will search within B<-ConfigPath> for the file. See the description of B<-Config
for more details.
=item B<-IncludeDirectories>
If set to a true value, you may specify include a directory, in which case all
files inside the directory will be loaded in ASCII order. Directory includes
will not recurse into subdirectories. This is comparable to including a
directory in Apache-style config files.
=item B<-IncludeGlob>
If set to a true value, you may specify a glob pattern for an include to
include all matching files (e.g. <<include conf.d/*.conf>>). Also note that as
with standard file patterns, * will not match dot-files, so <<include dir/*>>
is often more desirable than including a directory with B<-IncludeDirectories>.
=item B<-ConfigPath>
As mentioned above, you can use this variable to specify a search path for relative
@@ -1259,7 +1312,8 @@ config files which have to be included. Config::General will search within this
path for the file if it cannot find the file at the location relative to the
current config file.
You must specify the path as an array ref. For example:
To provide multiple search paths you can specify an array reference for the
path. For example:
@path = qw(/usr/lib/perl /nfs/apps/lib /home/lib);
..
@@ -2119,7 +2173,7 @@ I recommend you to read the following documentations, which are supplied with pe
=head1 COPYRIGHT
Copyright (c) 2000-2005 Thomas Linden
Copyright (c) 2000-2006 Thomas Linden
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
@@ -2136,7 +2190,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
2.30
2.31
=cut

15
General/Extended.pm
View File

@@ -1,7 +1,7 @@
#
# Config::General::Extended - special Class based on Config::General
#
# Copyright (c) 2000-2005 Thomas Linden <tom@daemon.de>.
# Copyright (c) 2000-2006 Thomas Linden <tom@daemon.de>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
@@ -23,7 +23,7 @@ use vars qw(@ISA @EXPORT);
use strict;
$Config::General::Extended::VERSION = "2.01";
$Config::General::Extended::VERSION = "2.02";
sub new {
@@ -225,7 +225,12 @@ sub keys {
#
my($this, $key) = @_;
if (!$key) {
return map { $_ } keys %{$this->{config}};
if (ref($this->{config}) eq "HASH") {
return map { $_ } keys %{$this->{config}};
}
else {
return ();
}
}
elsif (exists $this->{config}->{$key} && ref($this->{config}->{$key}) eq "HASH") {
return map { $_ } keys %{$this->{config}->{$key}};
@@ -571,7 +576,7 @@ values under the given key will be overwritten.
=head1 COPYRIGHT
Copyright (c) 2000-2005 Thomas Linden
Copyright (c) 2000-2006 Thomas Linden
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
@@ -589,7 +594,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
2.01
2.02
=cut

11
General/Interpolated.pm
View File

@@ -2,13 +2,13 @@
# Config::General::Interpolated - special Class based on Config::General
#
# Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>.
# Copyright (c) 2000-2005 by Thomas Linden <tom@daemon.de>.
# Copyright (c) 2000-2006 by Thomas Linden <tom@daemon.de>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
package Config::General::Interpolated;
$Config::General::Interpolated::VERSION = "2.06";
$Config::General::Interpolated::VERSION = "2.07";
use strict;
use Carp;
@@ -92,6 +92,9 @@ sub _interpolate {
elsif ($this->{InterPolateEnv}) {
# may lead to vulnerabilities, by default flag turned off
$con . $ENV{$var};
if (defined($ENV{$var})) {
$con . $ENV{$var};
}
}
else {
if ($this->{StrictVars}) {
@@ -294,7 +297,7 @@ L<Config::General>
=head1 COPYRIGHT
Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
Copyright 2002-2004 by Thomas Linden <tom@daemon.de>.
Copyright 2002-2006 by Thomas Linden <tom@daemon.de>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
@@ -303,7 +306,7 @@ See L<http://www.perl.com/perl/misc/Artistic.html>
=head1 VERSION
2.06
2.07
=cut

2
Makefile.PL
View File

@@ -1,7 +1,7 @@
#
# Makefile.PL - build file for Config::General
#
# Copyright (c) 2000-2005 Thomas Linden <tom@daemon.de>.
# Copyright (c) 2000-2006 Thomas Linden <tom@daemon.de>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#

6
README
View File

@@ -80,11 +80,11 @@ UPDATE
COPYRIGHT
Config::General
Config::General::Extended
Copyright (c) 2000-2005 by Thomas Linden <tom@daemon.de>
Copyright (c) 2000-2006 by Thomas Linden <tom@daemon.de>
Config::General::Interpolated
Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>
Copyright (c) 2002-2005 by Thomas Linden <tom@daemon.de>.
Copyright (c) 2002-2006 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.
@@ -104,4 +104,4 @@ AUTHOR
VERSION
2.30
2.31

112
t/run.t
View File

@@ -6,7 +6,7 @@
#
# Under normal circumstances every test should succeed.
BEGIN { $| = 1; print "1..22\n";}
BEGIN { $| = 1; print "1..24\n";}
use lib "blib/lib";
use Config::General;
use Data::Dumper;
@@ -257,10 +257,12 @@ my $conf22 = Config::General->new(
my %h22 = $conf22->getall;
my %expected_h22 = (
'sub3_seen' => 'yup',
'sub2_seen' => 'yup',
'sub1_seen' => 'yup',
'fruit' => 'mango',
'sub3_seen' => 'yup',
'sub2_seen' => 'yup',
'sub2b_seen' => 'yup',
'sub1_seen' => 'yup',
'sub1b_seen' => 'yup',
'fruit' => 'mango',
);
if (&comp(\%h22, \%expected_h22)) {
@@ -273,6 +275,100 @@ else {
}
pause;
# Testing IncludeDirectories option
my $conf23 = Config::General->new(
-String => "<<include t/sub1>>",
-IncludeDirectories => 1
);
my %h23 = $conf23->getall;
my %expected_h23 = (
fruit => 'mango',
sub1_seen => 'yup',
sub1b_seen => 'yup',
test => 'value',
test2 => 'value2',
test3 => 'value3'
);
if (&comp(\%h23, \%expected_h23)) {
print "ok\n";
print STDERR " .. ok # including a directory with -IncludeDirectories\n";
}
else {
print "23 not ok\n";
print STDERR "23 not ok\n";
}
pause;
# Testing IncludeGlob option
my $conf24 = Config::General->new(
-String => "<<include t/sub1/cfg.sub[123]{c,d,e}>>",
-IncludeGlob => 1
);
my %h24 = $conf24->getall;
my %expected_h24 = (
test => 'value',
test2 => 'value2',
test3 => 'value3'
);
if (&comp(\%h24, \%expected_h24)) {
print "ok\n";
print STDERR " .. ok # including multiple files via glob pattern with -IncludeGlob\n";
}
else {
print "24 not ok\n";
print STDERR "24 not ok\n";
}
pause;
# Testing block and block name quoting
my $conf25 = Config::General->new(
-String => <<TEST,
<block "/">
opt1 val1
</block>
<"block2 /">
opt2 val2
</"block2 /">
<"block 3" "/">
opt3 val3
</"block 3">
<block4 />
opt4 val4
</block4>
TEST
-SlashIsDirectory => 1
);
my %h25 = $conf25->getall;
my %expected_h25 = (
block => { '/' => { opt1 => 'val1' } },
'block2 /' => { opt2 => 'val2' },
'block 3' => { '/' => { opt3 => 'val3' } },
block4 => { '/' => { opt4 => 'val4' } }
);
if (&comp(\%h25, \%expected_h25)) {
print "ok\n";
print STDERR " .. ok # block and block name quoting\n";
}
else {
print "25 not ok\n";
print STDERR "25 not ok\n";
}
pause;
@@ -293,9 +389,11 @@ sub p {
sub comp {
my($a, $b) = @_;
foreach my $key (keys %{$a}) {
my %keys = map { $_ => 1 } keys %$a, keys %$b;
foreach my $key (keys %keys) {
return 0 unless exists $a->{$key} and exists $b->{$key};
if(ref($a->{$key}) eq "HASH") {
&comp($a->{$key},$b->{$key});
return 0 unless &comp($a->{$key},$b->{$key});
next;
}
elsif(ref($a->{$key}) eq "ARRAY") {

2
t/sub1/cfg.sub1
View File

@@ -1,3 +1,3 @@
fruit = mango
sub3_seen = yup
sub1_seen = yup

3
t/sub1/sub2/cfg.sub2
View File

@@ -1,4 +1,5 @@
fruit = pear
sub2_seen = yup
<<include ../cfg.sub1>>
<<include ../cfg.sub1>>
<<include ../cfg.sub1b>>

2
t/sub1/sub2/sub3/cfg.sub3
View File

@@ -2,4 +2,4 @@ fruit = apple
sub3_seen = yup
<<include ../cfg.sub2>>
<<include ../cfg.sub2b>>