From 72fdf51f16301f01ff92cde24bb9a5ca60ffd942 Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Sat, 10 Oct 2009 16:38:28 +0000 Subject: [PATCH] 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. git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@58 be1acefe-a474-0410-9a34-9b3221f2030f --- Changelog | 23 +++ General.pm | 292 ++++++++++++++++---------- General/Extended.pm | 7 +- General/Interpolated.pm | 21 +- MANIFEST | 34 +-- Makefile.PL | 4 +- README | 8 +- t/cfg.16 | 6 +- t/cfg.34 | 18 ++ t/run.t | 445 +++++++++++++++++++--------------------- t/sub1/cfg.sub1b | 1 + t/sub1/cfg.sub1c | 1 + t/sub1/cfg.sub1d | 1 + t/sub1/cfg.sub1e | 1 + t/sub1/sub2/cfg.sub2b | 1 + 15 files changed, 484 insertions(+), 379 deletions(-) create mode 100644 t/cfg.34 create mode 100644 t/sub1/cfg.sub1b create mode 100644 t/sub1/cfg.sub1c create mode 100644 t/sub1/cfg.sub1d create mode 100644 t/sub1/cfg.sub1e create mode 100644 t/sub1/sub2/cfg.sub2b diff --git a/Changelog b/Changelog index 7ff0905..1389848 100644 --- a/Changelog +++ b/Changelog @@ -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 : o bugfix: multiple levels if include files didn't diff --git a/General.pm b/General.pm index 52ab755..14a87bd 100644 --- a/General.pm +++ b/General.pm @@ -5,17 +5,22 @@ # config values from a given file and # return it as hash structure # -# Copyright (c) 2000-2006 Thomas Linden . +# Copyright (c) 2000-2007 Thomas Linden . # 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 "¶" to the here-doc-name, so + $hier .= ' ' . chr 182; # append a "¶" 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} ? '(?{BackslashEscape} ? '(?{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); # ¶, inserted by _open, our here-doc indicator + my $indichar = chr 182; # ¶, 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 . "\n"; + $config_string .= $indent . q(\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 @@ -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. + +=head1 DEPENDENCIES + +Config::General depends on the modules L, +L, L, which all are +shipped with perl. =head1 AUTHOR -Thomas Linden - +Thomas Linden =head1 VERSION -2.31 +2.32 =cut diff --git a/General/Extended.pm b/General/Extended.pm index 2772563..938a9f3 100644 --- a/General/Extended.pm +++ b/General/Extended.pm @@ -1,7 +1,7 @@ # # Config::General::Extended - special Class based on Config::General # -# Copyright (c) 2000-2006 Thomas Linden . +# Copyright (c) 2000-2007 Thomas Linden . # 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 - +Thomas Linden =head1 VERSION diff --git a/General/Interpolated.pm b/General/Interpolated.pm index 103e23d..5a58658 100644 --- a/General/Interpolated.pm +++ b/General/Interpolated.pm @@ -2,7 +2,7 @@ # Config::General::Interpolated - special Class based on Config::General # # Copyright (c) 2001 by Wei-Hon Chen . -# Copyright (c) 2000-2006 by Thomas Linden . +# Copyright (c) 2000-2007 by Thomas Linden . # 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 =head1 AUTHORS - Thomas Linden + Thomas Linden Autrijus Tang Wei-Hon Chen =head1 COPYRIGHT Copyright 2001 by Wei-Hon Chen Eplasmaball@pchome.com.twE. -Copyright 2002-2006 by Thomas Linden . +Copyright 2002-2007 by Thomas Linden . This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/MANIFEST b/MANIFEST index f08c7fb..f094e1f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -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 diff --git a/Makefile.PL b/Makefile.PL index e214c9f..1796d91 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -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 *~ */*~' }, ); + diff --git a/README b/README index ea5c6a4..c2e8298 100644 --- a/README +++ b/README @@ -80,11 +80,11 @@ UPDATE COPYRIGHT Config::General Config::General::Extended - Copyright (c) 2000-2006 by Thomas Linden + Copyright (c) 2000-2007 by Thomas Linden Config::General::Interpolated Copyright (c) 2001 by Wei-Hon Chen - Copyright (c) 2002-2006 by Thomas Linden . + Copyright (c) 2002-2007 by Thomas Linden . 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 + Thomas Linden VERSION - 2.31 + 2.32 diff --git a/t/cfg.16 b/t/cfg.16 index d515907..50ef74d 100644 --- a/t/cfg.16 +++ b/t/cfg.16 @@ -6,12 +6,12 @@ pr=$me/blubber uid = 501 +base = /opt - 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 - home = $base/home/max # $base should be interpolated + home = $base/home/max # $base should be /usr, not /opt ! diff --git a/t/cfg.34 b/t/cfg.34 new file mode 100644 index 0000000..2975171 --- /dev/null +++ b/t/cfg.34 @@ -0,0 +1,18 @@ + + var1 = yes + var2 = on + var3 = true + var4 = no + var5 = off + var6 = false + + + + var1 = Yes + var2 = On + var3 = TRUE + var4 = nO + var5 = oFf + var6 = False + + diff --git a/t/run.t b/t/run.t index c52d1a1..21f9223 100644 --- a/t/run.t +++ b/t/run.t @@ -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 = ; + 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 => "<>", -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 => "<>", -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 => < @@ -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 => < + 0 + +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 = ; - 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"); diff --git a/t/sub1/cfg.sub1b b/t/sub1/cfg.sub1b new file mode 100644 index 0000000..94f7565 --- /dev/null +++ b/t/sub1/cfg.sub1b @@ -0,0 +1 @@ +sub1b_seen = yup diff --git a/t/sub1/cfg.sub1c b/t/sub1/cfg.sub1c new file mode 100644 index 0000000..743c4f2 --- /dev/null +++ b/t/sub1/cfg.sub1c @@ -0,0 +1 @@ +test value diff --git a/t/sub1/cfg.sub1d b/t/sub1/cfg.sub1d new file mode 100644 index 0000000..c1344de --- /dev/null +++ b/t/sub1/cfg.sub1d @@ -0,0 +1 @@ +test2 value2 diff --git a/t/sub1/cfg.sub1e b/t/sub1/cfg.sub1e new file mode 100644 index 0000000..ff90bc8 --- /dev/null +++ b/t/sub1/cfg.sub1e @@ -0,0 +1 @@ +test3 value3 diff --git a/t/sub1/sub2/cfg.sub2b b/t/sub1/sub2/cfg.sub2b new file mode 100644 index 0000000..55a7b93 --- /dev/null +++ b/t/sub1/sub2/cfg.sub2b @@ -0,0 +1 @@ +sub2b_seen = yup