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"); +}