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

2.32

Browse Source 
- fixed rt.cpan.org#24232 - import ENV vars only if defined

	- fixed rt.cpan.org#20742 - dont' overwrite a var if re-defined
	  in current scope, interpolation failed for re-defined vars and used
	  the value of the var defined in outer scope, not the current one.

	- fixed rt.cpan.org#17852 - a 0 as blockname were ignored. applied
	  patch by SCOP to t/run.t to test for 0 in blocks.

	- applied most hints Perl::Critic had about Config::General:
	  o the functions ParseConfig SaveConfig SaveConfigString must
	    now imported implicitly. This might break existing code, but
	    is easily to fix.
	  o using IO::File instead of open().
	  o General.pm qualifies for "stern" level after all.

	- added much more tests to t/run.t for 'make test'.

	- using Test::More now.


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@58 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:38:28 +00:00
parent 80bcb7ddae
commit 72fdf51f16
15 changed files with 484 additions and 379 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
Changelog
View File

@@ -1,3 +1,26 @@
2.32
- fixed rt.cpan.org#24232 - import ENV vars only if defined
- fixed rt.cpan.org#20742 - dont' overwrite a var if re-defined
in current scope, interpolation failed for re-defined vars and used
the value of the var defined in outer scope, not the current one.
- fixed rt.cpan.org#17852 - a 0 as blockname were ignored. applied
patch by SCOP to t/run.t to test for 0 in blocks.
- applied most hints Perl::Critic had about Config::General:
o the functions ParseConfig SaveConfig SaveConfigString must
now imported implicitly. This might break existing code, but
is easily to fix.
o using IO::File instead of open().
o General.pm qualifies for "stern" level after all.
- added much more tests to t/run.t for 'make test'.
- using Test::More now.
2.31
- applied patches by Jason Rhinelander <jagerman@jagerman.com>:
o bugfix: multiple levels if include files didn't

292
General.pm
View File

