From e3f94758a72b60c8521af523c1879b5e4f829396 Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Wed, 18 Jul 2012 13:06:33 +0000 Subject: [PATCH] fixed bugs and added -NoEscape + -Normalize(Option|Block|Value) parameters. git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@94 be1acefe-a474-0410-9a34-9b3221f2030f --- Changelog | 15 ++++++++ General.pm | 83 ++++++++++++++++++++++++++++++++++++----- General/Extended.pm | 4 +- General/Interpolated.pm | 4 +- Makefile.PL | 2 +- t/run.t | 7 +++- 6 files changed, 99 insertions(+), 16 deletions(-) diff --git a/Changelog b/Changelog index aa8d4a7..322c4ca 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,18 @@ + 2.51 - fixed rt.cpan.org#77667 which resulted in invalid configs + written to file when using save_file() and a named block, + whose 2nd part starts with a /. + + - fixed rt.cpan.org#64169 by applying patch by Dulaunoy Fabrice. + adds -NoEscape switch which turns off escaping of anything. + + - implemented suggestion of rt.cpan.org#67564 by adding 3 new + parameters: -NormalizeOption, -NormalizeBlock and -NormalizeValue, + which take a subroutine reference and change the block, + option or value accordingly. + + - fixed rt.cpan.org#65860+76953 undefined value error. + + 2.50 - fixed rt.cpan.org#63487 documentation error. diff --git a/General.pm b/General.pm index 245a71d..e90f8b1 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-2010 Thomas Linden . +# Copyright (c) 2000-2012 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artistic License, same as perl itself. Have fun. # @@ -88,7 +88,11 @@ sub new { UTF8 => 0, SaveSorted => 0, ForceArray => 0, # force single value array if value enclosed in [] - AllowSingleQuoteInterpolation => 0 + AllowSingleQuoteInterpolation => 0, + NoEscape => 0, + NormalizeBlock => 0, + NormalizeOption => 0, + NormalizeValue => 0, }; # create the class instance @@ -791,6 +795,10 @@ sub _parse { } } + if($this->{NormalizeOption}) { + $option = $this->{NormalizeOption}($option); + } + if ($value && $value =~ /^"/ && $value =~ /"$/) { $value =~ s/^"//; # remove leading and trailing " $value =~ s/"$//; @@ -809,6 +817,16 @@ sub _parse { $blockname = $3 || $4; } } + if($this->{NormalizeBlock}) { + $block = $this->{NormalizeBlock}($block); + if (defined $blockname) { + $blockname = $this->{NormalizeBlock}($blockname); + if($blockname eq "") { + # if, after normalization no blockname is left, remove it + $blockname = undef; + } + } + } if ($this->{InterPolateVars}) { # interpolate block(name), add "<" and ">" to the key, because # it is sure that such keys does not exist otherwise. @@ -869,7 +887,7 @@ sub _parse { } } else { - if($this->{ForceArray} && $value =~ /^\[\s*(.+?)\s*\]$/) { + if($this->{ForceArray} && defined $value && $value =~ /^\[\s*(.+?)\s*\]$/) { # force single value array entry push @{$config->{$option}}, $this->_parse_value($config, $option, $1); } @@ -949,7 +967,6 @@ sub _parse { if ($this->{InterPolateVars}) { # inherit current __stack to new block $tmphash->{__stack} = $this->_copy($config->{__stack}); - #$tmphash->{__stack} = $config->{$block}->{__stack}; } $config->{$block}->{$blockname} = $this->_parse($tmphash, \@newcontent); @@ -1057,6 +1074,10 @@ sub _parse_value { return $value; } + if($this->{NormalizeValue}) { + $value = $this->{NormalizeValue}($value); + } + if ($this->{InterPolateVars}) { $value = $this->_interpolate($config, $option, $value); } @@ -1087,8 +1108,10 @@ sub _parse_value { } } - # are there any escaped characters left? put them out as is - $value =~ s/\\([\$\\\"#])/$1/g; + if (!$this->{NoEscape}) { + # are there any escaped characters left? put them out as is + $value =~ s/\\([\$\\\"#])/$1/g; + } return $value; } @@ -1277,8 +1300,10 @@ sub _write_scalar { else { # a simple stupid scalar entry - # re-escape contained $ or # or \ chars - $line =~ s/([#\$\\\"])/\\$1/g; + if (!$this->{NoEscape}) { + # re-escape contained $ or # or \ chars + $line =~ s/([#\$\\\"])/\\$1/g; + } # bugfix rt.cpan.org#42287 if ($line =~ /^\s/ or $line =~ /\s$/) { @@ -1306,6 +1331,20 @@ sub _write_hash { $entry = q(") . $entry . q("); } + # check if the next level key points to a hash and is the only one + # in this case put out a named block + # fixes rt.77667 + my $num = scalar keys %{$line}; + if($num == 1) { + my $key = (keys %{$line})[0]; + if(ref($line->{$key}) eq 'HASH') { + $config_string .= $indent . qq(<$entry $key>\n); + $config_string .= $this->_store($level + 1, $line->{$key}); + $config_string .= $indent . qq(\n"; + return $config_string; + } + } + $config_string .= $indent . q(<) . $entry . ">\n"; $config_string .= $this->_store($level + 1, $line); $config_string .= $indent . q(\n"; @@ -1900,6 +1939,32 @@ not work properly with older versions of Perl. If you want to save configs in a sorted manner, turn this parameter on. It is not enabled by default. +=item B<-NoEscape> + +If you want to use the data ( scalar or final leaf ) without escaping special charatecter, turn this +parameter on. It is not enabled by default. + +=item B<-NormalizeBlock> + +Takes a subroutine reference as parameter and gets the current +block or blockname passed as parameter and is expected to return +it in some altered way as a scalar string. The sub will be called +before anything else will be done by the module itself (e.g. interpolation). + +Example: + + -NormalizeBlock => sub { my $x = shift; $x =~ s/\s*$//; $x; } + +This removes trailing whitespaces of block names. + +=item B<-NormalizeOption> + +Same as B<-NormalizeBlock> but applied on options only. + +=item B<-NormalizeValue> + +Same as B<-NormalizeBlock> but applied on values only. + =back @@ -2512,7 +2577,7 @@ I recommend you to read the following documents, which are supplied with Perl: =head1 LICENSE AND COPYRIGHT -Copyright (c) 2000-2010 Thomas Linden +Copyright (c) 2000-2012 Thomas Linden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/General/Extended.pm b/General/Extended.pm index ee22316..a49bc8f 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-2010 Thomas Linden . +# Copyright (c) 2000-2012 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artistic License, same as perl itself. Have fun. # @@ -621,7 +621,7 @@ values under the given key will be overwritten. =head1 COPYRIGHT -Copyright (c) 2000-2010 Thomas Linden +Copyright (c) 2000-2012 Thomas Linden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/General/Interpolated.pm b/General/Interpolated.pm index e259964..df7f6e3 100644 --- a/General/Interpolated.pm +++ b/General/Interpolated.pm @@ -2,7 +2,7 @@ # Config::General::Interpolated - special Class based on Config::General # # Copyright (c) 2001 by Wei-Hon Chen . -# Copyright (c) 2000-2010 by Thomas Linden . +# Copyright (c) 2000-2012 by Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artistic License, same as perl itself. Have fun. # @@ -341,7 +341,7 @@ L =head1 COPYRIGHT Copyright 2001 by Wei-Hon Chen Eplasmaball@pchome.com.twE. -Copyright 2002-2010 by Thomas Linden . +Copyright 2002-2012 by Thomas Linden . This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/Makefile.PL b/Makefile.PL index f3f8da6..d697bde 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,7 +1,7 @@ # # Makefile.PL - build file for Config::General # -# Copyright (c) 2000-2010 Thomas Linden . +# Copyright (c) 2000-2012 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artistic License, same as perl itself. Have fun. # diff --git a/t/run.t b/t/run.t index 0217d81..425194c 100644 --- a/t/run.t +++ b/t/run.t @@ -8,7 +8,7 @@ use Data::Dumper; -use Test::More tests => 68; +use Test::More tests => 69; #use Test::More qw(no_plan); # ahem, we deliver the test code with a local copy of @@ -731,4 +731,7 @@ is($hash53{have}, "'1'", "check -AllowSingleQuoteInterpolation"); # Make sure no warnings were seen during the test. ok( !@WARNINGS_FOUND, "No unexpected warnings seen" ); - +# check if disabling escape chars does work +my $cfg54 = new Config::General(-NoEscape => 1, -String => qq(val = \\\$notavar:\\blah\n)); +my %hash54 = $cfg54->getall(); +is($hash54{val}, qq(\\\$notavar:\\blah), "check -NoEscape");