From d6b03e1ef78fd96b89d6d78da51a3cf29f350c24 Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Sat, 10 Oct 2009 16:44:49 +0000 Subject: [PATCH] 2.40 - fixed SplitDelimiter parser regex, it does no more consider non-whitespaces (\S+?) as the option name but anything before the delimiter (.+?), this fixes bug rt.cpan.org#36607, the fix of 2.39 were not sufficient. Thanks to Jeffrey Ratcliffe for pointing it out. - added new parameter -SaveSorted. The default value is 0, that means configs will be saved unsorted (as always), however if you want to save it sorted, turn this parameter to 1. Thanks to Herbert Breunung for the hint. - added complexity test, which checks a combination of various complex features of the parser. git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@66 be1acefe-a474-0410-9a34-9b3221f2030f --- Changelog | 15 ++++++ General.pm | 66 +++++++++++++++++------- t/complex.cfg | 28 ++++++++++ t/complex/n1.cfg | 16 ++++++ t/complex/n2.cfg | 17 +++++++ t/run.t | 130 ++++++++++++++++++++++++++++++++++++++++++++++- 6 files changed, 254 insertions(+), 18 deletions(-) create mode 100644 t/complex.cfg create mode 100644 t/complex/n1.cfg create mode 100644 t/complex/n2.cfg diff --git a/Changelog b/Changelog index b7c87ff..79c070e 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,18 @@ + 2.40 + - fixed SplitDelimiter parser regex, it does no more consider + non-whitespaces (\S+?) as the option name but anything + before the delimiter (.+?), this fixes bug rt.cpan.org#36607, + the fix of 2.39 were not sufficient. Thanks to + Jeffrey Ratcliffe for pointing it out. + + - added new parameter -SaveSorted. The default value is 0, + that means configs will be saved unsorted (as always), + however if you want to save it sorted, turn this parameter + to 1. Thanks to Herbert Breunung for the hint. + + - added complexity test, which checks a combination + of various complex features of the parser. + 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 diff --git a/General.pm b/General.pm index 09d1644..8807e80 100644 --- a/General.pm +++ b/General.pm @@ -32,7 +32,7 @@ use Carp::Heavy; use Carp; use Exporter; -$Config::General::VERSION = 2.39; +$Config::General::VERSION = 2.40; use vars qw(@ISA @EXPORT_OK); use base qw(Exporter); @@ -80,7 +80,8 @@ 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 + UTF8 => 0, + SaveSorted => 0 }; # create the class instance @@ -661,7 +662,7 @@ sub _read { } else { # no guess, use one of the configured strict split policies - if (/^\s*(\S+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) { + if (/^\s*(.+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) { $hier = $1; # the actual here-doc variable name $hierend = $3; # the here-doc identifier, i.e. "EOF" next; @@ -1160,22 +1161,48 @@ sub _store { my $config_string = q(); - 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); + 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); + } } } + 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}); + } + 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}); + } } } @@ -1832,6 +1859,11 @@ explicit empty blocks. If turned on, all files will be opened in utf8 mode. This may not work properly with older versions of perl. +=item B<-SaveSorted> + +If you want to save configs in a sorted manner, turn this +parameter on. It is not enabled by default. + =back @@ -2462,7 +2494,7 @@ Thomas Linden =head1 VERSION -2.39 +2.40 =cut diff --git a/t/complex.cfg b/t/complex.cfg new file mode 100644 index 0000000..c52517e --- /dev/null +++ b/t/complex.cfg @@ -0,0 +1,28 @@ +# complexity test +var1 = zero # comment +var2 = zeppelin /* another comment */ +/* +to be ignored +*/ +line = a\ + long line +var3 = blah +set = $var3 +ignore = \$set +quote = this should be 'kept: $set' and not be '$set!' +host = gw.intx.foo +cmd = mart@${host}:22 +onflag = yes +offflag = No +<> +a [[weird]] heredoc = < + <> + diff --git a/t/complex/n1.cfg b/t/complex/n1.cfg new file mode 100644 index 0000000..70b195d --- /dev/null +++ b/t/complex/n1.cfg @@ -0,0 +1,16 @@ + + + x = 9323 + z = 000 + + g = $z + long = another long \ + line + + /* + please ignore this */ + + + z = rewe + + diff --git a/t/complex/n2.cfg b/t/complex/n2.cfg new file mode 100644 index 0000000..6bd9f9f --- /dev/null +++ b/t/complex/n2.cfg @@ -0,0 +1,17 @@ + + mode = 755 + + + Options = +Indexes + +nando = 11111 + + blak = $nando + nando = 9999 + + + klack = $nando + + + value = 0 + diff --git a/t/run.t b/t/run.t index 77bba37..c3c12e0 100644 --- a/t/run.t +++ b/t/run.t @@ -8,7 +8,7 @@ use Data::Dumper; -use Test::More tests => 47; +use Test::More tests => 49; #use Test::More qw(no_plan); ### 1 @@ -487,3 +487,131 @@ my $expect46 = { 'foo' => 'bar' }; is_deeply($expect46, \%conf46, "Variables inside single quotes"); + + +# complexity test +# check the combination of various features +my $conf47 = new Config::General( + -ConfigFile => "t/complex.cfg", + -InterPolateVars => 1, + -DefaultConfig => { this => "that", default => "imported" }, + -MergeDuplicateBlocks => 1, + -MergeDuplicateOptions => 1, + -StrictVars => 1, + -SplitPolicy => 'custom', + -SplitDelimiter => '\s*=\s*', + -IncludeGlob => 1, + -IncludeAgain => 1, + -IncludeRelative => 1, + -AutoTrue => 1, + -FlagBits => { someflags => { LOCK => 1, RW => 2, TAINT => 3 } }, + -StoreDelimiter => ' = ', + -SlashIsDirectory => 1, + -SaveSorted => 1 + ); +my %conf47 = $conf47->getall(); +my $expect47 = { + 'var3' => 'blah', + 'z1' => { + 'blak' => '11111', + 'nando' => '9999' + }, + 'a' => { + 'b' => { + 'm' => { + '9323' => { + 'g' => '000', + 'long' => 'another long line' + } + }, + 'x' => '9323', + 'z' => 'rewe' + } + }, + 'onflag' => 1, + 'var2' => 'zeppelin', + 'ignore' => '\\$set', + 'quote' => 'this should be \'kept: $set\' and not be \'$set!\'', + 'x5' => { + 'klack' => '11111' + }, + 'set' => 'blah', + 'line' => 'along line', + 'this' => 'that', + 'imported' => 'got that from imported config', + 'someflags' => { + 'RW' => 2, + 'LOCK' => 1, + 'TAINT' => 3 + }, + 'var1' => 'zero', + 'offflag' => 0, + 'cmd' => 'mart@gw.intx.foo:22', + 'default' => 'imported', + 'host' => 'gw.intx.foo', + 'nando' => '11111', + 'auch ätzendes' => 'muss gehen', + 'Directory' => { + '/' => { + 'mode' => '755' + } + }, + 'hansa' => { + 'z1' => { + 'blak' => '11111', + 'nando' => '9999' + }, + 'Directory' => { + '/' => { + 'mode' => '755' + } + }, + 'block' => { + '0' => { + 'value' => 0 + } + }, + 'x5' => { + 'klack' => '11111' + }, + 'Files' => { + '~/*.pl' => { + 'Options' => '+Indexes' + } + }, + 'nando' => '11111' + }, + 'block' => { + '0' => { + 'value' => 0 + } + }, + 'Files' => { + '~/*.pl' => { + 'Options' => '+Indexes' + } + }, + 'a [[weird]] heredoc' => 'has to + work + too!' +}; + +is_deeply($expect47, \%conf47, "complexity test"); + +# check if sorted save works +$conf47->save_file("t/complex.out", \%conf47); +open T, "; +close T; +my $sorted = qq( +imported = got that from imported config +line = along line +nando = 11111 +offflag = 0 +onflag = 1); +if ($got47 =~ /\Q$sorted\E/) { + pass("Testing sorted save"); +} +else { + fail("Testing sorted save"); +}