From f85e18462c8c92c9b1185018e284168c63e97315 Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Sat, 10 Oct 2009 16:42:58 +0000 Subject: [PATCH] 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 | 22 ++++++ General.pm | 170 ++++++++++++++++++++++------------------ General/Interpolated.pm | 106 +++++++++++++------------ MANIFEST | 31 +++++--- t/cfg.17 | 3 + t/cfg.39 | 13 +++ t/cfg.40 | 7 ++ t/cfg.41 | 6 ++ t/cfg.42 | 13 +++ t/cfg.43 | 5 ++ t/run.t | 35 ++++++++- 11 files changed, 266 insertions(+), 145 deletions(-) create mode 100644 t/cfg.39 create mode 100644 t/cfg.40 create mode 100644 t/cfg.41 create mode 100644 t/cfg.42 create mode 100644 t/cfg.43 diff --git a/Changelog b/Changelog index 16d32d8..ea0beb9 100644 --- a/Changelog +++ b/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 diff --git a/General.pm b/General.pm index 48f89bf..a069139 100644 --- a/General.pm +++ b/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! - croak "EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n"; + elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block! + 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 - $this->_savelast($blockname); + if (defined $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 - $this->_savelast($block); - if (exists $config->{$block}) { # the block already exists, make it an array + else { + # standard block + 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); - $config->{$block} = $this->_parse($this->_hashref(), \@newcontent); + my $tmphash = $this->_hashref(); + + 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 =head1 VERSION -2.33 +2.37 =cut diff --git a/General/Interpolated.pm b/General/Interpolated.pm index a0fd9c5..23e187f 100644 --- a/General/Interpolated.pm +++ b/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 $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}; - } + my ($this, $config, $key, $value) = @_; $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}++; - $this->_savelast($key); - $config->{$key} = $this->_var_hash_stacker($config->{$key}); - $this->_backlast($key); - $this->{level}--; + my $tmphash = $config->{$key}; + $tmphash->{__stack} = $config->{__stack}; + $config->{$key} = $this->_var_hash_stacker($tmphash); } 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 =head1 VERSION -2.08 +2.09 =cut diff --git a/MANIFEST b/MANIFEST index a549b33..f932734 100644 --- a/MANIFEST +++ b/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 -MANIFEST -example.cfg -Makefile.PL +t/included.conf +t/run.t +t/test.rc +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 diff --git a/t/cfg.17 b/t/cfg.17 index 785764e..59f3df0 100644 --- a/t/cfg.17 +++ b/t/cfg.17 @@ -1 +1,4 @@ home = /home/users + +quux = $bar + diff --git a/t/cfg.39 b/t/cfg.39 new file mode 100644 index 0000000..eff9f54 --- /dev/null +++ b/t/cfg.39 @@ -0,0 +1,13 @@ + + test = foo + + ivar = $test + + + + + test = bar + + ivar = $test + + diff --git a/t/cfg.40 b/t/cfg.40 new file mode 100644 index 0000000..6dabe61 --- /dev/null +++ b/t/cfg.40 @@ -0,0 +1,7 @@ +# should generate an error about invalid structure +# array of scalars => hashref +val = 1 +val = 2 + + x = no + \ No newline at end of file diff --git a/t/cfg.41 b/t/cfg.41 new file mode 100644 index 0000000..1c8eed6 --- /dev/null +++ b/t/cfg.41 @@ -0,0 +1,6 @@ +# should generate an error about invalid structure +# scalar => hashref +val = 1 + + x = no + diff --git a/t/cfg.42 b/t/cfg.42 new file mode 100644 index 0000000..9014667 --- /dev/null +++ b/t/cfg.42 @@ -0,0 +1,13 @@ +# should generate an error about invalid structure +# array of hashrefs => scalar + + + x = no + + +val = 3 + + + x = no + + diff --git a/t/cfg.43 b/t/cfg.43 new file mode 100644 index 0000000..a6c4941 --- /dev/null +++ b/t/cfg.43 @@ -0,0 +1,5 @@ +# should generate an error about invalid structure +val = 1 + + x = 2 + diff --git a/t/run.t b/t/run.t index 1e0eece..c682846 100644 --- a/t/run.t +++ b/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"); +}