2.37

- "fixed" rt.cpan.org#30199 - check for invalid and
	  unsupported structures, especially mixing blocks
	  and scalars with identical names.

	- added checks to 'make test' to test for the above
	  checks.

	- revoked patch of rt.cpan.org#27225, it broke running
	  code.

	- fixed rt.cpan.org#30063 (and #27225!) by reimplementing
	  the whole interpolation code. The internal stack is
	  no more a class variable of the module but stored
	  directly within the generated config hash and cleaned
	  before returning to the user.

	- added (modified) patch rt.cpan.org#30063 to check
	  if interpolation works with supplied default config
	  works.


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

Changelog

@@ -1,3 +1,25 @@
+ 2.37
+	- "fixed" rt.cpan.org#30199 - check for invalid and
+	  unsupported structures, especially mixing blocks
+	  and scalars with identical names.
+
+	- added checks to 'make test' to test for the above
+	  checks.
+
+	- revoked patch of rt.cpan.org#27225, it broke running
+	  code.
+
+	- fixed rt.cpan.org#30063 (and #27225!) by reimplementing
+	  the whole interpolation code. The internal stack is
+	  no more a class variable of the module but stored
+	  directly within the generated config hash and cleaned
+	  before returning to the user.
+
+	- added (modified) patch rt.cpan.org#30063 to check
+	  if interpolation works with supplied default config
+	  works.
+
+
  2.36
 	- oh my goodness! For some unknown reason I deleted the
 	  Makefile.PL before packaging. Dammit. So, here it is

General.pm

@@ -32,7 +32,7 @@ use Carp::Heavy;
 use Carp;
 use Exporter;
 
-$Config::General::VERSION = 2.34;
+$Config::General::VERSION = 2.37;
 
 use vars  qw(@ISA @EXPORT_OK);
 use base qw(Exporter);
@@ -78,10 +78,6 @@ sub new {
 	      StrictVars            => 1,       # be strict on undefined variables in Interpolate mode
 	      Tie                   => q(),      # could be set to a perl module for tie'ing new hashes
 	      parsed                => 0,       # internal state stuff for variable interpolation
-	      upperkey              => q(),
-	      upperkeys             => [],
-	      lastkey               => q(),
-	      prevkey               => q( ),
 	      files                 => {},      # which files we have read, if any
 	     };
 
@@ -116,6 +112,10 @@ sub new {
     $self->_process();
   }
 
+  if ($self->{InterPolateVars}) {
+    $self->{config} = $self->_clean_stack($self->{config});
+  }
+
   # bless into OOP namespace if required
   $self->_blessoop();
 
@@ -144,7 +144,7 @@ sub _process {
       $self->{parsed} = 1;
     }
     else {
-      croak "Parameter -ConfigHash must be a hash reference!\n";
+      croak "Config::General: Parameter -ConfigHash must be a hash reference!\n";
     }
   }
   elsif (ref($self->{ConfigFile}) eq 'GLOB' || ref($self->{ConfigFile}) eq 'FileHandle') {
@@ -191,7 +191,7 @@ sub _blessoop {
       require Config::General::Extended;
     };
     if ($EVAL_ERROR) {
-      croak $EVAL_ERROR;
+      croak "Config::General: " . $EVAL_ERROR;
     }
   }
 #  return $self;
@@ -212,7 +212,7 @@ sub _blessvars {
       require Config::General::Interpolated;
     };
     if ($EVAL_ERROR) {
-      croak $EVAL_ERROR;
+      croak "Config::General: " . $EVAL_ERROR;
     }
     # pre-compile the variable regexp
     $self->{regex} = $self->_set_regex();
@@ -240,11 +240,11 @@ sub _splitpolicy {
     }
     elsif ($self->{SplitPolicy} eq 'custom') {
       if (! $self->{SplitDelimiter} ) {
-	croak "SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
+	croak "Config::General: SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
       }
     }
     else {
-      croak "Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
+      croak "Config::General: Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
     }
   }
   else {
@@ -299,7 +299,7 @@ sub _prepare {
       $self->{StringContent} = join '\n', @{$conf{-String}};
     }
     else {
-      croak "Parameter -String must be a SCALAR!\n";
+      croak "Config::General: Parameter -String must be a SCALAR!\n";
     }
   }
 
