diff --git a/Changelog b/Changelog index 36da504..7ff0905 100644 --- a/Changelog +++ b/Changelog @@ -1,6 +1,38 @@ + 2.31 + - applied patches by Jason Rhinelander : + 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 : + ::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 · - - applied patch by Branislav Zahradnik which adds -InterPolateEnv. This allows to use environment variables too. It diff --git a/General.pm b/General.pm index f91b2ee..52ab755 100644 --- a/General.pm +++ b/General.pm @@ -5,7 +5,7 @@ # config values from a given file and # return it as hash structure # -# Copyright (c) 2000-2005 Thomas Linden . +# Copyright (c) 2000-2006 Thomas Linden . # 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); # ¶, 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. <>). Also note that as +with standard file patterns, * will not match dot-files, so <> +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 =head1 VERSION -2.30 +2.31 =cut diff --git a/General/Extended.pm b/General/Extended.pm index d18028c..2772563 100644 --- a/General/Extended.pm +++ b/General/Extended.pm @@ -1,7 +1,7 @@ # # Config::General::Extended - special Class based on Config::General # -# Copyright (c) 2000-2005 Thomas Linden . +# Copyright (c) 2000-2006 Thomas Linden . # 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 =head1 VERSION -2.01 +2.02 =cut diff --git a/General/Interpolated.pm b/General/Interpolated.pm index 43c455b..103e23d 100644 --- a/General/Interpolated.pm +++ b/General/Interpolated.pm @@ -2,13 +2,13 @@ # Config::General::Interpolated - special Class based on Config::General # # Copyright (c) 2001 by Wei-Hon Chen . -# Copyright (c) 2000-2005 by Thomas Linden . +# Copyright (c) 2000-2006 by Thomas Linden . # 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 =head1 COPYRIGHT Copyright 2001 by Wei-Hon Chen Eplasmaball@pchome.com.twE. -Copyright 2002-2004 by Thomas Linden . +Copyright 2002-2006 by Thomas Linden . 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 =head1 VERSION -2.06 +2.07 =cut diff --git a/Makefile.PL b/Makefile.PL index 92a9950..e214c9f 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,7 +1,7 @@ # # Makefile.PL - build file for Config::General # -# Copyright (c) 2000-2005 Thomas Linden . +# Copyright (c) 2000-2006 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artificial License, same as perl itself. Have fun. # diff --git a/README b/README index 1f30d33..ea5c6a4 100644 --- a/README +++ b/README @@ -80,11 +80,11 @@ UPDATE COPYRIGHT Config::General Config::General::Extended - Copyright (c) 2000-2005 by Thomas Linden + Copyright (c) 2000-2006 by Thomas Linden Config::General::Interpolated Copyright (c) 2001 by Wei-Hon Chen - Copyright (c) 2002-2005 by Thomas Linden . + Copyright (c) 2002-2006 by Thomas Linden . 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 diff --git a/t/run.t b/t/run.t index 551fcca..c52d1a1 100644 --- a/t/run.t +++ b/t/run.t @@ -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 => "<>", + -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 => "<>", + -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 => < + opt1 val1 + +<"block2 /"> + opt2 val2 + +<"block 3" "/"> + opt3 val3 + + + opt4 val4 + +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") { diff --git a/t/sub1/cfg.sub1 b/t/sub1/cfg.sub1 index 1ad8c8c..d5ef884 100644 --- a/t/sub1/cfg.sub1 +++ b/t/sub1/cfg.sub1 @@ -1,3 +1,3 @@ fruit = mango -sub3_seen = yup +sub1_seen = yup diff --git a/t/sub1/sub2/cfg.sub2 b/t/sub1/sub2/cfg.sub2 index a6aaf96..f31638f 100644 --- a/t/sub1/sub2/cfg.sub2 +++ b/t/sub1/sub2/cfg.sub2 @@ -1,4 +1,5 @@ fruit = pear sub2_seen = yup -<> \ No newline at end of file +<> +<> diff --git a/t/sub1/sub2/sub3/cfg.sub3 b/t/sub1/sub2/sub3/cfg.sub3 index 450ffd7..fa4b573 100644 --- a/t/sub1/sub2/sub3/cfg.sub3 +++ b/t/sub1/sub2/sub3/cfg.sub3 @@ -2,4 +2,4 @@ fruit = apple sub3_seen = yup <> - +<>