2.12 - fixed cpan bugid #1768, stuff inside a hash given

by the -DefaultConfig parameter was ignored by
	   the new interpolation code, this has been fixed.

	 - fixed another bug in the new interpolation code,
	   which made variable global, the variable scope
	   were ignored. Now a special constructed hash
	   exists, which makes sure, that variables only
	   valid within its correct scope.


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

Changelog

@@ -1,3 +1,13 @@
+ 2.12    - fixed cpan bugid #1768, stuff inside a hash given
+	   by the -DefaultConfig parameter was ignored by
+	   the new interpolation code, this has been fixed.
+
+	 - fixed another bug in the new interpolation code,
+	   which made variable global, the variable scope
+	   were ignored. Now a special constructed hash
+	   exists, which makes sure, that variables only
+	   valid within its correct scope.
+
  2.11	 - heavy change in the variable interpolation code.
 	   Peter Sergeant <pete@clueball.com> reported this
 	   mis-behavior. The problem was that the whole hash

General.pm

@@ -17,7 +17,7 @@ use strict;
 use Carp;
 use Exporter;
 
-$Config::General::VERSION = "2.11";
+$Config::General::VERSION = "2.12";
 
 use vars  qw(@ISA @EXPORT);
 @ISA    = qw(Exporter);
@@ -69,7 +69,10 @@ sub new {
 
 	      StrictVars            => 1,       # be strict on undefined variables in Interpolate mode
 
-	      parsed                => 0
+	      parsed                => 0,
+	      upperkey              => "",
+	      lastkey               => "",
+	      prevkey               => " ",
 	     };
 
   # create the class instance
