From 5f92f52e0a53dee2e5b5aa4910212f8c772921a2 Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Sat, 10 Oct 2009 16:43:54 +0000 Subject: [PATCH] 2.39 - fixed rt.cpan.org#35122. This one was one of the most intriguing bugs I've ever observed in my own code. The internal temporary __stack hashref were copied from one subhash to another to enable inheritance of variables. However, the hashes were copied by reference, so once a value changed later, that value were overwritten because the __stack in question were just a reference. I introduced a simple function _copy() which copies the contents of the __stack by value, which solved the bug. Conclusion: beware of perl hash refs! - fixed rt.cpan.org#36607, accept whitespaces in heredoc names if split delimiter is gues (equalsign or whitespace) - fixed rt.cpan.org#34080 (typo) - fixed rt.cpan.org#35766. Variables inside single quoted strings will no more interpolated (as the docu states). Also added test case for this. - fixed bug rt.cpan.org#33766. Checking for defined not true in ::Extended::AUTOLOAD(). - added -UTF8 flag, which opens files in utf8 mode (suggested by KAORU, rt.cpan.org#35583) I decided not to add a test case for this, since perls utf8 support is not stable with all versions. git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@65 be1acefe-a474-0410-9a34-9b3221f2030f --- Changelog | 30 +++++++++++++++ General.pm | 83 +++++++++++++++++++++++++++++++++-------- General/Extended.pm | 10 ++--- General/Interpolated.pm | 18 +++++++++ README | 2 +- t/cfg.45 | 14 +++++++ t/cfg.46 | 3 ++ t/run.t | 32 +++++++++++++++- 8 files changed, 170 insertions(+), 22 deletions(-) create mode 100644 t/cfg.45 create mode 100644 t/cfg.46 diff --git a/Changelog b/Changelog index e7e7b32..b7c87ff 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,33 @@ + 2.39 + - fixed rt.cpan.org#35122. This one was one of the most + intriguing bugs I've ever observed in my own code. The + internal temporary __stack hashref were copied from one + subhash to another to enable inheritance of variables. + However, the hashes were copied by reference, so once a + value changed later, that value were overwritten because + the __stack in question were just a reference. I introduced + a simple function _copy() which copies the contents of + the __stack by value, which solved the bug. + Conclusion: beware of perl hash refs! + + - fixed rt.cpan.org#36607, accept whitespaces in heredoc + names if split delimiter is gues (equalsign or whitespace) + + - fixed rt.cpan.org#34080 (typo) + + - fixed rt.cpan.org#35766. Variables inside single quoted + strings will no more interpolated (as the docu states). + Also added test case for this. + + - fixed bug rt.cpan.org#33766. Checking for defined not true + in ::Extended::AUTOLOAD(). + + - added -UTF8 flag, which opens files in utf8 mode + (suggested by KAORU, rt.cpan.org#35583) + I decided not to add a test case for this, since perls + utf8 support is not stable with all versions. + + 2.38 - fixed rt.cpan.org#31529 variable inheritance failed with multiple named blocks. diff --git a/General.pm b/General.pm index 13fac98..09d1644 100644 --- a/General.pm +++ b/General.pm @@ -32,7 +32,7 @@ use Carp::Heavy; use Carp; use Exporter; -$Config::General::VERSION = 2.38; +$Config::General::VERSION = 2.39; use vars qw(@ISA @EXPORT_OK); use base qw(Exporter); @@ -80,6 +80,7 @@ sub new { Tie => q(), # could be set to a perl module for tie'ing new hashes parsed => 0, # internal state stuff for variable interpolation files => {}, # which files we have read, if any + UTF8 => 0 }; # create the class instance @@ -367,7 +368,7 @@ sub _prepare { $self->{IncludeRelative} = 1; $self->{IncludeDirectories} = 1; $self->{IncludeGlob} = 1; - $self->{SpashIsDirectory} = 1; + $self->{SlashIsDirectory} = 1; $self->{SplitPolicy} = 'whitespace'; $self->{CComments} = 0; $self->{BackslashEscape} = 1; @@ -460,7 +461,14 @@ 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 "Config::General: Could not open $file!($!)\n"; + if ($this->{UTF8}) { + $fh = new IO::File; + open( $fh, "<:utf8", $file) + or croak "Config::General: Could not open $file in UTF8 mode!($!)\n"; + } + else { + $fh = IO::File->new( $file, 'r') or croak "Config::General: Could not open $file!($!)\n"; + } $this->{files}->{"$file"} = 1; $this->_read($fh); } @@ -476,7 +484,15 @@ sub _open { return; } else { - $fh = IO::File->new( "$configfile", 'r') or croak "Config::General: Could not open $configfile!($!)\n"; + if ($this->{UTF8}) { + $fh = new IO::File; + open( $fh, "<:utf8", $configfile) + or croak "Config::General: Could not open $configfile in UTF8 mode!($!)\n"; + } + else { + $fh = IO::File->new( "$configfile", 'r') + or croak "Config::General: Could not open $configfile!($!)\n"; + } $this->{files}->{$configfile} = 1; @@ -630,9 +646,16 @@ sub _read { # look for here-doc identifier if ($this->{SplitPolicy} eq 'guess') { - if (/^\s*(\S+?)(\s*=\s*|\s+)<<\s*(.+?)\s*$/) { + if (/^\s*([^=]+?)\s*=\s*<<\s*(.+?)\s*$/) { + # try equal sign (fix bug rt#36607) $hier = $1; # the actual here-doc variable name - $hierend = $3; # the here-doc identifier, i.e. "EOF" + $hierend = $2; # the here-doc identifier, i.e. "EOF" + next; + } + elsif (/^\s*(\S+?)\s+<<\s*(.+?)\s*$/) { + # try whitespace + $hier = $1; # the actual here-doc variable name + $hierend = $2; # the here-doc identifier, i.e. "EOF" next; } } @@ -837,7 +860,7 @@ sub _parse { if ($this->{InterPolateVars}) { # inherit current __stack to new block - $config->{$block}->{__stack} = $config->{__stack}; + $config->{$block}->{__stack} = $this->_copy($config->{__stack}); } } @@ -881,7 +904,8 @@ sub _parse { if ($this->{InterPolateVars}) { # inherit current __stack to new block - $tmphash->{__stack} = $config->{__stack}; + $tmphash->{__stack} = $this->_copy($config->{__stack}); + #$tmphash->{__stack} = $config->{$block}->{__stack}; } $config->{$block}->{$blockname} = $this->_parse($tmphash, \@newcontent); @@ -920,7 +944,7 @@ sub _parse { my $tmphash = $this->_hashref(); if ($this->{InterPolateVars}) { # inherit current __stack to new block - $tmphash->{__stack} = $config->{__stack}; + $tmphash->{__stack} = $this->_copy($config->{__stack}); } push @ar, $this->_parse( $tmphash, \@newcontent); @@ -935,7 +959,7 @@ sub _parse { if ($this->{InterPolateVars}) { # inherit current __stack to new block - $tmphash->{__stack} = $config->{__stack}; + $tmphash->{__stack} = $this->_copy($config->{__stack}); } $config->{$block} = $this->_parse($tmphash, \@newcontent); @@ -947,7 +971,7 @@ sub _parse { next; } } - else { # inside $block, just push onto new content stack + else { # inside $block, just push onto new content stack push @newcontent, $_; } } @@ -960,6 +984,20 @@ sub _parse { } +sub _copy { + # + # copy the contents of one hash into another + # to circumvent invalid references + # fixes rt.cpan.org bug #35122 + my($this, $source) = @_; + my %hash = (); + foreach my $key (keys %{$source}) { + $hash{$key} = $source->{$key}; + } + return \%hash; +} + + sub _parse_value { # # parse the value if value parsing is turned on @@ -1054,8 +1092,15 @@ sub save_file { croak "Config::General: Filename is required!"; } else { - $fh = IO::File->new( "$file", 'w') or croak "Config::General: Could not open $file!($!)\n"; - + if ($this->{UTF8}) { + $fh = new IO::File; + open($fh, ">:utf8", $file) + or croak "Config::General: Could not open $file in UTF8 mode!($!)\n"; + } + else { + $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}}); @@ -1709,6 +1754,9 @@ character within configurations. By default it is turned off. +Be carefull with this option, as it removes all backslashes after parsing. + +B. =item B<-SlashIsDirectory> @@ -1768,7 +1816,7 @@ The following options will be set: IncludeRelative = 1 IncludeDirectories = 1 IncludeGlob = 1 - SpashIsDirectory = 1 + SlashIsDirectory = 1 SplitPolicy = 'equalsign' CComments = 0 BackslashEscape = 1 @@ -1779,6 +1827,11 @@ those options are doing. Beside setting some options it also turns off support for explicit empty blocks. +=item B<-UTF8> + +If turned on, all files will be opened in utf8 mode. This may +not work properly with older versions of perl. + =back @@ -2409,7 +2462,7 @@ Thomas Linden =head1 VERSION -2.38 +2.39 =cut diff --git a/General/Extended.pm b/General/Extended.pm index 938a9f3..7a96224 100644 --- a/General/Extended.pm +++ b/General/Extended.pm @@ -1,7 +1,7 @@ # # Config::General::Extended - special Class based on Config::General # -# Copyright (c) 2000-2007 Thomas Linden . +# Copyright (c) 2000-2008 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artificial License, same as perl itself. Have fun. # @@ -23,7 +23,7 @@ use vars qw(@ISA @EXPORT); use strict; -$Config::General::Extended::VERSION = "2.02"; +$Config::General::Extended::VERSION = "2.03"; sub new { @@ -294,7 +294,7 @@ sub AUTOLOAD { my $key = $Config::General::Extended::AUTOLOAD; # get to know how we were called $key =~ s/.*:://; # remove package name! - if ($value) { + if (defined $value) { # just set $key to $value! $this->{config}->{$key} = $value; } @@ -576,7 +576,7 @@ values under the given key will be overwritten. =head1 COPYRIGHT -Copyright (c) 2000-2007 Thomas Linden +Copyright (c) 2000-2008 Thomas Linden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -593,7 +593,7 @@ Thomas Linden =head1 VERSION -2.02 +2.03 =cut diff --git a/General/Interpolated.pm b/General/Interpolated.pm index 36fdf48..a8597d8 100644 --- a/General/Interpolated.pm +++ b/General/Interpolated.pm @@ -66,6 +66,17 @@ sub _interpolate { # my ($this, $config, $key, $value) = @_; + # some dirty trick to circumvent single quoted vars to be interpolated + # we remove all quotes and replace them with unique random literals, + # which will be replaced after interpolation with the original quotes + # fixes bug rt#35766 + my %quotes; + $value =~ s/(\'[^\']+?\')/ + my $key = "QUOTE" . int(rand(1000)) . "QUOTE"; + $quotes{ $key } = $1; + $key; + /gex; + $value =~ s{$this->{regex}}{ my $con = $1; my $var = $3; @@ -94,6 +105,12 @@ sub _interpolate { } }egx; + # re-insert unaltered quotes + # fixes bug rt#35766 + foreach my $quote (keys %quotes) { + $value =~ s/$quote/$quotes{$quote}/; + } + return $value; }; @@ -170,6 +187,7 @@ sub _clean_stack { # recursively empty the variable stack # my ($this, $config) = @_; + #return $config; # DEBUG foreach my $key (keys %{$config}) { if ($key eq "__stack") { delete $config->{__stack}; diff --git a/README b/README index a0f6c8d..fac15c4 100644 --- a/README +++ b/README @@ -104,4 +104,4 @@ AUTHOR VERSION - 2.38 + 2.39 diff --git a/t/cfg.45 b/t/cfg.45 new file mode 100644 index 0000000..5794ffc --- /dev/null +++ b/t/cfg.45 @@ -0,0 +1,14 @@ +param1 = value1 +param2 = value2 + + + param2 = value3 + param4 = $param1 # expect: "value1" + param5 = $param2 # expect: "value3" + + + + param6 = $param1 # expect: "value1" + param7 = $param2 # expect: "value2" + + diff --git a/t/cfg.46 b/t/cfg.46 new file mode 100644 index 0000000..e93750f --- /dev/null +++ b/t/cfg.46 @@ -0,0 +1,3 @@ +foo = bar +blah = blubber +test = $foo 'variable $blah should be kept' and '$foo too' diff --git a/t/run.t b/t/run.t index 965bf69..77bba37 100644 --- a/t/run.t +++ b/t/run.t @@ -8,7 +8,7 @@ use Data::Dumper; -use Test::More tests => 45; +use Test::More tests => 47; #use Test::More qw(no_plan); ### 1 @@ -457,3 +457,33 @@ eval { }; ok(! $@, "-String arrayref"); is_deeply({ $conf44->getall }, { foo => 'bar' }, "-String arrayref contents"); + + + +# verifies bug rt#35122 +my $conf45 = new Config::General(-ConfigFile => "t/cfg.45", -InterPolateVars => 1, -StrictVars => 0); +my %conf45 = $conf45->getall(); +my $expect45 = { + 'block1' => { + 'param5' => 'value3', + 'param4' => 'value1', + 'param2' => 'value3' + }, + 'block2' => { + 'param7' => 'value2', + 'param6' => 'value1' + }, + 'param2' => 'value2', + 'param1' => 'value1' + }; +is_deeply($expect45, \%conf45, "Variable precedence"); + +# verifies bug rt#35766 +my $conf46 = new Config::General(-ConfigFile => "t/cfg.46", -InterPolateVars => 1, -StrictVars => 0); +my %conf46 = $conf46->getall(); +my $expect46 = { + 'blah' => 'blubber', + 'test' => 'bar \'variable $blah should be kept\' and \'$foo too\'', + 'foo' => 'bar' + }; +is_deeply($expect46, \%conf46, "Variables inside single quotes");