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.


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@57 be1acefe-a474-0410-9a34-9b3221f2030f

Changelog

@@ -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

General.pm

@@ -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}) ) {
+  if ($this->{IncludeGlob} and $configfile =~ /[*?\[\{\\]/) {
-    # try to find the file within ConfigPath
+    # Something like: *.conf (or maybe dir/*.conf) was included; expand it and
-    foreach my $dir (@{$this->{ConfigPath}}) {
+    # pass each expansion through this method again.
-      if( -e catfile($dir, $configfile) ) {
+    my @include = grep -f, bsd_glob($configfile, GLOB_BRACE | GLOB_QUOTE);
-	$configfile = catfile($dir, $configfile);
+    if (@include == 1) {
-	last; # found it
+      $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);
+      my ($volume, $path, undef)           = splitpath($configfile);
-      $this->{'CurrentConfigFilePath'} = catpath($volume, $path, '');
+      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 it is a named block store the name separately; allow the block and name to each be quoted
-	  if ($blockname) {
+	  if ($block =~ /^(?:"([^"]+)"|(\S+))(?:\s+(?:"([^"]+)"|(.*)))?$/) {
-	    $block = $grab;
+	    $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
 

General/Extended.pm

@@ -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
 

General/Interpolated.pm

@@ -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
 

Makefile.PL

@@ -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.
 #

README

@@ -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

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',
+    'sub3_seen'  => 'yup',
-    'sub2_seen' => 'yup',
+    'sub2_seen'  => 'yup',
-    'sub1_seen' => 'yup',
+    'sub2b_seen' => 'yup',
-    'fruit'     => 'mango',
+    '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") {

t/sub1/cfg.sub1

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

t/sub1/sub2/cfg.sub2

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

t/sub1/sub2/sub3/cfg.sub3

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