@@ -197,6 +200,9 @@ sub new {
 
   # process as usual
   if (!$self->{parsed}) {
+    if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
+      $self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig});
+    }
     if (exists $self->{StringContent}) {
       # consider the supplied string as config file
       $self->_read($self->{StringContent}, "SCALAR");
@@ -408,8 +414,6 @@ sub _parse {
   local $_;
   my $indichar = chr(182);  # <20>, inserted by _open, our here-doc indicator
 
-
-
   foreach (@{$content}) {                                  # loop over content stack
     chomp;
     $chunk++;
@@ -436,7 +440,6 @@ sub _parse {
       }
     }
 
-
     if ($value && $value =~ /^"/ && $value =~ /"$/) {
       $value =~ s/^"//;                                    # remove leading and trailing "
       $value =~ s/"$//;
@@ -503,6 +506,7 @@ sub _parse {
       }
       else {                                               # calling myself recursively, end of $block reached, $block_level is 0
 	if ($blockname) {                                  # a named block, make it a hashref inside a hash within the current node
+	  $this->_savelast($blockname);
 	  if (exists $config->{$block}->{$blockname}) {    # the named block already exists, make it an array
 	    if ($this->{MergeDuplicateBlocks}) {
 	      # just merge the new block with the same name as an existing one into
@@ -531,8 +535,10 @@ sub _parse {
 	  else {                                          # the first occurence of this particular named block
 	    $config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
 	  }
+	  $this->_backlast($blockname);
 	}
 	else {                                             # standard block
+	  $this->_savelast($block);
 	  if (exists $config->{$block}) {                  # the block already exists, make it an array
 	    if ($this->{MergeDuplicateBlocks}) {
 	      # just merge the new block with the same name as an existing one into
@@ -562,6 +568,7 @@ sub _parse {
 	    # the first occurence of this particular block
 	    $config->{$block} = $this->_parse($config->{$block}, \@newcontent);
 	  }
+	  $this->_backlast($block);
 	}
 	undef $blockname;
 	undef $block;
@@ -582,8 +589,18 @@ sub _parse {
 }
 
 
+sub _savelast {
+  my($this, $key) = @_;
+  $this->{upperkey} = $this->{lastkey};
+  $this->{lastkey}  = $this->{prevkey};
+  $this->{prevkey}  = $key;
+}
 
-
+sub _backlast {
+  my($this, $key) = @_;
+  $this->{prevkey} = $this->{lastkey};
+  $this->{lastkey} = $this->{upperkey};
+}
 
 sub _parse_value {
   #
@@ -1724,7 +1741,7 @@ Thomas Linden <tom@daemon.de>
 
 =head1 VERSION
 
-2.11
+2.12
 
 =cut
 

General/Interpolated.pm

@@ -1,5 +1,5 @@
 package Config::General::Interpolated;
-$Config::General::Interpolated::VERSION = "2.0";
+$Config::General::Interpolated::VERSION = "2.01";
 
 use strict;
 use Carp;
@@ -56,11 +56,27 @@ sub _interpolate  {
   #
   my ($this, $key, $value) = @_;
 
+  my $prevkey;
+
+  if ($this->{level} == 1) {
+    # top level
+    $prevkey = " ";
+  }
+  else {
+    # incorporate variables outside current scope(block) into
+    # our scope to make them visible to _interpolate()
+    foreach my $key (keys %{$this->{stack}->{ $this->{level} - 1}->{ $this->{lastkey} }}) {
+      $this->{stack}->{ $this->{level} }->{ $this->{prevkey} }->{$key} =
+	$this->{stack}->{ $this->{level} - 1}->{ $this->{lastkey} }->{$key};
+    }
+    $prevkey = $this->{prevkey};
+  }
+
   $value =~ s{$this->{regex}}{
     my $con = $1;
     my $var = $3;
-    if (exists $this->{varstack}->{$var}) {
+    if (exists $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var}) {
-      $con . $this->{varstack}->{$var};
+      $con . $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var};
     }
     else {
       if ($this->{StrictVars}) {
@@ -73,12 +89,98 @@ sub _interpolate  {
     }
   }egx;
 
-  $this->{varstack}->{$key} = $value;
+  $this->{stack}->{ $this->{level} }->{ $prevkey }->{$key} = $value;
 
   return $value;
 };
 
 
+sub _interpolate_hash {
+  #
+  # interpolate a complete hash and keep the results
+  # on the varstack.
+  #
+  # called directly by Config::General::new()
+  #
+  my ($this, $config) = @_;
+
+  $this->{level}    = 1;
+  $this->{upperkey} = "";
+  $this->{lastkey}  = "";
+  $this->{prevkey}  = " ";
+
+  $config = $this->_var_hash_stacker($config);
+
+  $this->{level}    = 1;
+  $this->{upperkey} = "";
+  $this->{lastkey}  = "";
+  $this->{prevkey}  = " ";
+
+  return $config;
+}
+
+sub _var_hash_stacker {
+  #
+  # build a varstack of a given hash ref
+  #
+  my ($this, $config) = @_;
+
+  
+
+  foreach my $key (keys %{$config}) {
+    if (ref($config->{$key}) eq "ARRAY" ) {
+      $this->{level}++;
+      $this->_savelast($key);
+      $config->{$key} = $this->_var_array_stacker($config->{$key}, $key);
+      $this->_backlast($key);
+      $this->{level}--;
+    }
+    elsif (ref($config->{$key}) eq "HASH") {
+      $this->{level}++;
+      $this->_savelast($key);
+      $config->{$key} = $this->_var_hash_stacker($config->{$key});
+      $this->_backlast($key);
+      $this->{level}--;
+    }
+    else {
+      # SCALAR
+      $config->{$key} = $this->_interpolate($key, $config->{$key});
+    }
+  }
+
+  #$this->{level}--;
+  return $config;
+}
+
+
+sub _var_array_stacker {
+  #
+  # same as _var_hash_stacker but for arrayrefs
+  #
+  my ($this, $config, $key) = @_;
+
+  my @new;
+  #$this->{level}++;
+
+  foreach my $entry (@{$config}) {
+    if (ref($entry) eq "HASH") {
+      $entry = $this->_var_hash_stacker($entry);
+    }
+    elsif (ref($entry) eq "ARRAY") {
+      # ignore this. Arrays of Arrays cannot be created/supported
+      # with Config::General, because they are not accessible by
+      # any key (anonymous array-ref)
+      next;
+    }
+    else {
+      $entry = $this->_interpolate($key, $entry);
+    }
+    push @new, $entry;
+  }
+
+  return  \@new;
+}
+
 
 1;
 
@@ -184,7 +286,7 @@ See L<http://www.perl.com/perl/misc/Artistic.html>
 
 =head1 VERSION
 
-2.0
+2.01
 
 =cut
 

README

@@ -104,4 +104,4 @@ AUTHOR
 
 
 VERSION
-	2.11
+	2.12

t/run.t

@@ -120,7 +120,7 @@ print STDERR " .. ok # Using AUTOLOAD methods\n";
 
 
 # testing variable interpolation
-my $conf16 = new Config::General(-ConfigFile => "t/cfg.16", -InterPolateVars => 1);
+my $conf16 = new Config::General(-ConfigFile => "t/cfg.16", -InterPolateVars => 1, -StrictVars => 0);
 my %h16 = $conf16->getall();
 if($h16{etc}->{log} eq "/usr/local/log/logfile") {
    print "ok\n";