- 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
This commit is contained in:
Thomas von Dein
2009-10-10 16:44:49 +00:00
parent 5f92f52e0a
commit d6b03e1ef7
6 changed files with 254 additions and 18 deletions

View File

@@ -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 <tlinden |AT| cpan.org>
=head1 VERSION
2.39
2.40
=cut