@@ -336,7 +336,7 @@ sub _prepare {
     my $key = $entry;
     $key =~ s/^\-//;
     if (! exists $self->{$key}) {
-      croak "Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n";
+      croak "Config::General: Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n";
     }
     if ($conf{$entry} =~ /$self->{AutoTrueFlags}->{true}/io) {
       $self->{$key} = 1;
@@ -436,7 +436,7 @@ sub _open {
     }
     if (!$found) {
       my $path_message = defined $this->{ConfigPath} ? q( within ConfigPath: ) . join(q(.), @{$this->{ConfigPath}}) : q();
-      croak qq{The file "$basefile" does not exist$path_message!};
+      croak qq{Config::GeneralThe file "$basefile" does not exist$path_message!};
     }
   }
 
@@ -449,7 +449,7 @@ sub _open {
   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";
+    opendir INCLUDEDIR, $configfile or croak "Config::General: Could not open directory $configfile!($!)\n";
     my @files = sort grep { -f catfile($configfile, $_) } catfile($configfile, $_), readdir INCLUDEDIR;
     closedir INCLUDEDIR;
     local $this->{CurrentConfigFilePath} = $configfile;
@@ -457,7 +457,7 @@ sub _open {
       my $file = catfile($configfile, $_);
       if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) {
         # support re-read if used urged us to do so, otherwise ignore the file
-	$fh = IO::File->new( $file, 'r') or croak "Could not open $file!($!)\n";
+	$fh = IO::File->new( $file, 'r') or croak "Config::General: Could not open $file!($!)\n";
 	$this->{files}->{"$file"} = 1;
 	$this->_read($fh);
       }
@@ -473,7 +473,7 @@ sub _open {
       return;
     }
     else {
-      $fh = IO::File->new( "$configfile", 'r') or croak "Could not open $configfile!($!)\n";
+      $fh = IO::File->new( "$configfile", 'r') or croak "Config::General: Could not open $configfile!($!)\n";
 
       $this->{files}->{$configfile}    = 1;
 
@@ -745,16 +745,11 @@ sub _parse {
 	  }
 	}
 	if ($this->{InterPolateVars}) {
-          # Clear everything from the next level
-          # rt:27225
-          if (defined $this->{stack} and defined $this->{stack}->{$this->{level} + 1}) {
-            $this->{stack}->{$this->{level} + 1} = {};
-          }
 	  # interpolate block(name), add "<" and ">" to the key, because
 	  # it is sure that such keys does not exist otherwise.
-	  $block     = $this->_interpolate("<$block>", $block);
+	  $block     = $this->_interpolate($config, "<$block>", $block);
 	  if (defined $blockname) {
-	    $blockname = $this->_interpolate("<$blockname>", "$blockname");
+	    $blockname = $this->_interpolate($config, "<$blockname>", "$blockname");
 	  }
 	}
 	if ($this->{LowerCaseNames}) {
@@ -764,21 +759,22 @@ sub _parse {
 	undef @newcontent;
 	next;
       }
-      elsif (/^<\/(.+?)>$/) {                              # it is an end block, but we don't have a matching block!
+      elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block!
-	croak "EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
+	croak "Config::General: EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
       }
       else {                                               # insert key/value pair into actual node
 	if ($this->{LowerCaseNames}) {
 	  $option = lc $option;
 	}
+
 	if (exists $config->{$option}) {
 	  if ($this->{MergeDuplicateOptions}) {
-	    $config->{$option} = $this->_parse_value($option, $value);
+	    $config->{$option} = $this->_parse_value($config, $option, $value);
 	  }
 	  else {
 	    if (! $this->{AllowMultiOptions} ) {
 	      # no, duplicates not allowed
-	      croak "Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
+	      croak "Config::General: Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
 	    }
 	    else {
 	      # yes, duplicates allowed
@@ -792,18 +788,23 @@ sub _parse {
 		my $i = scalar @{$config->{$option}};
 	      };
 	      if ($EVAL_ERROR) {
-		$config->{$option} = $this->_parse_value($option, $value);
+		$config->{$option} = $this->_parse_value($config, $option, $value);
 	      }
 	      else {
 		# it's already an array, just push
-		push @{$config->{$option}}, $this->_parse_value($option, $value);
+		push @{$config->{$option}}, $this->_parse_value($config, $option, $value);
 	      }
 	    }
 	  }
 	}
 	else {
 	  # standard config option, insert key/value pair into node
-	  $config->{$option} = $this->_parse_value($option, $value);
+	  $config->{$option} = $this->_parse_value($config, $option, $value);
+
+	  if ($this->{InterPolateVars}) {
+	    # save pair on local stack
+	    $config->{__stack}->{$option} = $config->{$option};
+	  }
 	}
       }
     }
@@ -817,14 +818,29 @@ sub _parse {
 	push @newcontent, $_;       # push onto new content stack
       }
       else {                        # calling myself recursively, end of $block reached, $block_level is 0
-	if (defined $blockname) {           # a named block, make it a hashref inside a hash within the current node
+	if (defined $blockname) {
-	  $this->_savelast($blockname);
+	  # a named block, make it a hashref inside a hash within the current node
 
 	  if (! exists $config->{$block}) {
-	    $config->{$block} = $this->_hashref(); # Make sure that the hash is not created implicitely
+	    # Make sure that the hash is not created implicitly
+	    $config->{$block} = $this->_hashref();
+
+	    if ($this->{InterPolateVars}) {
+	      # inherit current __stack to new block
+	      $config->{$block}->{__stack} = $config->{__stack};
+	    }
 	  }
 
-	  if (exists $config->{$block}->{$blockname}) {    # the named block already exists, make it an array
+	  if (ref($config->{$block}) eq '') {
+	    croak "Config::General: Block <$block> already exists as scalar entry!\n";
+	  }
+	  elsif (ref($config->{$block}) eq 'ARRAY') {
+	    croak "Config::General: Cannot append named block <$block $blockname> to array of scalars!\n"
+	         ."Block <$block> or scalar '$block' occurs more than once.\n"
+	         ."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n";
+	  }
+	  elsif (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
               # this one.
@@ -832,7 +848,7 @@ sub _parse {
 	    }
 	    else {
 	      if (! $this->{AllowMultiOptions}) {
-		croak "Named block \"<$block $blockname>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
+		croak "Config::General: Named block \"<$block $blockname>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
 	      }
 	      else {                                       # preserve existing data
 		my $savevalue = $config->{$block}->{$blockname};
@@ -849,19 +865,27 @@ sub _parse {
 	      }
 	    }
 	  }
-	  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($this->_hashref(), \@newcontent);
+	    my $tmphash = $this->_hashref();
+
+	    if ($this->{InterPolateVars}) {
+	      # inherit current __stack to new block
+	      $tmphash->{__stack} = $config->{__stack};
+	    }
+
+	    $config->{$block}->{$blockname} = $this->_parse($tmphash, \@newcontent);
 	  }
-	  $this->_backlast($blockname);
 	}
-	else {                                             # standard block
+	else {
-	  $this->_savelast($block);
+	  # standard block
-	  if (exists $config->{$block}) {                  # the block already exists, make it an array
+	  if (exists $config->{$block}) {
+	    if (ref($config->{$block}) eq '') {
+	      croak "Config::General: Cannot create hashref from <$block> because there is\n"
+		   ."already a scalar option '$block' with value '$config->{$block}'\n";
+	    }
+
+	    # 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
               # this one.
@@ -869,7 +893,7 @@ sub _parse {
             }
             else {
 	      if (! $this->{AllowMultiOptions}) {
-	        croak "Block \"<$block>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
+	        croak "Config::General: Block \"<$block>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
 	      }
 	      else {
 		my $savevalue = $config->{$block};
@@ -888,10 +912,15 @@ sub _parse {
 	  }
 	  else {
 	    # the first occurence of this particular block
-	    #### $config->{$block} = $this->_parse($config->{$block}, \@newcontent);
+	    my $tmphash = $this->_hashref();
-	    $config->{$block} = $this->_parse($this->_hashref(), \@newcontent);
+
+	    if ($this->{InterPolateVars}) {
+	      # inherit current __stack to new block
+	      $tmphash->{__stack} = $config->{__stack};
+	    }
+
+	    $config->{$block} = $this->_parse($tmphash, \@newcontent);
 	  }
-	  $this->_backlast($block);
 	}
 	undef $blockname;
 	undef $block;
@@ -906,34 +935,19 @@ sub _parse {
   if ($block) {
     # $block is still defined, which means, that it had
     # no matching endblock!
-    croak "Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n";
+    croak "Config::General: Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n";
   }
   return $config;
 }
 
 
-sub _savelast {
-  my($this, $key) = @_;
-  push @{$this->{upperkeys}}, $this->{lastkey};
-  $this->{lastkey}  = $this->{prevkey};
-  $this->{prevkey}  = $key;
-  return;
-}
-
-sub _backlast {
-  my($this, $key) = @_;
-  $this->{prevkey} = $this->{lastkey};
-  $this->{lastkey} = pop @{$this->{upperkeys}};
-  return;
-}
-
 sub _parse_value {
   #
   # parse the value if value parsing is turned on
   # by either -AutoTrue and/or -FlagBits
   # otherwise just return the given value unchanged
   #
-  my($this, $option, $value) =@_;
+  my($this, $config, $option, $value) =@_;
 
   # avoid "Use of uninitialized value"
   if (! defined $value) {
@@ -941,7 +955,7 @@ sub _parse_value {
   }
 
   if ($this->{InterPolateVars}) {
-    $value = $this->_interpolate($option, $value);
+    $value = $this->_interpolate($config, $option, $value);
   }
 
   # make true/false values to 1 or 0 (-AutoTrue)
@@ -983,7 +997,7 @@ sub NoMultiOptions {
   # Since we do parsing from within new(), we must
   # call it again if one turns NoMultiOptions on!
   #
-  croak q(The NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
+  croak q(Config::GeneralThe NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
 }
 
 
@@ -1003,7 +1017,7 @@ sub save {
     $this->save_file($one, \%h);
   }
   else {
-    croak q(The save() method is deprecated. Use the new save_file() method instead!);
+    croak q(Config::GeneralThe save() method is deprecated. Use the new save_file() method instead!);
   }
   return;
 }
@@ -1018,17 +1032,17 @@ sub save_file {
   my $config_string;
 
   if (!$file) {
-    croak "Filename is required!";
+    croak "Config::General: Filename is required!";
   }
   else {
-    $fh = IO::File->new( "$file", 'w') or croak "Could not open $file!($!)\n";
+    $fh = IO::File->new( "$file", 'w') or croak "Config::General: Could not open $file!($!)\n";
 
     if (!$config) {
       if (exists $this->{config}) {
 	$config_string = $this->_store(0, %{$this->{config}});
       }
       else {
-	croak "No config hash supplied which could be saved to disk!\n";
+	croak "Config::General: No config hash supplied which could be saved to disk!\n";
       }
     }
     else {
@@ -1061,7 +1075,7 @@ sub save_string {
       return $this->_store(0, %{$this->{config}});
     }
     else {
-      croak "No config hash supplied which could be saved to disk!\n";
+      croak "Config::General: No config hash supplied which could be saved to disk!\n";
     }
   }
   else {
@@ -1180,7 +1194,7 @@ sub _hashref {
       eval qq{require $this->{Tie}};
     };
     if ($EVAL_ERROR) {
-      croak q(Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR;
+      croak q(Config::GeneralCould not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR;
     }
     my %hash;
     tie %hash, $this->{Tie};
@@ -1210,11 +1224,11 @@ sub SaveConfig {
   my ($file, $hash) = @_;
 
   if (!$file || !$hash) {
-    croak q{SaveConfig(): filename and hash argument required.};
+    croak q{Config::GeneralSaveConfig(): filename and hash argument required.};
   }
   else {
     if (ref($hash) ne 'HASH') {
-      croak q(The second parameter must be a reference to a hash!);
+      croak q(Config::GeneralThe second parameter must be a reference to a hash!);
     }
     else {
       (new Config::General(-ConfigHash => $hash))->save_file($file);
@@ -1231,11 +1245,11 @@ sub SaveConfigString {
   my ($hash) = @_;
 
   if (!$hash) {
-    croak q{SaveConfigString(): Hash argument required.};
+    croak q{Config::GeneralSaveConfigString(): Hash argument required.};
   }
   else {
     if (ref($hash) ne 'HASH') {
-      croak q(The parameter must be a reference to a hash!);
+      croak q(Config::GeneralThe parameter must be a reference to a hash!);
     }
     else {
       return (new Config::General(-ConfigHash => $hash))->save_string();
@@ -2376,7 +2390,7 @@ Thomas Linden <tlinden |AT| cpan.org>
 
 =head1 VERSION
 
-2.33
+2.37
 
 =cut
 

General/Interpolated.pm

@@ -8,7 +8,7 @@
 #
 
 package Config::General::Interpolated;
-$Config::General::Interpolated::VERSION = "2.08";
+$Config::General::Interpolated::VERSION = "2.09";
 
 use strict;
 use Carp;
@@ -64,34 +64,15 @@ sub _interpolate  {
   #
   # called directly by Config::General::_parse_value()
   #
-  my ($this, $key, $value) = @_;
+  my ($this, $config, $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} }}) {
-      if (! exists $this->{stack}->{ $this->{level} }->{ $this->{prevkey} }->{$key}) {
-	# only import a variable if it is not re-defined in current scope! (rt.cpan.org bug #20742
-	$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;
     my $var_lc = $this->{LowerCaseNames} ? lc($var) : $var;
-    if (exists $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var_lc}) {
+
-      $con . $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var_lc};
+    if (exists $config->{__stack}->{$var_lc}) {
+      $con . $config->{__stack}->{$var_lc};
     }
     elsif ($this->{InterPolateEnv}) {
       # may lead to vulnerabilities, by default flag turned off
@@ -113,8 +94,6 @@ sub _interpolate  {
     }
   }egx;
 
-  $this->{stack}->{ $this->{level} }->{ $prevkey }->{$key} = $value;
-
   return $value;
 };
 
@@ -128,20 +107,8 @@ sub _interpolate_hash {
   #
   my ($this, $config) = @_;
 
-  $this->{level}     = 1;
-  $this->{upperkey}  = "";
-  $this->{upperkeys} = [];
-  $this->{lastkey}   = "";
-  $this->{prevkey}   = " ";
-
   $config = $this->_var_hash_stacker($config);
 
-  $this->{level}    = 1;
-  $this->{upperkey} = "";
-  $this->{upperkeys} = [];
-  $this->{lastkey}  = "";
-  $this->{prevkey}  = " ";
-
   return $config;
 }
 
@@ -152,23 +119,18 @@ sub _var_hash_stacker {
   my ($this, $config) = @_;
 
   foreach my $key (keys %{$config}) {
+    next if($key eq "__stack");
     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}++;
+      my $tmphash = $config->{$key};
-      $this->_savelast($key);
+      $tmphash->{__stack} = $config->{__stack};
-      $config->{$key} = $this->_var_hash_stacker($config->{$key});
+      $config->{$key} = $this->_var_hash_stacker($tmphash);
-      $this->_backlast($key);
-      $this->{level}--;
     }
     else {
       # SCALAR
-      $config->{$key} = $this->_interpolate($key, $config->{$key});
+      $config->{__stack}->{$key} = $config->{$key};
     }
   }
 
@@ -195,7 +157,7 @@ sub _var_array_stacker {
       next;
     }
     else {
-      $entry = $this->_interpolate($key, $entry);
+      $config->{__stack}->{$key} = $config->{$key};
     }
     push @new, $entry;
   }
@@ -203,6 +165,50 @@ sub _var_array_stacker {
   return  \@new;
 }
 
+sub _clean_stack {
+  #
+  # recursively empty the variable stack
+  #
+  my ($this, $config) = @_;
+  foreach my $key (keys %{$config}) {
+    if ($key eq "__stack") {
+      delete $config->{__stack};
+      next;
+    }
+    if (ref($config->{$key}) eq "ARRAY" ) {
+      $config->{$key} = $this->_clean_array_stack($config->{$key});
+    }
+    elsif (ref($config->{$key}) eq "HASH") {
+      $config->{$key} = $this->_clean_stack($config->{$key});
+    }
+  }
+  return $config;
+}
+
+
+sub _clean_array_stack {
+  #
+  # same as _var_hash_stacker but for arrayrefs
+  #
+  my ($this, $config) = @_;
+
+  my @new;
+
+  foreach my $entry (@{$config}) {
+    if (ref($entry) eq "HASH") {
+      $entry = $this->_clean_stack($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;
+    }
+    push @new, $entry;
+  }
+
+  return  \@new;
+}
 
 1;
 
@@ -312,7 +318,7 @@ See L<http://www.perl.com/perl/misc/Artistic.html>
 
 =head1 VERSION
 
-2.08
+2.09
 
 =cut
 

MANIFEST

@@ -1,5 +1,3 @@
-General/Extended.pm
-General/Interpolated.pm
 t/sub1/sub2/sub3/cfg.sub3
 t/sub1/sub2/cfg.sub2
 t/sub1/sub2/cfg.sub2b
@@ -8,28 +6,35 @@ t/sub1/cfg.sub1b
 t/sub1/cfg.sub1c
 t/sub1/cfg.sub1d
 t/sub1/cfg.sub1e
+t/apache-include.conf
 t/cfg.16
 t/cfg.17
 t/cfg.19
 t/cfg.2
+t/cfg.20.a
+t/cfg.20.b
+t/cfg.20.c
 t/cfg.3
+t/cfg.34
 t/cfg.4
 t/cfg.5
 t/cfg.6
 t/cfg.7
 t/cfg.8
-t/test.rc
-t/cfg.20.a
-t/cfg.20.b
-t/cfg.20.c
-t/run.t
-t/cfg.34
-t/included.conf
 t/dual-include.conf
-t/apache-include.conf
+t/included.conf
-MANIFEST
+t/run.t
-example.cfg
+t/test.rc
-Makefile.PL
+t/cfg.39
+t/cfg.41
+t/cfg.40
+t/cfg.42
+t/cfg.43
+General/Extended.pm
+General/Interpolated.pm
 General.pm
+MANIFEST
 README
+example.cfg
 Changelog
+Makefile.PL

t/cfg.17

@@ -1 +1,4 @@
 home = /home/users
+<foo>
+quux = $bar
+</foo>

t/cfg.39

@@ -0,0 +1,13 @@
+<outer b1>
+  test = foo
+  <inner>
+    ivar = $test
+  </inner>
+</outer>
+
+<outer b2>
+  test = bar
+  <inner>
+    ivar = $test
+  </inner>
+</outer>

t/cfg.40

@@ -0,0 +1,7 @@
+# should generate an error about invalid structure
+# array of scalars => hashref
+val = 1
+val = 2
+<val 3>
+ x = no
+</val>

t/cfg.41

@@ -0,0 +1,6 @@
+# should generate an error about invalid structure
+# scalar => hashref
+val = 1
+<val 2>
+ x = no
+</val>

t/cfg.42

@@ -0,0 +1,13 @@
+# should generate an error about invalid structure
+# array of hashrefs => scalar
+
+<val 1>
+ x = no
+</val>
+
+val = 3
+
+<val 2>
+ x = no
+</val>
+

t/cfg.43

@@ -0,0 +1,5 @@
+# should generate an error about invalid structure
+val = 1
+<val>
+ x = 2
+</val>

t/run.t

@@ -8,7 +8,7 @@
 
 
 use Data::Dumper;
-use Test::More tests => 38;
+use Test::More tests => 43;
 #use Test::More qw(no_plan);
 
 ### 1
@@ -117,16 +117,25 @@ else {
 }
 
 
+
 ### 17
 # testing value pre-setting using a hash
 my $conf17 = new Config::General(
  -file => "t/cfg.17",
- -DefaultConfig => { home => "/exports/home", logs => "/var/backlog" },
+ -DefaultConfig => { home => "/exports/home",
+		     logs => "/var/backlog",
+                     foo  => {
+			       bar => "quux"
+			     }
+		   },
+ -InterPolateVars => 1,
  -MergeDuplicateOptions => 1,
  -MergeDuplicateBlocks => 1
 );
 my %h17 = $conf17->getall();
-ok ($h17{home} eq "/home/users", "Testing value pre-setting using a hash");
+ok ($h17{home} eq "/home/users" &&
+    $h17{foo}{quux} eq "quux",
+    "Testing value pre-setting using a hash");
 
 
 ### 18
@@ -404,7 +413,7 @@ my %C36 = $conf36->getall;
 is_deeply( \%C36, { bit => { one => { honk=>'bonk' }, 
                            two => { honk=>'bonk' } 
                 }        }, "Included twice" );
-                        
+
 
 ### Include once
 diag "\nPlease ignore the following message about IncludeAgain";
@@ -423,3 +432,21 @@ my %C38 = $conf38->getall;
 is_deeply( \%C38, { bit => { one => { honk=>'bonk' }, 
                            two => { honk=>'bonk' } 
                 }        }, "Apache-style include" );
+
+#### 39 verifies bug rt#27225
+# testing variable scope.
+# a variable shall resolve to the value defined in the current
+# scope, not a previous outer scope.
+my $conf39 = new Config::General(-ConfigFile => "t/cfg.39", -InterPolateVars => 1, -StrictVars => 0);
+my %conf39 = $conf39->getall();
+isnt($conf39{outer}->{b1}->{inner}->{ivar},
+     $conf39{outer}->{b2}->{inner}->{ivar},
+     "Variable scope test");
+
+### 40 - 42 verify if structural error checks are working
+foreach my $pos (40 .. 43) {
+  eval {
+    my $conf = new Config::General(-ConfigFile => "t/cfg.$pos");
+  };
+  ok($@ =~ /^Config::General/, "$pos: Structural error checks");
+}