From 5e99e1f8b2e9b187876c61c700d84a21bf92f510 Mon Sep 17 00:00:00 2001
From: Thomas von Dein <git@daemon.de>
Date: Sat, 10 Oct 2009 16:26:40 +0000
Subject: [PATCH]  2.15    - fixed Bug in SaveConfig***, which didn't work.    
      - applied patch by Robb Canfield <robb@canfield.com>, 	   which fixes
 a bug in the variable interpolation 	   scheme. It did not interpolate
 blocks nor 	   blocknames. This patch fixes this. Patch slightly 	  
 modified by me(interpolation on block and blocknames). 	 - enhanced
 test for variable interpolation to 	   reflect this. 	 - added check
 if a named block occurs after the underlying 	   block is already an array,
 which is not possible. 	   perl cannot add a hashref to an array.
 i.e.: 	   <bl>  	     a = 1 	   </bl> 	   <bl>  	     b
 = 1 	   </bl> 	   <bl blubber>  	     c = 1 	   </bl> 
    As you can see, "<bl>" will be an array, and "blubber" 	   cannot be
 stored in any way on this array. 	   The module croaks now if such
 construct occurs.

git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@41 be1acefe-a474-0410-9a34-9b3221f2030f
---
 Changelog               | 24 ++++++++++++++++++++++++
 General.pm              | 26 +++++++++++++++++++-------
 General/Interpolated.pm |  4 ----
 t/cfg.16                | 16 ++++++++++++++++
 4 files changed, 59 insertions(+), 11 deletions(-)

diff --git a/Changelog b/Changelog
index b5dabf9..b114fdc 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,27 @@
+ 2.15    - fixed Bug in SaveConfig***, which didn't work.
+         - applied patch by Robb Canfield <robb@canfield.com>,
+	   which fixes a bug in the variable interpolation
+	   scheme. It did not interpolate blocks nor
+	   blocknames. This patch fixes this. Patch slightly
+	   modified by me(interpolation on block and blocknames).
+	 - enhanced test for variable interpolation to
+	   reflect this.
+	 - added check if a named block occurs after the underlying
+	   block is already an array, which is not possible.
+	   perl cannot add a hashref to an array. i.e.:
+	   <bl>
+ 	     a = 1
+	   </bl>
+	   <bl>
+ 	     b = 1
+	   </bl>
+	   <bl blubber>
+ 	     c = 1
+	   </bl>
+	   As you can see, "<bl>" will be an array, and "blubber"
+	   cannot be stored in any way on this array.
+	   The module croaks now if such construct occurs.
+
  2.14    - fixed bug reported by Francisco Olarte Sanz
 	   <folarte@peoplecall.com>, which caused _parse to
 	   ignore blocks with the name "0": 
diff --git a/General.pm b/General.pm
index 0f25ffd..49f2ffa 100644
--- a/General.pm
+++ b/General.pm
@@ -17,7 +17,7 @@ use strict;
 use Carp;
 use Exporter;
 
-$Config::General::VERSION = "2.14";
+$Config::General::VERSION = "2.15";
 
 use vars  qw(@ISA @EXPORT);
 @ISA    = qw(Exporter);
@@ -493,13 +493,21 @@ sub _parse {
     }
     if (! defined $block) {                                # not inside a block @ the moment
       if (/^<([^\/]+?.*?)>$/) {                            # look if it is a block
-	$this->{level} += 1;
 	$block = $1;                                       # store block name
 	($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
+	  # it is sure that such keys does not exist otherwise.
+	  $block     = $this->_interpolate("<$block>", $block);
+	  if ($blockname) {
+	    $blockname = $this->_interpolate("<$blockname>", $blockname);
+	  }
+	}
 	$block = lc($block) if $this->{LowerCaseNames};    # only for blocks lc(), if configured via new()
+	$this->{level} += 1;
 	undef @newcontent;
 	next;
       }
@@ -579,7 +587,12 @@ sub _parse {
 	      }
 	    }
 	  }
-	  else {                                          # the first occurence of this particular named block
+	  elsif (ref($config->{$block}) eq "ARRAY") {
+	    croak "Cannot add named block <$block $blockname> to hash! Block <$block> occurs more than once.\n"
+	         ."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n";
+	  }
+	  else {
+	    # the first occurence of this particular named block
 	    $config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
 	  }
 	  $this->_backlast($blockname);
@@ -905,7 +918,7 @@ sub SaveConfig {
       croak "The second parameter must be a reference to a hash!";
     }
     else {
-      (new Config::General($hash))->save_file($file);
+      (new Config::General(-ConfigHash => $hash))->save_file($file);
     }
   }
 }
@@ -925,7 +938,7 @@ sub SaveConfigString {
       croak "The parameter must be a reference to a hash!";
     }
     else {
-      return (new Config::General($hash))->save_string();
+      return (new Config::General(-ConfigHash => $hash))->save_string();
     }
   }
 }
@@ -1780,7 +1793,6 @@ modify it under the same terms as Perl itself.
 
 none known yet.
 
-
 =head1 AUTHOR
 
 Thomas Linden <tom@daemon.de>
@@ -1788,7 +1800,7 @@ Thomas Linden <tom@daemon.de>
 
 =head1 VERSION
 
-2.14
+2.15
 
 =cut
 
diff --git a/General/Interpolated.pm b/General/Interpolated.pm
index 301b454..daba9d6 100644
--- a/General/Interpolated.pm
+++ b/General/Interpolated.pm
@@ -125,8 +125,6 @@ sub _var_hash_stacker {
   #
   my ($this, $config) = @_;
 
-  
-
   foreach my $key (keys %{$config}) {
     if (ref($config->{$key}) eq "ARRAY" ) {
       $this->{level}++;
@@ -148,7 +146,6 @@ sub _var_hash_stacker {
     }
   }
 
-  #$this->{level}--;
   return $config;
 }
 
@@ -160,7 +157,6 @@ sub _var_array_stacker {
   my ($this, $config, $key) = @_;
 
   my @new;
-  #$this->{level}++;
 
   foreach my $entry (@{$config}) {
     if (ref($entry) eq "HASH") {
diff --git a/t/cfg.16 b/t/cfg.16
index 45bd29b..d515907 100644
--- a/t/cfg.16
+++ b/t/cfg.16
@@ -14,3 +14,19 @@ pr=$me/blubber
     home = $base/home/max # $base should be interpolated
   </users>
 </etc>
+
+# block(name) test
+tag  = dir
+mono = teri
+<$tag>
+  bl = 1
+</$tag>
+<$tag mono>
+  bl = 2
+</$tag>
+<text $mono>
+  bl = 3
+</text>
+<$tag $mono>
+  bl = 3
+</$tag>