scip/Config-General
1
0
Fork 0
mirror of https://codeberg.org/scip/Config-General.git synced 2025-12-16 12:11:02 +01:00
Code Issues Packages Projects Releases Wiki Activity

Splat with 2.45

Browse Source 
git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@74 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2010-04-08 15:47:22 +00:00
parent afc1678d5d
commit 045aed9c39
9 changed files with 159 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
Changelog
View File

@@ -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.

115
General.pm
View File

@@ -5,7 +5,7 @@
# config values from a given file and
# return it as hash structure
#
# Copyright (c) 2000-2009 Thomas Linden <tlinden |AT| cpan.org>.
# Copyright (c) 2000-20010Thomas Linden <tlinden |AT| cpan.org>.
# 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} ? '(?<!\\\\)' : q();
if (/$extra\\$/) {
#my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : q();
#if (/$extra\\$/) {
if (/(?<!\\)\\$/) {
chop;
s/^\s*//;
$longline .= $_;
@@ -630,13 +630,13 @@ sub _read {
# remove the \ from all characters if BackslashEscape is turned on
# FIXME (rt.cpan.org#33218
if ($this->{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<This option might be removed in future versions>.
B<Deprecated Option>.
=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 <tlinden |AT| cpan.org>
=head1 VERSION
2.44
2.45
=cut

29
General/Interpolated.pm
View File

@@ -2,13 +2,13 @@
# Config::General::Interpolated - special Class based on Config::General
#
# Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>.
# Copyright (c) 2000-2009 by Thomas Linden <tlinden |AT| cpan.org>.
# Copyright (c) 2000-2010 by Thomas Linden <tlinden |AT| cpan.org>.
# 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<Config::General>
=head1 COPYRIGHT
Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
Copyright 2002-2009 by Thomas Linden <tlinden |AT| cpan.org>.
Copyright 2002-2010 by Thomas Linden <tlinden |AT| cpan.org>.
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<http://www.perl.com/perl/misc/Artistic.html>
=head1 VERSION
2.11
2.12
=cut

42
MANIFEST
View File

@@ -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

2
META.yml
View File

@@ -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:

2
README
View File

@@ -104,4 +104,4 @@ AUTHOR
VERSION
2.39
2.45

4
t/cfg.51 Normal file
View File

@@ -0,0 +1,4 @@
dollar = \$foo
backslash = contains \\ backslash
prize = 18 $
hostparam = "\"'wsh.dir'\""

5
t/cfg.8
View File

@@ -9,8 +9,7 @@
</officer>
</cops>
domain b0fh.org
domain l0pht.com
domain infonexus.com
domain b0fh.org
message <<EOF
yes. we are not here. you
can reach us somewhere in
@@ -37,3 +36,5 @@ host = blah.blubber
quoted = "this one contains whitespace at the end "
quotedwithquotes = " holy crap, it contains \"masked quotes\" and 'single quotes' "

68
t/run.t
View File

@@ -8,8 +8,8 @@
use Data::Dumper;
use Test::More tests => 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");