@@ -5,17 +5,22 @@
# config values from a given file and
# return it as hash structure
#
# Copyright (c) 2000-2006 Thomas Linden <tom@daemon.de>.
# Copyright (c) 2000-2007 Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
# namespace
package Config::General;
use strict;
use warnings;
use English '-no_match_vars';
use IO::File;
use FileHandle;
use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath);
use File::Glob qw/:glob/;
use strict;
# on debian with perl > 5.8.4 croak() doesn't work anymore without this.
# There is some require statement which dies 'cause it can't find Carp::Heavy,
@@ -27,11 +32,11 @@ use Carp::Heavy;
use Carp;
use Exporter;
$Config::General::VERSION = "2.31";
$Config::General::VERSION = 2.32;
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(ParseConfig SaveConfig SaveConfigString);
use vars qw(@ISA @EXPORT_OK);
use base qw(Exporter);
@EXPORT_OK = qw(ParseConfig SaveConfig SaveConfigString);
sub new {
#
@@ -89,18 +94,18 @@ sub new {
StrictVars => 1, # be strict on undefined variables in Interpolate mode
Tie => "", # could be set to a perl module for tie'ing new hashes
Tie => q(), # could be set to a perl module for tie'ing new hashes
parsed => 0, # internal state stuff for variable interpolation
upperkey => "",
upperkey => q(),
upperkeys => [],
lastkey => "",
prevkey => " ",
lastkey => q(),
prevkey => q( ),
files => {}, # which files we have read, if any
};
# create the class instance
bless($self,$class);
bless $self, $class;
if ($#param >= 1) {
@@ -111,12 +116,20 @@ sub new {
$self->{Params} = \%conf;
# be backwards compatible
$self->{ConfigFile} = delete $conf{-file} if(exists $conf{-file});
$self->{ConfigHash} = delete $conf{-hash} if(exists $conf{-hash});
if (exists $conf{-file}) {
$self->{ConfigFile} = delete $conf{-file};
}
if (exists $conf{-hash}) {
$self->{ConfigHash} = delete $conf{-hash};
}
# store input, file, handle, or array
$self->{ConfigFile} = delete $conf{-ConfigFile} if(exists $conf{-ConfigFile});
$self->{ConfigHash} = delete $conf{-ConfigHash} if(exists $conf{-ConfigHash});
if (exists $conf{-ConfigFile}) {
$self->{ConfigFile} = delete $conf{-ConfigFile};
}
if (exists $conf{-ConfigHash}) {
$self->{ConfigHash} = delete $conf{-ConfigHash};
}
# store search path for relative configs, if any
if (exists $conf{-ConfigPath}) {
@@ -126,10 +139,15 @@ sub new {
# handle options which contains values we are needing (strings, hashrefs or the like)
if (exists $conf{-String} ) {
if ($conf{-String}) {
$self->{StringContent} = $conf{-String};
if (ref(\$conf{-String}) eq 'SCALAR') {
if ( $conf{-String}) {
$self->{StringContent} = $conf{-String};
}
delete $conf{-String};
}
else {
croak "Parameter -String must be a SCALAR!\n";
}
delete $conf{-String};
}
if (exists $conf{-Tie}) {
@@ -140,7 +158,7 @@ sub new {
}
if (exists $conf{-FlagBits}) {
if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq "HASH") {
if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq 'HASH') {
$self->{FlagBits} = 1;
$self->{FlagBitsFlags} = $conf{-FlagBits};
}
@@ -148,11 +166,11 @@ sub new {
}
if (exists $conf{-DefaultConfig}) {
if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq "HASH") {
if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq 'HASH') {
$self->{DefaultConfig} = $conf{-DefaultConfig};
}
elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq "") {
$self->_read($conf{-DefaultConfig}, "SCALAR");
elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq q()) {
$self->_read($conf{-DefaultConfig}, 'SCALAR');
$self->{DefaultConfig} = $self->_parse($self->_hashref(), $self->{content});
$self->{content} = ();
}
@@ -189,7 +207,7 @@ sub new {
elsif ($#param == 0) {
# use of the old style
$self->{ConfigFile} = $param[0];
if (ref($self->{ConfigFile}) eq "HASH") {
if (ref($self->{ConfigFile}) eq 'HASH') {
$self->{ConfigHash} = delete $self->{ConfigFile};
}
}
@@ -203,11 +221,15 @@ sub new {
if ($self->{SplitPolicy} ne 'guess') {
if ($self->{SplitPolicy} eq 'whitespace') {
$self->{SplitDelimiter} = '\s+';
$self->{StoreDelimiter} = " " if(!$self->{StoreDelimiter});
if (!$self->{StoreDelimiter}) {
$self->{StoreDelimiter} = q( );
}
}
elsif ($self->{SplitPolicy} eq 'equalsign') {
$self->{SplitDelimiter} = '\s*=\s*';
$self->{StoreDelimiter} = " = " if(!$self->{StoreDelimiter});
if (!$self->{StoreDelimiter}) {
$self->{StoreDelimiter} = ' = ';
}
}
elsif ($self->{SplitPolicy} eq 'custom') {
if (! $self->{SplitDelimiter} ) {
@@ -219,7 +241,9 @@ sub new {
}
}
else {
$self->{StoreDelimiter} = " " if(!$self->{StoreDelimiter});
if (!$self->{StoreDelimiter}) {
$self->{StoreDelimiter} = q( );
}
}
if ($self->{InterPolateVars} || $self->{InterPolateEnv}) {
@@ -229,12 +253,12 @@ sub new {
# we are blessing here again, to get into the ::InterPolated namespace
# for inheriting the methods available overthere, which we doesn't have.
#
bless($self, "Config::General::Interpolated");
bless $self, 'Config::General::Interpolated';
eval {
require Config::General::Interpolated;
};
if ($@) {
croak $@;
if ($EVAL_ERROR) {
croak $EVAL_ERROR;
}
# pre-compile the variable regexp
$self->{regex} = $self->_set_regex();
@@ -247,11 +271,11 @@ sub new {
}
if (exists $self->{StringContent}) {
# consider the supplied string as config file
$self->_read($self->{StringContent}, "SCALAR");
$self->_read($self->{StringContent}, 'SCALAR');
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
elsif (exists $self->{ConfigHash}) {
if (ref($self->{ConfigHash}) eq "HASH") {
if (ref($self->{ConfigHash}) eq 'HASH') {
# initialize with given hash
$self->{config} = $self->{ConfigHash};
$self->{parsed} = 1;
@@ -260,7 +284,7 @@ sub new {
croak "Parameter -ConfigHash must be a hash reference!\n";
}
}
elsif (ref($self->{ConfigFile}) eq "GLOB" || ref($self->{ConfigFile}) eq "FileHandle") {
elsif (ref($self->{ConfigFile}) eq 'GLOB' || ref($self->{ConfigFile}) eq 'FileHandle') {
# use the file the glob points to
$self->_read($self->{ConfigFile});
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
@@ -273,8 +297,10 @@ sub new {
# look if is is an absolute path and save the basename if it is absolute
my ($volume, $path, undef) = splitpath($self->{ConfigFile});
$path =~ s#/$##; # remove eventually existing trailing slash
$self->{ConfigPath} = [] unless $self->{ConfigPath};
unshift @{$self->{ConfigPath}}, catpath($volume, $path, '');
if (! $self->{ConfigPath}) {
$self->{ConfigPath} = [];
}
unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
}
$self->_open($self->{configfile});
# now, we parse immdediately, getall simply returns the whole hash
@@ -297,12 +323,12 @@ sub new {
# we are blessing here again, to get into the ::Extended namespace
# for inheriting the methods available overthere, which we doesn't have.
#
bless($self, "Config::General::Extended");
bless $self, 'Config::General::Extended';
eval {
require Config::General::Extended;
};
if ($@) {
croak $@;
if ($EVAL_ERROR) {
croak $EVAL_ERROR;
}
}
@@ -334,16 +360,18 @@ sub _open {
# open the config file, or expand a directory or glob
#
my($this, $configfile) = @_;
my $fh = new FileHandle;
my $fh;
if ($this->{IncludeGlob} and $configfile =~ /[*?\[\{\\]/) {
# Something like: *.conf (or maybe dir/*.conf) was included; expand it and
# pass each expansion through this method again.
my @include = grep -f, bsd_glob($configfile, GLOB_BRACE | GLOB_QUOTE);
my @include = grep { -f $_ } bsd_glob($configfile, GLOB_BRACE | GLOB_QUOTE);
if (@include == 1) {
$configfile = $include[0];
}
else { # Multiple results or no expansion results (which is fine, include foo/* shouldn't fail if there isn't anything matching)
else {
# Multiple results or no expansion results (which is fine,
# include foo/* shouldn't fail if there isn't anything matching)
local $this->{IncludeGlob};
for (@include) {
$this->_open($_);
@@ -354,7 +382,7 @@ sub _open {
if (!-e $configfile) {
my $found;
if (defined($this->{ConfigPath})) {
if (defined $this->{ConfigPath}) {
# try to find the file within ConfigPath
foreach my $dir (@{$this->{ConfigPath}}) {
if( -e catfile($dir, $configfile) ) {
@@ -365,27 +393,27 @@ sub _open {
}
}
if (!$found) {
my $path_message = defined $this->{ConfigPath} ? ' within ConfigPath: ' . join('.', @{$this->{ConfigPath}}) : '';
my $path_message = defined $this->{ConfigPath} ? q( within ConfigPath: ) . join(q(.), @{$this->{ConfigPath}}) : q();
croak qq{The file "$configfile" does not exist$path_message!};
}
}
local ($/) = $/;
unless ($/) {
carp("\$/ (INPUT_RECORD_SEPARATOR) is undefined. Guessing you want a line feed character");
$/ = "\n";
local ($RS) = $RS;
if (! $RS) {
carp(q(\$RS (INPUT_RECORD_SEPARATOR) is undefined. Guessing you want a line feed character));
$RS = "\n";
}
if (-d $configfile and $this->{IncludeDirectories}) {
# A directory was included; include all the files inside that directory in ASCII order
local *INCLUDEDIR;
opendir INCLUDEDIR, $configfile or croak "Could not open directory $configfile!($!)\n";
my @files = sort grep -f "$configfile/$_", readdir INCLUDEDIR;
my @files = sort grep { -f "$configfile/$_" } "$configfile/$_", readdir INCLUDEDIR;
closedir INCLUDEDIR;
local $this->{CurrentConfigFilePath} = $configfile;
for (@files) {
unless ($this->{files}->{"$configfile/$_"}) {
open $fh, "<$configfile/$_" or croak "Could not open $configfile/$_!($!)\n";
if (! $this->{files}->{"$configfile/$_"}) {
$fh = IO::File->new( "$configfile/$_", 'r') or croak "Could not open $configfile/$_!($!)\n";
$this->{files}->{"$configfile/$_"} = 1;
$this->_read($fh);
}
@@ -398,16 +426,17 @@ sub _open {
return;
}
else {
open $fh, "<$configfile" or croak "Could not open $configfile!($!)\n";
$fh = IO::File->new( "$configfile", 'r') or croak "Could not open $configfile!($!)\n";
$this->{files}->{$configfile} = 1;
my ($volume, $path, undef) = splitpath($configfile);
local $this->{CurrentConfigFilePath} = catpath($volume, $path, '');
local $this->{CurrentConfigFilePath} = catpath($volume, $path, q());
$this->_read($fh);
}
}
return;
}
@@ -419,14 +448,14 @@ sub _read {
#
my($this, $fh, $flag) = @_;
my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc);
local $_;
local $_ = q();
if ($flag && $flag eq "SCALAR") {
if (ref($fh) eq "ARRAY") {
if ($flag && $flag eq 'SCALAR') {
if (ref($fh) eq 'ARRAY') {
@stuff = @{$fh};
}
else {
@stuff = split "\n", $fh;
@stuff = split /\n/, $fh;
}
}
else {
@@ -435,8 +464,9 @@ sub _read {
foreach (@stuff) {
if ($this->{AutoLaunder}) {
m/^(.*)$/;
$_ = $1;
if (m/^(.*)$/) {
$_ = $1;
}
}
chomp;
@@ -472,7 +502,7 @@ sub _read {
# inside here-doc, only look for $hierend marker
if (/^(\s*)\Q$hierend\E\s*$/) {
my $indent = $1; # preserve indentation
$hier .= " " . chr(182); # append a "<22>" to the here-doc-name, so
$hier .= ' ' . chr 182; # append a "<22>" to the here-doc-name, so
# _parse will also preserver indentation
if ($indent) {
foreach (@hierdoc) {
@@ -506,7 +536,7 @@ sub _read {
# look for multiline option, indicated by a trailing backslash
my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : '';
my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : q();
if (/$extra\\$/) {
chop;
s/^\s*//;
@@ -581,11 +611,11 @@ sub _read {
else {
# look for include statement(s)
my $incl_file;
my $path = "";
if ( $this->{IncludeRelative} and defined($this->{CurrentConfigFilePath})) {
my $path = '';
if ( $this->{IncludeRelative} and defined $this->{CurrentConfigFilePath}) {
$path = $this->{CurrentConfigFilePath};
}
elsif (defined($this->{ConfigPath})) {
elsif (defined $this->{ConfigPath}) {
# fetch pathname of base config file, assuming the 1st one is the path of it
$path = $this->{ConfigPath}->[0];
}
@@ -621,7 +651,7 @@ sub _parse {
my($this, $config, $content) = @_;
my(@newcontent, $block, $blockname, $chunk,$block_level);
local $_;
my $indichar = chr(182); # <20>, inserted by _open, our here-doc indicator
my $indichar = chr 182; # <20>, inserted by _open, our here-doc indicator
foreach (@{$content}) { # loop over content stack
chomp;
@@ -671,11 +701,13 @@ sub _parse {
# interpolate block(name), add "<" and ">" to the key, because
# it is sure that such keys does not exist otherwise.
$block = $this->_interpolate("<$block>", $block);
if ($blockname) {
$blockname = $this->_interpolate("<$blockname>", $blockname);
if (defined $blockname) {
$blockname = $this->_interpolate("<$blockname>", "$blockname");
}
}
$block = lc($block) if $this->{LowerCaseNames}; # only for blocks lc(), if configured via new()
if ($this->{LowerCaseNames}) {
$block = lc $block; # only for blocks lc(), if configured via new()
}
$this->{level} += 1;
undef @newcontent;
next;
@@ -684,7 +716,9 @@ sub _parse {
croak "EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
}
else { # insert key/value pair into actual node
$option = lc($option) if $this->{LowerCaseNames};
if ($this->{LowerCaseNames}) {
$option = lc $option;
}
if (exists $config->{$option}) {
if ($this->{MergeDuplicateOptions}) {
$config->{$option} = $this->_parse_value($option, $value);
@@ -696,7 +730,7 @@ sub _parse {
}
else {
# yes, duplicates allowed
if (ref($config->{$option}) ne "ARRAY") { # convert scalar to array
if (ref($config->{$option}) ne 'ARRAY') { # convert scalar to array
my $savevalue = $config->{$option};
delete $config->{$option};
push @{$config->{$option}}, $savevalue;
@@ -705,7 +739,7 @@ sub _parse {
# check if arrays are supported by the underlying hash
my $i = scalar @{$config->{$option}};
};
if ($@) {
if ($EVAL_ERROR) {
$config->{$option} = $this->_parse_value($option, $value);
}
else {
@@ -731,11 +765,12 @@ sub _parse {
push @newcontent, $_; # push onto new content stack
}
else { # calling myself recursively, end of $block reached, $block_level is 0
if ($blockname) { # a named block, make it a hashref inside a hash within the current node
if (defined $blockname) { # a named block, make it a hashref inside a hash within the current node
$this->_savelast($blockname);
$config->{$block} = $this->_hashref() # Make sure that the hash is not created implicitely
unless exists $config->{$block};
if (! exists $config->{$block}) {
$config->{$block} = $this->_hashref(); # Make sure that the hash is not created implicitely
}
if (exists $config->{$block}->{$blockname}) { # the named block already exists, make it an array
if ($this->{MergeDuplicateBlocks}) {
@@ -751,7 +786,7 @@ sub _parse {
my $savevalue = $config->{$block}->{$blockname};
delete $config->{$block}->{$blockname};
my @ar;
if (ref $savevalue eq "ARRAY") {
if (ref $savevalue eq 'ARRAY') {
push @ar, @{$savevalue}; # preserve array if any
}
else {
@@ -762,7 +797,7 @@ sub _parse {
}
}
}
elsif (ref($config->{$block}) eq "ARRAY") {
elsif (ref($config->{$block}) eq 'ARRAY') {
croak "Cannot add named block <$block $blockname> to hash! Block <$block> occurs more than once.\n"
."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n";
}
@@ -827,15 +862,17 @@ sub _parse {
sub _savelast {
my($this, $key) = @_;
push(@{$this->{upperkeys}}, $this->{lastkey});
push @{$this->{upperkeys}}, $this->{lastkey};
$this->{lastkey} = $this->{prevkey};
$this->{prevkey} = $key;
return;
}
sub _backlast {
my($this, $key) = @_;
$this->{prevkey} = $this->{lastkey};
$this->{lastkey} = pop(@{$this->{upperkeys}});
$this->{lastkey} = pop @{$this->{upperkeys}};
return;
}
sub _parse_value {
@@ -847,7 +884,9 @@ sub _parse_value {
my($this, $option, $value) =@_;
# avoid "Use of uninitialized value"
$value = '' unless defined $value;
if (! defined $value) {
$value = q();
}
if ($this->{InterPolateVars}) {
$value = $this->_interpolate($option, $value);
@@ -892,7 +931,7 @@ sub NoMultiOptions {
# Since we do parsing from within new(), we must
# call it again if one turns NoMultiOptions on!
#
croak "The NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!";
croak q(The NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
}
@@ -912,8 +951,9 @@ sub save {
$this->save_file($one, \%h);
}
else {
croak "The save() method is deprecated. Use the new save_file() method instead!";
croak q(The save() method is deprecated. Use the new save_file() method instead!);
}
return;
}
@@ -922,14 +962,14 @@ sub save_file {
# save the config back to disk
#
my($this, $file, $config) = @_;
my $fh = new FileHandle;
my $fh;
my $config_string;
if (!$file) {
croak "Filename is required!";
}
else {
open $fh, ">$file" or croak "Could not open $file!($!)\n";
$fh = IO::File->new( "$file", 'w') or croak "Could not open $file!($!)\n";
if (!$config) {
if (exists $this->{config}) {
@@ -944,15 +984,16 @@ sub save_file {
}
if ($config_string) {
print $fh $config_string;
print {$fh} $config_string;
}
else {
# empty config for whatever reason, I don't care
print $fh "";
print {$fh} q();
}
close $fh;
}
return;
}
@@ -963,7 +1004,7 @@ sub save_string {
#
my($this, $config) = @_;
if (!$config || ref($config) ne "HASH") {
if (!$config || ref($config) ne 'HASH') {
if (exists $this->{config}) {
return $this->_store(0, %{$this->{config}});
}
@@ -974,6 +1015,7 @@ sub save_string {
else {
return $this->_store(0, %{$config});
}
return;
}
@@ -984,14 +1026,14 @@ sub _store {
#
my($this, $level, %config) = @_;
local $_;
my $indent = " " x $level;
my $indent = q( ) x $level;
my $config_string = "";
my $config_string = q();
foreach my $entry (sort keys %config) {
if (ref($config{$entry}) eq "ARRAY") {
if (ref($config{$entry}) eq 'ARRAY') {
foreach my $line (@{$config{$entry}}) {
if (ref($line) eq "HASH") {
if (ref($line) eq 'HASH') {
$config_string .= $this->_write_hash($level, $entry, $line);
}
else {
@@ -999,7 +1041,7 @@ sub _store {
}
}
}
elsif (ref($config{$entry}) eq "HASH") {
elsif (ref($config{$entry}) eq 'HASH') {
$config_string .= $this->_write_hash($level, $entry, $config{$entry});
}
else {
@@ -1018,18 +1060,18 @@ sub _write_scalar {
#
my($this, $level, $entry, $line) = @_;
my $indent = " " x $level;
my $indent = q( ) x $level;
my $config_string;
if ($line =~ /\n/ || $line =~ /\\$/) {
# it is a here doc
my $delimiter;
my $tmplimiter = "EOF";
my $tmplimiter = 'EOF';
while (!$delimiter) {
# create a unique here-doc identifier
if ($line =~ /$tmplimiter/s) {
$tmplimiter .= "%";
$tmplimiter .= q(%);
}
else {
$delimiter = $tmplimiter;
@@ -1058,17 +1100,17 @@ sub _write_hash {
#
my($this, $level, $entry, $line) = @_;
my $indent = " " x $level;
my $indent = q( ) x $level;
my $config_string;
if ($entry =~ /\s/) {
# quote the entry if it contains whitespaces
$entry = '"' . $entry . '"';
$entry = q(") . $entry . q(");
}
$config_string .= $indent . "<" . $entry . ">\n";
$config_string .= $indent . q(<) . $entry . ">\n";
$config_string .= $this->_store($level + 1, %{$line});
$config_string .= $indent . "</" . $entry . ">\n";
$config_string .= $indent . q(</) . $entry . ">\n";
return $config_string
}
@@ -1080,13 +1122,13 @@ sub _hashref {
#
my($this) = @_;
my ($package, $filename, $line, $subroutine, $hasargs,
$wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(0);
$wantarray, $evaltext, $is_require, $hints, $bitmask) = caller 0;
if ($this->{Tie}) {
eval {
eval "require $this->{Tie}";
eval {require $this->{Tie}};
};
if ($@) {
croak "Could not create a tied hash of type: " . $this->{Tie} . ": " . $@;
if ($EVAL_ERROR) {
croak q(Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR;
}
my %hash;
tie %hash, $this->{Tie};
@@ -1116,16 +1158,17 @@ sub SaveConfig {
my ($file, $hash) = @_;
if (!$file || !$hash) {
croak "SaveConfig(): filename and hash argument required.";
croak q{SaveConfig(): filename and hash argument required.};
}
else {
if (ref($hash) ne "HASH") {
croak "The second parameter must be a reference to a hash!";
if (ref($hash) ne 'HASH') {
croak q(The second parameter must be a reference to a hash!);
}
else {
(new Config::General(-ConfigHash => $hash))->save_file($file);
}
}
return;
}
sub SaveConfigString {
@@ -1136,22 +1179,24 @@ sub SaveConfigString {
my ($hash) = @_;
if (!$hash) {
croak "SaveConfigString(): Hash argument required.";
croak q{SaveConfigString(): Hash argument required.};
}
else {
if (ref($hash) ne "HASH") {
croak "The parameter must be a reference to a hash!";
if (ref($hash) ne 'HASH') {
croak q(The parameter must be a reference to a hash!);
}
else {
return (new Config::General(-ConfigHash => $hash))->save_string();
}
}
return;
}
# keep this one
1;
__END__
@@ -1188,7 +1233,7 @@ In addition to the capabilities of an apache config file it supports some enhanc
C-style comments or multiline options.
=head1 METHODS
=head1 SUBROUTINES/METHODS
=over
@@ -2117,6 +2162,10 @@ which is supplied with the Config::General distribution.
Config::General exports some functions too, which makes it somewhat
easier to use it, if you like this.
How to import the functions:
use Config::General qw(ParseConfig SaveConfig SaveConfigString);
=over
=item B<ParseConfig()>
@@ -2158,6 +2207,9 @@ Example:
=back
=head1 CONFIGURATION AND ENVIRONMENT
No environment variables will be used.
=head1 SEE ALSO
@@ -2171,26 +2223,38 @@ I recommend you to read the following documentations, which are supplied with pe
Config::General::Extended Object oriented interface to parsed configs
Config::General::Interpolated Allows to use variables inside config files
=head1 COPYRIGHT
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2000-2006 Thomas Linden
Copyright (c) 2000-2007 Thomas Linden
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 BUGS AND LIMITATIONS
=head1 BUGS
See rt.cpan.org for current bugs, if any.
none known yet.
=head1 INCOMPATIBILITIES
None known.
=head1 DIAGNOSTICS
To debug Config::General use the perl debugger, see L<perldebug>.
=head1 DEPENDENCIES
Config::General depends on the modules L<FileHandle>,
L<File::Spec::Functions>, L<File::Glob>, which all are
shipped with perl.
=head1 AUTHOR
Thomas Linden <tom@daemon.de>
Thomas Linden <tlinden |AT| cpan.org>
=head1 VERSION
2.31
2.32
=cut

7
General/Extended.pm
View File

@@ -1,7 +1,7 @@
#
# Config::General::Extended - special Class based on Config::General
#
# Copyright (c) 2000-2006 Thomas Linden <tom@daemon.de>.
# Copyright (c) 2000-2007 Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
@@ -576,7 +576,7 @@ values under the given key will be overwritten.
=head1 COPYRIGHT
Copyright (c) 2000-2006 Thomas Linden
Copyright (c) 2000-2007 Thomas Linden
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
@@ -589,8 +589,7 @@ none known yet.
=head1 AUTHOR
Thomas Linden <tom@daemon.de>
Thomas Linden <tlinden |AT| cpan.org>
=head1 VERSION

21
General/Interpolated.pm
View File

@@ -2,7 +2,7 @@
# Config::General::Interpolated - special Class based on Config::General
#
# Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>.
# Copyright (c) 2000-2006 by Thomas Linden <tom@daemon.de>.
# Copyright (c) 2000-2007 by Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
@@ -75,23 +75,26 @@ sub _interpolate {
else {
# incorporate variables outside current scope(block) into
# our scope to make them visible to _interpolate()
foreach my $key (keys %{$this->{stack}->{ $this->{level} - 1}->{ $this->{lastkey} }}) {
$this->{stack}->{ $this->{level} }->{ $this->{prevkey} }->{$key} =
$this->{stack}->{ $this->{level} - 1}->{ $this->{lastkey} }->{$key};
if (! exists $this->{stack}->{ $this->{level} }->{ $this->{prevkey} }->{$key}) {
# only import a variable if it is not re-defined in current scope! (rt.cpan.org bug #20742
$this->{stack}->{ $this->{level} }->{ $this->{prevkey} }->{$key} = $this->{stack}->{ $this->{level} - 1}->{ $this->{lastkey} }->{$key};
}
}
$prevkey = $this->{prevkey};
}
$value =~ s{$this->{regex}}{
my $con = $1;
my $var = $3;
$var = lc($var) if $this->{LowerCaseNames};
if (exists $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var}) {
$con . $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var};
my $var_lc = $this->{LowerCaseNames} ? lc($var) : $var;
if (exists $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var_lc}) {
$con . $this->{stack}->{ $this->{level} }->{ $prevkey }->{$var_lc};
}
elsif ($this->{InterPolateEnv}) {
# may lead to vulnerabilities, by default flag turned off
$con . $ENV{$var};
if (defined($ENV{$var})) {
$con . $ENV{$var};
}
@@ -290,14 +293,14 @@ L<Config::General>
=head1 AUTHORS
Thomas Linden <tom@daemon.de>
Thomas Linden <tlinden |AT| cpan.org>
Autrijus Tang <autrijus@autrijus.org>
Wei-Hon Chen <plasmaball@pchome.com.tw>
=head1 COPYRIGHT
Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
Copyright 2002-2006 by Thomas Linden <tom@daemon.de>.
Copyright 2002-2007 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.

34
MANIFEST
View File

@@ -1,19 +1,19 @@
Changelog
General/Extended.pm
General/Interpolated.pm
General.pm
MANIFEST
Makefile.PL
README
t/sub1/sub2/sub3/cfg.sub3.orig
t/sub1/sub2/sub3/cfg.sub3
t/sub1/sub2/cfg.sub2.orig
t/sub1/sub2/cfg.sub2
t/sub1/sub2/cfg.sub2b.orig
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
t/cfg.16
t/cfg.17
t/cfg.19
t/cfg.20.a
t/cfg.20.b
t/cfg.20.c
t/sub1/sub2/sub3/cfg.sub3
t/sub1/sub2/cfg.sub2
t/sub1/cfg.sub1
t/cfg.2
t/cfg.3
t/cfg.4
@@ -21,6 +21,16 @@ t/cfg.5
t/cfg.6
t/cfg.7
t/cfg.8
t/run.t
t/test.rc
t/cfg.20.a
t/cfg.20.b
t/cfg.20.c
t/run.t
t/test.rc.out
t/cfg.34
MANIFEST
example.cfg
Makefile.PL
General.pm
README
Changelog

4
Makefile.PL
View File

@@ -8,9 +8,9 @@
use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => 'Config::General',
'VERSION_FROM' => 'General.pm', # finds $VERSION
'clean' => { FILES => 't/cfg.out t/test.cfg *~ */*~' },
'clean' => { FILES => 't/*.out t/test.cfg *~ */*~' },
);

8
README
View File

@@ -80,11 +80,11 @@ UPDATE
COPYRIGHT
Config::General
Config::General::Extended
Copyright (c) 2000-2006 by Thomas Linden <tom@daemon.de>
Copyright (c) 2000-2007 by Thomas Linden <tom@daemon.de>
Config::General::Interpolated
Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>
Copyright (c) 2002-2006 by Thomas Linden <tom@daemon.de>.
Copyright (c) 2002-2007 by Thomas Linden <tom@daemon.de>.
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
@@ -100,8 +100,8 @@ BUGS
AUTHOR
Thomas Linden <tom@daemon.de>
Thomas Linden <tlinden |AT| cpan.org>
VERSION
2.31
2.32

6
t/cfg.16
View File

@@ -6,12 +6,12 @@ pr=$me/blubber
uid = 501
</vars>
base = /opt
<etc>
dir = $base/conf # $base should not be interpolated
base = /usr/local # set $base to a new value in this scope
base = /usr # set $base to a new value in this scope
log = ${base}/log/logfile # use braces
<users>
home = $base/home/max # $base should be interpolated
home = $base/home/max # $base should be /usr, not /opt !
</users>
</etc>

18
t/cfg.34 Normal file
View File

@@ -0,0 +1,18 @@
<a>
var1 = yes
var2 = on
var3 = true
var4 = no
var5 = off
var6 = false
</a>
<b>
var1 = Yes
var2 = On
var3 = TRUE
var4 = nO
var5 = oFf
var6 = False
</b>

445
t/run.t
View File

@@ -6,174 +6,142 @@
#
# Under normal circumstances every test should succeed.
BEGIN { $| = 1; print "1..24\n";}
use lib "blib/lib";
use Config::General;
use Data::Dumper;
use Test::More tests => 35;
#use Test::More qw(no_plan);
sub pause;
### 1
BEGIN { use_ok "Config::General"};
require_ok( 'Config::General' );
print "ok\n";
print STDERR " .. ok # loading Config::General\n";
foreach (2..7) {
&p("t/cfg." . $_, $_);
pause;
### 2 - 7
foreach my $num (2..7) {
my $cfg = "t/cfg.$num";
open T, "<$cfg";
my @file = <T>;
close T;
my $fst = $file[0];
chomp $fst;
$fst =~ s/\#\s*//g;
eval {
my $conf = new Config::General($cfg);
my %hash = $conf->getall;
};
ok(!$@, "$fst");
}
### 8
my $conf = new Config::General("t/cfg.8");
my %hash = $conf->getall;
$conf->save_file("t/cfg.out");
my $copy = new Config::General("t/cfg.out");
my %copyhash = $copy->getall;
is_deeply(\%hash, \%copyhash, "Writing Config Hash to disk and compare with original");
my $a = \%hash;
my $b = \%copyhash;
# now see if the saved hash is still the same as the
# one we got from cfg.8
if (&comp($a,$b)) {
print "ok\n";
print STDERR " ... ok # Writing Config Hash to disk and compare with original\n";
}
else {
print "8 not ok\n";
print STDERR "8 ... not ok\n";
}
pause;
############## Extended Tests #################
### 9
$conf = new Config::General(
-ExtendedAccess => 1,
-ConfigFile => "t/test.rc");
print "ok\n";
print STDERR " ... ok # Creating a new object from config file\n";
pause;
-ExtendedAccess => 1,
-ConfigFile => "t/test.rc");
ok($conf, "Creating a new object from config file");
# now test the new notation of new()
### 10
my $conf2 = new Config::General(
-ExtendedAccess => 1,
-ConfigFile => "t/test.rc",
-AllowMultiOptions => "yes"
);
print "ok\n";
print STDERR " ... ok # Creating a new object using the hash parameter way\n";
pause;
-ExtendedAccess => 1,
-ConfigFile => "t/test.rc",
-AllowMultiOptions => "yes"
);
ok($conf2, "Creating a new object using the hash parameter way");
### 11
my $domain = $conf->obj("domain");
print "ok\n";
print STDERR " .. ok # Creating a new object from a block\n";
pause;
ok($domain, "Creating a new object from a block");
### 12
my $addr = $domain->obj("bar.de");
print "ok\n";
print STDERR " .. ok # Creating a new object from a sub block\n";
pause;
ok($addr, "Creating a new object from a sub block");
### 13
my @keys = $conf->keys("domain");
print "ok\n";
print STDERR " .. ok # Getting values from the object\n";
pause;
ok($#keys > -1, "Getting values from the object");
### 14
# test various OO methods
my $a;
if ($conf->is_hash("domain")) {
my $domains = $conf->obj("domain");
foreach my $domain ($conf->keys("domain")) {
my $domain_obj = $domains->obj($domain);
foreach my $address ($domains->keys($domain)) {
my $blah = $domain_obj->value($address);
$a = $domain_obj->value($address);
}
}
}
print "ok\n";
print STDERR " .. ok # Using keys() and values() \n";
pause;
ok($a, "Using keys() and values()");
### 15
# test AUTOLOAD methods
my $conf3 = new Config::General(
-ExtendedAccess => 1,
-ConfigHash => { name => "Moser", prename => "Hannes"}
);
my $n = $conf3->name;
my $p = $conf3->prename;
$conf3->name("Meier");
$conf3->prename("Max");
$conf3->save_file("t/test.cfg");
print "ok\n";
print STDERR " .. ok # Using AUTOLOAD methods\n";
pause;
eval {
my $conf3 = new Config::General(
-ExtendedAccess => 1,
-ConfigHash => { name => "Moser", prename => "Hannes"}
);
my $n = $conf3->name;
my $p = $conf3->prename;
$conf3->name("Meier");
$conf3->prename("Max");
$conf3->save_file("t/test.cfg");
};
ok (!$@, "Using AUTOLOAD methods");
### 16
# testing variable interpolation
my $conf16 = new Config::General(-ConfigFile => "t/cfg.16", -InterPolateVars => 1, -StrictVars => 0);
my %h16 = $conf16->getall();
if($h16{etc}->{log} eq "/usr/local/log/logfile") {
print "ok\n";
print STDERR " .. ok # Testing variable interpolation\n";
if($h16{etc}->{log} eq "/usr/log/logfile" and
$h16{etc}->{users}->{home} eq "/usr/home/max" and
exists $h16{dir}->{teri}->{bl}) {
pass("Testing variable interpolation");
}
else {
print "16 not ok\n";
print STDERR "16 not ok\n";
fail("Testing variable interpolation");
}
pause;
### 17
# testing value pre-setting using a hash
my $conf17 = new Config::General(
-file => "t/cfg.17",
-DefaultConfig => { home => "/exports/home", logs => "/var/backlog" },
-MergeDuplicateOptions => 1,
-MergeDuplicateBlocks => 1
);
-file => "t/cfg.17",
-DefaultConfig => { home => "/exports/home", logs => "/var/backlog" },
-MergeDuplicateOptions => 1,
-MergeDuplicateBlocks => 1
);
my %h17 = $conf17->getall();
if ($h17{home} eq "/home/users") {
print "ok\n";
print STDERR " .. ok # Testing value pre-setting using a hash\n";
}
else {
print "17 not ok\n";
print STDERR "17 not ok\n";
}
pause;
ok ($h17{home} eq "/home/users", "Testing value pre-setting using a hash");
### 18
# testing value pre-setting using a string
my $conf18 = new Config::General(
-file => "t/cfg.17", # reuse the file
-DefaultConfig => "home = /exports/home\nlogs = /var/backlog",
-MergeDuplicateOptions => 1,
-MergeDuplicateBlocks => 1
);
-file => "t/cfg.17", # reuse the file
-DefaultConfig => "home = /exports/home\nlogs = /var/backlog",
-MergeDuplicateOptions => 1,
-MergeDuplicateBlocks => 1
);
my %h18 = $conf18->getall();
if ($h18{home} eq "/home/users") {
print "ok\n";
print STDERR " .. ok # Testing value pre-setting using a string\n";
}
else {
print "18 not ok\n";
print STDERR "18 not ok\n";
}
pause;
ok ($h18{home} eq "/home/users", "Testing value pre-setting using a string");
### 19
# testing various otion/value assignment notations
my $conf19 = new Config::General(-file => "t/cfg.19");
my %h19 = $conf19->getall();
@@ -183,51 +151,26 @@ foreach my $key (keys %h19) {
$works = 0;
}
}
if ($works) {
print "ok\n";
print STDERR " .. ok # Testing various otion/value assignment notations\n";
}
else {
print "19 not ok\n";
print STDERR "19 not ok\n";
}
pause;
ok ($works, "Testing various otion/value assignment notations");
### 20
# testing files() method
my $conf20 = Config::General->new(
-file => "t/cfg.20.a",
-MergeDuplicateOptions => 1
);
my %h20 = $conf20->getall();
my %expected_h20 = (
'seen_cfg.20.a' => 'true',
'seen_cfg.20.b' => 'true',
'seen_cfg.20.c' => 'true',
'last' => 'cfg.20.c',
);
my %files = map { $_ => 1 } $conf20->files();
my %expected_files = map { $_ => 1 } (
't/cfg.20.a',
't/cfg.20.b',
't/cfg.20.c',
);
is_deeply (\%files, \%expected_files, "testing files() method");
if (&comp(\%h20, \%expected_h20) and &comp(\%files, \%expected_files)) {
print "ok\n";
print STDERR " .. ok # testing files() method\n";
}
else {
print "20 not ok\n";
print STDERR "20 not ok\n";
}
pause;
### 22
# testing improved IncludeRelative option
# First try without -IncludeRelative
# this should fail
eval {
@@ -236,25 +179,17 @@ eval {
-MergeDuplicateOptions => 1,
);
};
if ($@) {
print "ok\n";
print STDERR " .. ok # prevented from loading relative cfgs without -IncludeRelative\n";
}
else {
print "21 not ok\n";
print STDERR "21 not ok\n";
}
pause;
ok ($@, "prevented from loading relative cfgs without -IncludeRelative");
### 23
# Now try with -IncludeRelative
# this should fail
my $conf22 = Config::General->new(
-file => "t/sub1/sub2/sub3/cfg.sub3",
-MergeDuplicateOptions => 1,
-IncludeRelative => 1,
);
my %h22 = $conf22->getall;
my %expected_h22 = (
'sub3_seen' => 'yup',
@@ -264,24 +199,15 @@ my %expected_h22 = (
'sub1b_seen' => 'yup',
'fruit' => 'mango',
);
is_deeply(\%h22, \%expected_h22, "loaded relative to included files");
if (&comp(\%h22, \%expected_h22)) {
print "ok\n";
print STDERR " .. ok # loaded relative to included files\n";
}
else {
print "22 not ok\n";
print STDERR "22 not ok\n";
}
pause;
### 24
# Testing IncludeDirectories option
my $conf23 = Config::General->new(
-String => "<<include t/sub1>>",
-IncludeDirectories => 1
);
my %h23 = $conf23->getall;
my %expected_h23 = (
fruit => 'mango',
@@ -291,45 +217,26 @@ my %expected_h23 = (
test2 => 'value2',
test3 => 'value3'
);
if (&comp(\%h23, \%expected_h23)) {
print "ok\n";
print STDERR " .. ok # including a directory with -IncludeDirectories\n";
}
else {
print "23 not ok\n";
print STDERR "23 not ok\n";
}
pause;
is_deeply(\%h23, \%expected_h23, "including a directory with -IncludeDirectories");
### 24
# Testing IncludeGlob option
my $conf24 = Config::General->new(
-String => "<<include t/sub1/cfg.sub[123]{c,d,e}>>",
-IncludeGlob => 1
);
my %h24 = $conf24->getall;
my %expected_h24 = (
test => 'value',
test2 => 'value2',
test3 => 'value3'
);
if (&comp(\%h24, \%expected_h24)) {
print "ok\n";
print STDERR " .. ok # including multiple files via glob pattern with -IncludeGlob\n";
}
else {
print "24 not ok\n";
print STDERR "24 not ok\n";
}
pause;
is_deeply(\%h24, \%expected_h24, "including multiple files via glob pattern with -IncludeGlob");
### 25
# Testing block and block name quoting
my $conf25 = Config::General->new(
-String => <<TEST,
<block "/">
@@ -348,66 +255,142 @@ TEST
-SlashIsDirectory => 1
);
my %h25 = $conf25->getall;
my %expected_h25 = (
block => { '/' => { opt1 => 'val1' } },
'block2 /' => { opt2 => 'val2' },
'block 3' => { '/' => { opt3 => 'val3' } },
block4 => { '/' => { opt4 => 'val4' } }
);
is_deeply(\%h25, \%expected_h25, "block and block name quoting");
if (&comp(\%h25, \%expected_h25)) {
print "ok\n";
print STDERR " .. ok # block and block name quoting\n";
}
else {
print "25 not ok\n";
print STDERR "25 not ok\n";
}
pause;
### 26
# Testing 0-value handling
my $conf26 = Config::General->new(
-String => <<TEST,
<foo 0>
0
</foo>
TEST
);
my %h26 = $conf26->getall;
my %expected_h26 = (
foo => { 0 => { 0 => '' } },
);
is_deeply(\%h26, \%expected_h26, "testing 0-values in block names");
#
# look if invalid input gets rejected right
#
# all subs here
sub p {
my($cfg, $t) = @_;
open T, "<$cfg";
my @file = <T>;
close T;
@file = map { chomp($_); $_} @file;
my $fst = $file[0];
my $conf = new Config::General($cfg);
my %hash = $conf->getall;
print "ok\n";
print STDERR " ... ok $fst\n";
### 27
# testing invalid parameter calls, expected to fail
my @pt = (
{
p => {-ConfigHash => "StringNotHash"},
t => "-ConfigHash HASH required"
},
{
p => {-String => {}},
t => "-String STRING required"
},
{
p => {-ConfigFile => {}},
t => "-ConfigFile STRING required"
},
{
p => {-ConfigFile => "NoFile"},
t => "-ConfigFile STRING File must exist and be readable"
}
);
foreach my $C (@pt) {
eval {
my $cfg = new Config::General(%{$C->{p}});
};
ok ($@, "check parameter failure handling $C->{t}");
}
sub comp {
my($a, $b) = @_;
my %keys = map { $_ => 1 } keys %$a, keys %$b;
foreach my $key (keys %keys) {
return 0 unless exists $a->{$key} and exists $b->{$key};
if(ref($a->{$key}) eq "HASH") {
return 0 unless &comp($a->{$key},$b->{$key});
next;
### 32
# check Flagbits
my $cfg28 = new Config::General(
-String => "Mode = CLEAR | UNSECURE",
-FlagBits => {
Mode => {
CLEAR => 1,
STRONG => 1,
UNSECURE => "32bit"
}
elsif(ref($a->{$key}) eq "ARRAY") {
# ignore arrays for simplicity
next;
}
return 0 if($a->{$key} ne $b->{$key});
} );
my %cfg28 = $cfg28->getall();
is_deeply(\%cfg28,
{
'Mode' => {
'STRONG' => undef,
'UNSECURE' => '32bit',
'CLEAR' => 1
}}, "Checking -Flagbits resolving");
### 33
# checking functional interface
eval {
my %conf = Config::General::ParseConfig(-ConfigFile => "t/test.rc");
Config::General::SaveConfig("t/test.rc.out", \%conf);
my %next = Config::General::ParseConfig(-ConfigFile => "t/test.rc.out");
my @a = sort keys %conf;
my @b = sort keys %next;
if (@a != @b) {
die "Re-parsed result differs from original";
}
return 1;
}
};
ok(! $@, "Testing functional interface $@");
sub pause {
# we are pausing between tests
# so the output gets not confused
# by stderr/stdout "collisions"
select undef, undef, undef, 0.3;
}
### 34
# testing -AutoTrue
my $cfg34 = new Config::General(-AutoTrue => 1, -ConfigFile => "t/cfg.34");
my %cfg34 = $cfg34->getall();
my %expect34 = (
'a' => {
'var6' => 0,
'var3' => 1,
'var1' => 1,
'var4' => 0,
'var2' => 1,
'var5' => 0
},
'b' => {
'var6' => 0,
'var3' => 1,
'var1' => 1,
'var4' => 0,
'var2' => 1,
'var5' => 0
}
);
is_deeply(\%cfg34, \%expect34, "Using -AutoTrue");
### 35
# testing -SplitPolicy
my %conf35 = Config::General::ParseConfig(
-String =>
qq(var1 :: alpha
var2 :: beta
var3 = gamma # use wrong delimiter by purpose),
-SplitPolicy => 'custom',
-SplitDelimiter => '\s*::\s*'
);
my %expect35 = (
'var3 = gamma' => '',
'var1' => 'alpha',
'var2' => 'beta'
);
is_deeply(\%conf35, \%expect35, "Using -SplitPolicy and custom -SplitDelimiter");

1
t/sub1/cfg.sub1b Normal file
View File

@@ -0,0 +1 @@
sub1b_seen = yup

1
t/sub1/cfg.sub1c Normal file
View File

@@ -0,0 +1 @@
test value

1
t/sub1/cfg.sub1d Normal file
View File

@@ -0,0 +1 @@
test2 value2

1
t/sub1/cfg.sub1e Normal file
View File

@@ -0,0 +1 @@
test3 value3

1
t/sub1/sub2/cfg.sub2b Normal file
View File

@@ -0,0 +1 @@
sub2b_seen = yup