diff --git a/Changelog b/Changelog index 4562f21..a16e3ee 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,19 @@ +2.45 + - fixed rt.cpan.org#50647 escaping bug. Now escaped $ or + backslash characters are handled correctly (across save too) + + - fixed rt.cpan.org#52047, tied hash will remain tied + when savong to a file. + + - fixed rt.cpan.org#54580, preserve single quotes during + variable interpolation corrected. No more using rand() + to mark single quotes but an incrementor instead. + + - fixed rt.cpan.org#42721+54583, empty config values will no + more handed over to interpreting methods (as interpolate + or autotrue and the like) but returned as undef untouched. + + 2.44 - fixed rt.cpan.org#49023 by rolling back change in 2.43 in line 158, regarding GLOB support. diff --git a/General.pm b/General.pm index b4db197..77f3fd1 100644 --- a/General.pm +++ b/General.pm @@ -5,7 +5,7 @@ # config values from a given file and # return it as hash structure # -# Copyright (c) 2000-2009 Thomas Linden . +# Copyright (c) 2000-20010Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artificial License, same as perl itself. Have fun. # @@ -32,7 +32,7 @@ use Carp::Heavy; use Carp; use Exporter; -$Config::General::VERSION = 2.44; +$Config::General::VERSION = 2.45; use vars qw(@ISA @EXPORT_OK); use base qw(Exporter); @@ -79,7 +79,7 @@ sub new { SplitDelimiter => 0, # must be set by the user if SplitPolicy is 'custom' StoreDelimiter => 0, # will be set by me unless user uses 'custom' policy CComments => 1, # by default turned on - BackslashEscape => 0, # by default turned off, allows escaping anything using the backslash + BackslashEscape => 0, # deprecated StrictObjects => 1, # be strict on non-existent keys in OOP mode StrictVars => 1, # be strict on undefined variables in Interpolate mode Tie => q(), # could be set to a perl module for tie'ing new hashes @@ -377,7 +377,6 @@ sub _prepare { $self->{SlashIsDirectory} = 1; $self->{SplitPolicy} = 'whitespace'; $self->{CComments} = 0; - $self->{BackslashEscape} = 1; } } @@ -620,8 +619,9 @@ sub _read { # look for multiline option, indicated by a trailing backslash - my $extra = $this->{BackslashEscape} ? '(?{BackslashEscape} ? '(?{BackslashEscape}) { - s/\\(.)/$1/g; - } - else { - # remove the \ char in front of masked "#", if any - s/\\#/#/g; - } + #if ($this->{BackslashEscape}) { + # s/\\(.)/$1/g; + #} + #else { + # # remove the \ char in front of masked "#", if any + # s/\\#/#/g; + #} # transform explicit-empty blocks to conforming blocks @@ -1041,7 +1041,9 @@ sub _parse_value { # avoid "Use of uninitialized value" if (! defined $value) { - $value = undef; # bigfix rt.cpan.org#42721 q(); + # patch fix rt#54583 + # Return an input undefined value without trying transformations + return $value; } if ($this->{InterPolateVars}) { @@ -1073,6 +1075,10 @@ sub _parse_value { $value = \%__flags; } } + + # are there any escaped characters left? put them out as is + $value =~ s/\\([\$\\\"])/$1/g; + return $value; } @@ -1087,7 +1093,7 @@ sub NoMultiOptions { # Since we do parsing from within new(), we must # call it again if one turns NoMultiOptions on! # - croak q(Config::Genera: lThe NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!); + croak q(Config::General: The NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!); } @@ -1193,48 +1199,22 @@ sub _store { my $config_string = q(); - if($this->{SaveSorted}) { - # ahm, well this might look strange because the two loops - # are obviously the same, but I don't know how to call - # a foreach() with sort and without sort() on the same - # line (I think it's impossible) - foreach my $entry (sort keys %{$config}) { - if (ref($config->{$entry}) eq 'ARRAY') { - foreach my $line (sort @{$config->{$entry}}) { - if (ref($line) eq 'HASH') { - $config_string .= $this->_write_hash($level, $entry, $line); - } - else { - $config_string .= $this->_write_scalar($level, $entry, $line); - } + foreach my $entry ( $this->{SaveSorted} ? sort keys %$config : keys %$config ) { + if (ref($config->{$entry}) eq 'ARRAY') { + foreach my $line (sort @{$config->{$entry}}) { + if (ref($line) eq 'HASH') { + $config_string .= $this->_write_hash($level, $entry, $line); + } + else { + $config_string .= $this->_write_scalar($level, $entry, $line); } - } - elsif (ref($config->{$entry}) eq 'HASH') { - $config_string .= $this->_write_hash($level, $entry, $config->{$entry}); - } - else { - $config_string .= $this->_write_scalar($level, $entry, $config->{$entry}); } } - } - else { - foreach my $entry (keys %{$config}) { - if (ref($config->{$entry}) eq 'ARRAY') { - foreach my $line (@{$config->{$entry}}) { - if (ref($line) eq 'HASH') { - $config_string .= $this->_write_hash($level, $entry, $line); - } - else { - $config_string .= $this->_write_scalar($level, $entry, $line); - } - } - } - elsif (ref($config->{$entry}) eq 'HASH') { - $config_string .= $this->_write_hash($level, $entry, $config->{$entry}); - } - else { - $config_string .= $this->_write_scalar($level, $entry, $config->{$entry}); - } + elsif (ref($config->{$entry}) eq 'HASH') { + $config_string .= $this->_write_hash($level, $entry, $config->{$entry}); + } + else { + $config_string .= $this->_write_scalar($level, $entry, $config->{$entry}); } } @@ -1253,14 +1233,18 @@ sub _write_scalar { my $config_string; - if ($line =~ /\n/ || $line =~ /\\$/) { + # patch fix rt#54583 + if ( ! defined $line ) { + $config_string .= $indent . $entry . "\n"; + } + elsif ($line =~ /\n/ || $line =~ /\\$/) { # it is a here doc my $delimiter; my $tmplimiter = 'EOF'; while (!$delimiter) { # create a unique here-doc identifier if ($line =~ /$tmplimiter/s) { - $tmplimiter .= q(%); + $tmplimiter .= '%'; } else { $delimiter = $tmplimiter; @@ -1275,7 +1259,10 @@ sub _write_scalar { } else { # a simple stupid scalar entry - $line =~ s/#/\\#/g; + + # re-escape contained $ or # or \ chars + $line =~ s/([#\$\\\"])/\\$1/g; + # bugfix rt.cpan.org#42287 if ($line =~ /^\s/ or $line =~ /\s$/) { # need to quote it @@ -1811,14 +1798,7 @@ By default B<-CComments> is turned on. =item B<-BackslashEscape> -If you turn on this parameter, a backslash can be used to escape any special -character within configurations. - -By default it is turned off. - -Be careful with this option, as it removes all backslashes after parsing. - -B. +B. =item B<-SlashIsDirectory> @@ -1881,7 +1861,6 @@ The following options will be set: SlashIsDirectory = 1 SplitPolicy = 'equalsign' CComments = 0 - BackslashEscape = 1 Take a look into the particular documentation sections what those options are doing. @@ -2502,7 +2481,7 @@ I recommend you to read the following documents, which are supplied with Perl: =head1 LICENSE AND COPYRIGHT -Copyright (c) 2000-2009 Thomas Linden +Copyright (c) 2000-2010 Thomas Linden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -2531,7 +2510,7 @@ Thomas Linden =head1 VERSION -2.44 +2.45 =cut diff --git a/General/Interpolated.pm b/General/Interpolated.pm index 67cd228..2c94b0c 100644 --- a/General/Interpolated.pm +++ b/General/Interpolated.pm @@ -2,13 +2,13 @@ # Config::General::Interpolated - special Class based on Config::General # # Copyright (c) 2001 by Wei-Hon Chen . -# Copyright (c) 2000-2009 by Thomas Linden . +# Copyright (c) 2000-2010 by Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artificial License, same as perl itself. Have fun. # package Config::General::Interpolated; -$Config::General::Interpolated::VERSION = "2.11"; +$Config::General::Interpolated::VERSION = "2.12"; use strict; use Carp; @@ -65,12 +65,7 @@ sub _interpolate { # called directly by Config::General::_parse_value() # my ($this, $config, $key, $value) = @_; - - if (! defined($value)) { - # bugfix rt.cpan.org#50329 - # nothing to do here - return $value; - } + my $quote_counter = 100; # some dirty trick to circumvent single quoted vars to be interpolated # we remove all quotes and replace them with unique random literals, @@ -78,7 +73,7 @@ sub _interpolate { # fixes bug rt#35766 my %quotes; $value =~ s/(\'[^\']+?\')/ - my $key = "QUOTE" . int(rand(1000)) . "QUOTE"; + my $key = "QUOTE" . ($quote_counter++) . "QUOTE"; $quotes{ $key } = $1; $key; /gex; @@ -100,14 +95,12 @@ sub _interpolate { $con; } } + elsif ($this->{StrictVars}) { + croak "Use of uninitialized variable (\$$var) while loading config entry: $key = $value\n"; + } else { - if ($this->{StrictVars}) { - croak "Use of uninitialized variable (\$$var) while loading config entry: $key = $value\n"; - } - else { - # be cool - $con; - } + # be cool + $con; } }egx; @@ -345,7 +338,7 @@ L =head1 COPYRIGHT Copyright 2001 by Wei-Hon Chen Eplasmaball@pchome.com.twE. -Copyright 2002-2009 by Thomas Linden . +Copyright 2002-2010 by Thomas Linden . This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -354,7 +347,7 @@ See L =head1 VERSION -2.11 +2.12 =cut diff --git a/MANIFEST b/MANIFEST index c540efd..c7009fd 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,19 +1,15 @@ +Changelog +example.cfg General/Extended.pm General/Interpolated.pm -t/Tie/IxHash.pm -t/Tie/README -t/complex/n1.cfg -t/complex/n2.cfg -t/sub1/sub2/sub3/cfg.sub3 -t/sub1/sub2/cfg.sub2 -t/sub1/sub2/cfg.sub2b -t/sub1/cfg.sub1 -t/sub1/cfg.sub1b -t/sub1/cfg.sub1c -t/sub1/cfg.sub1d -t/sub1/cfg.sub1e +General.pm +Makefile.PL +MANIFEST +META.yml +README t/apache-include.conf t/cfg.16 +t/cfg.16a t/cfg.17 t/cfg.19 t/cfg.2 @@ -34,15 +30,21 @@ t/cfg.5 t/cfg.6 t/cfg.7 t/cfg.8 +t/complex/n1.cfg +t/complex/n2.cfg t/complex.cfg t/dual-include.conf -t/run.t t/included.conf +t/run.t +t/sub1/cfg.sub1 +t/sub1/cfg.sub1b +t/sub1/cfg.sub1c +t/sub1/cfg.sub1d +t/sub1/cfg.sub1e +t/sub1/sub2/cfg.sub2 +t/sub1/sub2/cfg.sub2b +t/sub1/sub2/sub3/cfg.sub3 t/test.rc -Changelog -General.pm -MANIFEST -Makefile.PL -README -example.cfg -META.yml Module meta-data (added by MakeMaker) +t/Tie/IxHash.pm +t/Tie/README +t/cfg.51 diff --git a/META.yml b/META.yml index 3e0995a..a4a4e74 100644 --- a/META.yml +++ b/META.yml @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Config-General -version: 2.42 +version: 2.45 version_from: General.pm installdirs: site requires: diff --git a/README b/README index fac15c4..291077b 100644 --- a/README +++ b/README @@ -104,4 +104,4 @@ AUTHOR VERSION - 2.39 + 2.45 diff --git a/t/cfg.51 b/t/cfg.51 new file mode 100644 index 0000000..6971360 --- /dev/null +++ b/t/cfg.51 @@ -0,0 +1,4 @@ +dollar = \$foo +backslash = contains \\ backslash +prize = 18 $ +hostparam = "\"'wsh.dir'\"" diff --git a/t/cfg.8 b/t/cfg.8 index 3321e76..a826671 100644 --- a/t/cfg.8 +++ b/t/cfg.8 @@ -9,8 +9,7 @@ domain b0fh.org -domain l0pht.com -domain infonexus.com +domain b0fh.org message < 53; -#use Test::More qw(no_plan); +#use Test::More tests => 57; +use Test::More qw(no_plan); # ahem, we deliver the test code with a local copy of # the Tie::IxHash module so we can do tests on sorted @@ -508,6 +508,9 @@ my $expect46 = { is_deeply($expect46, \%conf46, "Variables inside single quotes"); + + + # complexity test # check the combination of various features my $conf47 = new Config::General( @@ -549,7 +552,7 @@ my $expect47 = { }, 'onflag' => 1, 'var2' => 'zeppelin', - 'ignore' => '\\$set', + 'ignore' => '$set', # escaped $ should get to plain $, not \\$! 'quote' => 'this should be \'kept: $set\' and not be \'$set!\'', 'x5' => { 'klack' => '11111' @@ -614,7 +617,7 @@ my $expect47 = { work too!' }; - +#scip is_deeply($expect47, \%conf47, "complexity test"); # check if sorted save works @@ -652,13 +655,50 @@ my $str48 = $cfg48->save_string(\%hash48); is( $str48, $ostr48, "tied hash test"); -# Check whether we can create a C::G object when -ConfigFile is passed as a stringify-able object. -use PathObject; -my $cfgFileObject = new PathObject; -my $cfg49 = new Config::General( - -ConfigFile => $cfgFileObject, - -ExtendedAccess => 1 - ); -ok($cfg49, "Creating a new object using the stringify-able file object way"); -my $domain49 = $cfg49->keys("domain"); -ok($domain49, "Config object created using the stringify-able file object way contains the domain section."); + +# check for undef and -w +{ +my $ostr49 = "foo\n"; +local $^W = 1; +my $cfg49 = new Config::General( -String => $ostr49 ); +my %hash49 = $cfg49->getall(); +ok( exists $hash49{foo}, "value for undefined key found"); +is( $hash49{foo}, undef, "value returned as expected - undef"); + +# repeat with interpolation turned on +$cfg49 = new Config::General( -String => $ostr49, -InterPolateVars => 1 ); +%hash49 = $cfg49->getall(); +ok( exists $hash49{foo}, "value for undefined key found"); +is( $hash49{foo}, undef, "value returned as expected - undef"); +$^W = 0; +} + + +# verifies bug fix rt#54580 +# Test handling of values containing *many* single-quoted strings +# when -InterPolateVars option is set +my $dupcount50 = 2000; +my $ostr50; +foreach my $counter ( reverse 1 .. $dupcount50 ) { + $ostr50 .= " 'luck${counter}'"; +} +$ostr50 =~ s{\A }{}; +my $cfgsrc50 = 'test_single_many ' . $ostr50; +$cfg50 = new Config::General( -String => $cfgsrc50, -InterPolateVars => 1 ); +%hash50 = $cfg50->getall(); +is($hash50{test_single_many}, $ostr50, "value with single-quote strings is as expected" ); + + +# check for escaped chars +my $cfg51 = new Config::General( -ConfigFile => "t/cfg.51" ); +my %hash51 = $cfg51->getall(); +is($hash51{dollar}, '$foo', "keep escaped dollar character"); +is($hash51{backslash}, 'contains \ backslash', "keep escaped backslash character"); +is($hash51{prize}, '18 $', "keep un-escaped dollar character"); +is($hash51{hostparam}, q("'wsh.dir'"), "keep escaped quote character"); + +# now save it to a file and re-read it in and see if everything remains escaped +$cfg51->save_file("t/cfg.51.out"); +$cfg51 = new Config::General( -ConfigFile => "t/cfg.51.out", -InterPolateVars => 1 ); +my %hash51new = $cfg51->getall(); +is_deeply(\%hash51, \%hash51new, "compare saved config containing escaped chars");