2.28

- fixed bug in save(), now blocks containing whitespaces
	   will be saved using quotes, in addition the parser observes
	   the quoting feature, added portion about this to the pod
	   doc. pointed out by Jeff Murphy <jcmurphy@jeffmurphy.org>.

	 - added internal list of files opened so far to avoid
	   reading in the same file multiple times.
	   Suggested by Michael Graham.

	 - added new method files() which returns the above list.

	 - added workaround for foolish perl installation on
	   debian systems (croak() doesn't work anymore as of
	   5.8.4, it's a shame!)

	 - applied patch by Michael Graham which fixes IncludeRelative
	   feature, now an included file is being included relative
	   to the calling config file, not the first one.

	 - added 'make test' targets for files() and include
	   stuff. (by Michael too)


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

Changelog

@@ -1,3 +1,22 @@
+ 2.28
+	 - added internal list of files opened so far to avoid
+	   reading in the same file multiple times.
+	   Suggested by Michael Graham.
+
+	 - added new method files() which returns the above list.
+
+	 - added workaround for foolish perl installation on
+	   debian systems (croak() doesn't work anymore as of
+	   5.8.4, it's a shame!)
+
+	 - applied patch by Michael Graham which fixes IncludeRelative
+	   feature, now an included file is being included relative
+	   to the calling config file, not the first one.
+
+	 - added 'make test' targets for files() and include
+	   stuff. (by Michael too)
+
+
  2.27
          - bugfix in _store, which caused warning when saving
 	   a config containing empty hashes. Reported by 

General.pm

@@ -5,7 +5,7 @@
 #          config values from a given file and
 #          return it as hash structure
 #
-# Copyright (c) 2000-2004 Thomas Linden <tom@daemon.de>.
+# Copyright (c) 2000-2005 Thomas Linden <tom@daemon.de>.
 # All Rights Reserved. Std. disclaimer applies.
 # Artificial License, same as perl itself. Have fun.
 #
@@ -15,10 +15,18 @@ package Config::General;
 use FileHandle;
 use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath);
 use strict;
+
+# on debian with perl > 5.8.4 croak() doesn't work anymore without this.
+# There is some require statement which dies 'cause it can't find Carp::Heavy,
+# I really don't understand, what the hell they made, but the debian perl
+# installation is definetly bullshit, damn!
+use Carp::Heavy;
+
+
 use Carp;
 use Exporter;
 
-$Config::General::VERSION = "2.27";
+$Config::General::VERSION = "2.28";
 
 use vars  qw(@ISA @EXPORT);
 @ISA    = qw(Exporter);
@@ -80,6 +88,7 @@ sub new {
 	      upperkey              => "",
 	      lastkey               => "",
 	      prevkey               => " ",
+	      files                 => {},      # which files we have read, if any
 	     };
 
   # create the class instance
@@ -298,6 +307,14 @@ sub getall {
 }
 
 
+sub files {
+  #
+  # return a list of files opened so far
+  #
+  my($this) = @_;
+  return (exists $this->{files} ? keys %{$this->{files}} : () );
+}
+
 
 sub _open {
   #
@@ -323,8 +340,22 @@ sub _open {
   }
 
   if (-e $configfile) {
-    open $fh, "<$configfile" or croak "Could not open $configfile!($!)\n";
+    if (exists $this->{files}->{$configfile} ) {
-    $this->_read($fh);
+      # do not read the same file twice, just return
+      # FIXME: should we croak here, when some "debugging" is enabled?
+      return;
+    }
+    else {
+      open $fh, "<$configfile" or croak "Could not open $configfile!($!)\n";
+
+      $this->{files}->{$configfile}    = 1;
+
+      my ($volume, $path, undef)       = splitpath($configfile);
+      $this->{'CurrentConfigFilePath'} = catpath($volume, $path, '');
+
+      $this->_read($fh);
+      undef $this->{'CurrentConfigFilePath'};
+    }
   }
   else {
     if (defined $this->{ConfigPath}) {
@@ -496,7 +527,10 @@ sub _read {
       # look for include statement(s)
       my $incl_file;
       my $path = "";
-      if (defined($this->{ConfigPath})) {
+      if ( $this->{IncludeRelative} and defined($this->{CurrentConfigFilePath})) {
+      	$path = $this->{CurrentConfigFilePath};
+      }
+      elsif (defined($this->{ConfigPath})) {
 	# fetch pathname of base config file, assuming the 1st one is the path of it
 	$path = $this->{ConfigPath}->[0];
       }
@@ -567,9 +601,15 @@ sub _parse {
     if (! defined $block) {                                # not inside a block @ the moment
       if (/^<([^\/]+?.*?)>$/) {                            # look if it is a block
 	$block = $1;                                       # store block name
-	($grab, $blockname) = split /\s\s*/, $block, 2;    # is it a named block? if yes, store the name separately
+	if ($block =~ /^"/ && $block =~ /"$/) {
-	if ($blockname) {
+	  # quoted block, unquote it and do not split
-	  $block = $grab;
+	  $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 ($this->{InterPolateVars}) {
 	  # interpolate block(name), add "<" and ">" to the key, because
@@ -965,6 +1005,11 @@ sub _write_hash {
   my $indent = "    " x $level;
   my $config_string;
 
+  if ($entry =~ /\s/) {
+    # quote the entry if it contains whitespaces
+    $entry = '"' . $entry . '"';
+  }
+
   $config_string .= $indent . "<" . $entry . ">\n";
   $config_string .= $this->_store($level + 1, %{$line});
   $config_string .= $indent . "</" . $entry . ">\n";
@@ -1450,6 +1495,9 @@ By default it is turned off.
 
 Returns a hash structure which represents the whole config.
 
+=item files()
+
+Returns a list of all files read in.
 
 =item save_file()
 
@@ -1657,6 +1705,42 @@ You cannot have more than one named block with the same name because it will
 be stored in a hashref and therefore be overwritten if a block occurs once more.
 
 
+=head1 WHITESPACES IN BLOCKS
+
+The normal behavior of Config::General is to look for whitespaces in
+block names to decide if it's a named block or just a simple block.
+
+Sometimes you may need blocknames which have whitespaces in their names.
+
+With named blocks this is no problem, as the module only looks for the
+first whitespace:
+
+ <person hugo gera>
+ </person>
+
+would be parsed to:
+
+ $VAR1 = {
+          'person' => {
+                       'hugo gera' => {
+                                      },
+                      }
+         };
+
+The problem occurs, if you want to have a simple block containing whitespaces:
+
+ <hugo gera>
+ </hugo gera>
+
+This would be parsed as a named block, which is not what you wanted. In this
+very case you may use quotation marks to indicate that it is not a named block:
+
+ <"hugo gera">
+ </"hugo gera">
+
+The save() method of the module inserts automatically quotation marks in such
+cases.
+
 
 =head1 EXPICIT EMPTY BLOCKS
 
@@ -1968,7 +2052,7 @@ I recommend you to read the following documentations, which are supplied with pe
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000-2004 Thomas Linden
+Copyright (c) 2000-2005 Thomas Linden
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
@@ -1985,7 +2069,7 @@ Thomas Linden <tom@daemon.de>
 
 =head1 VERSION
 
-2.27
+2.28
 
 =cut
 

General/Extended.pm

@@ -1,7 +1,7 @@
 #
 # Config::General::Extended - special Class based on Config::General
 #
-# Copyright (c) 2000-2004 Thomas Linden <tom@daemon.de>.
+# Copyright (c) 2000-2005 Thomas Linden <tom@daemon.de>.
 # All Rights Reserved. Std. disclaimer applies.
 # Artificial License, same as perl itself. Have fun.
 #
@@ -522,7 +522,7 @@ values under the given key will be overwritten.
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000-2004 Thomas Linden
+Copyright (c) 2000-2005 Thomas Linden
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.

General/Interpolated.pm

@@ -1,3 +1,12 @@
+#
+# 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>.
+# All Rights Reserved. Std. disclaimer applies.
+# Artificial License, same as perl itself. Have fun.
+#
+
 package Config::General::Interpolated;
 $Config::General::Interpolated::VERSION = "2.04";
 

Makefile.PL

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

README

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

t/cfg.20.b

@@ -0,0 +1,2 @@
+seen_cfg.20.b = true
+<<include t/cfg.20.c>>

t/cfg.20.c

@@ -0,0 +1,2 @@
+seen_cfg.20.c = true
+last          = cfg.20.c

t/run.t

@@ -6,7 +6,7 @@
 #
 # Under normal circumstances every test should succeed.
 
-BEGIN { $| = 1; print "1..19\n";}
+BEGIN { $| = 1; print "1..22\n";}
 use lib "blib/lib";
 use Config::General;
 use Data::Dumper;
@@ -194,6 +194,87 @@ else {
 pause;
 
 
+# testing files() method
+my $conf20 = Config::General->new(
+    -file => "t/cfg.20.a",
+    -MergeDuplicateOptions => 1
+);
+my %h20 = $conf20->getall();
+
+my %expected_h20 = (
+    'seen_cfg.20.a' => 'true',
+    'seen_cfg.20.b' => 'true',
+    'seen_cfg.20.c' => 'true',
+    'last'          => 'cfg.20.c',
+);
+
+my %files = map { $_ => 1 } $conf20->files();
+
+my %expected_files = map { $_ => 1 } (
+    't/cfg.20.a',
+    't/cfg.20.b',
+    't/cfg.20.c',
+);
+
+if (&comp(\%h20, \%expected_h20) and &comp(\%files, \%expected_files)) {
+  print "ok\n";
+  print STDERR " .. ok # testing files() method\n";
+}
+else {
+  print "20 not ok\n";
+  print STDERR "20 not ok\n";
+}
+pause;
+
+# testing improved IncludeRelative option
+
+# First try without -IncludeRelative
+# this should fail
+eval {
+    my $conf21 = Config::General->new(
+        -file => "t/sub1/sub2/sub3/cfg.sub3",
+        -MergeDuplicateOptions => 1,
+    );
+};
+if ($@) {
+  print "ok\n";
+  print STDERR " .. ok # prevented from loading relative cfgs without -IncludeRelative\n";
+}
+else {
+  print "21 not ok\n";
+  print STDERR "21 not ok\n";
+}
+pause;
+
+# Now try with -IncludeRelative
+# this should fail
+
+my $conf22 = Config::General->new(
+    -file => "t/sub1/sub2/sub3/cfg.sub3",
+    -MergeDuplicateOptions => 1,
+    -IncludeRelative       => 1,
+);
+
+my %h22 = $conf22->getall;
+my %expected_h22 = (
+    'sub3_seen' => 'yup',
+    'sub2_seen' => 'yup',
+    'sub1_seen' => 'yup',
+    'fruit'     => 'mango',
+);
+
+if (&comp(\%h22, \%expected_h22)) {
+  print "ok\n";
+  print STDERR " .. ok # loaded relative to included files\n";
+}
+else {
+  print "22 not ok\n";
+  print STDERR "22 not ok\n";
+}
+pause;
+
+
+
 
 # all subs here
 

t/sub1/cfg.sub1

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

t/sub1/sub2/cfg.sub2

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

t/sub1/sub2/sub3/cfg.sub3

@@ -0,0 +1,5 @@
+fruit     = apple
+sub3_seen = yup
+
+<<include ../cfg.sub2>>
+