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

1.36 - simplified new() parameter parsing, should be now a little

Browse Source 
bit better to understand.

	 - added new parameter -DefaultConfig, which can hold a hashref
	   or a string, which will be used to pre-define values
	   of the resulting hash after parsing a config.
	   Thanks to Mark Hampton <mark.hampton@qualis.com> for the
	   suggestion.

	 - added new parameter -MergeDuplicateOptions, which allows
	   one to overwrite duplicate options, which is required,
	   if you turn on -DefaultConfig, because otherwise a
 	   array would be created, which is probably not what you
	   wanted.

	 - added patch by Danial Pearce <danial@infoxchange.net.au>
	   to Config::General::Extended::keys(), which allows to
	   retrieve the keys of the object itself (which was not
	   directly possible before)

	 - added patch by Danial Pearce <danial@infoxchange.net.au>
	   to Config::General::Extended::value(), which allows to
	   set a value to a (perlish-) nontrue value. This was a
	   bug.

	 - added patch by Danial Pearce <danial@infoxchange.net.au>
	   to Config::General::_parse_value, which fixes a bug in
	   this method, which in prior versions caused values of
	   "0" (zero digit) to be wiped out of the config.

	 - added tests in t/run.t for the new default config feature.


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@25 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:19:00 +00:00
parent cbe885c7b9
commit c3eced799c
6 changed files with 205 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
Changelog
View File

@@ -1,3 +1,37 @@
1.36 - simplified new() parameter parsing, should be now a little
bit better to understand.
- added new parameter -DefaultConfig, which can hold a hashref
or a string, which will be used to pre-define values
of the resulting hash after parsing a config.
Thanks to Mark Hampton <mark.hampton@qualis.com> for the
suggestion.
- added new parameter -MergeDuplicateOptions, which allows
one to overwrite duplicate options, which is required,
if you turn on -DefaultConfig, because otherwise a
array would be created, which is probably not what you
wanted.
- added patch by Danial Pearce <danial@infoxchange.net.au>
to Config::General::Extended::keys(), which allows to
retrieve the keys of the object itself (which was not
directly possible before)
- added patch by Danial Pearce <danial@infoxchange.net.au>
to Config::General::Extended::value(), which allows to
set a value to a (perlish-) nontrue value. This was a
bug.
- added patch by Danial Pearce <danial@infoxchange.net.au>
to Config::General::_parse_value, which fixes a bug in
this method, which in prior versions caused values of
"0" (zero digit) to be wiped out of the config.
- added tests in t/run.t for the new default config feature.
1.35 - the here-doc identifier in saved configs will now created
in a way which avoids the existence of this identifier
inside the here-doc, which if it happens results in

195
General.pm
View File

@@ -17,7 +17,7 @@ use strict;
use Carp;
use Exporter;
$Config::General::VERSION = "1.35";
$Config::General::VERSION = "1.36";
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@@ -30,10 +30,35 @@ sub new {
my($this, @param ) = @_;
my($configfile);
my $class = ref($this) || $this;
my $self = {};
# define default options
my $self = {
AllowMultiOptions => 1,
MergeDuplicateOptions => 0,
MergeDuplicateBlocks => 0,
LowerCaseNames => 0,
UseApacheInclude => 0,
IncludeRelative => 0,
AutoTrue => 0,
AutoTrueFlags => {
true => '^(on|yes|true|1)$',
false => '^(off|no|false|0)$',
},
DefaultConfig => {},
level => 1,
};
# create the class instance
bless($self,$class);
$self->{level} = 1;
if ($#param >= 1) {
# use of the new hash interface!
@@ -41,84 +66,74 @@ sub new {
$configfile = delete $conf{-file} if(exists $conf{-file});
$configfile = delete $conf{-hash} if(exists $conf{-hash});
if (exists $conf{-AllowMultiOptions} ) {
if ($conf{-AllowMultiOptions} =~ /^no$/) {
$self->{NoMultiOptions} = 1;
delete $conf{-AllowMultiOptions};
}
else {
delete $conf{-AllowMultiOptions};
}
}
# handle options which contains values we are needing (strings, hashrefs or the like)
if (exists $conf{-String} ) {
if ($conf{-String}) {
$self->{StringContent} = $conf{-String};
delete $conf{-String};
}
}
if (exists $conf{-LowerCaseNames}) {
if ($conf{-LowerCaseNames}) {
$self->{LowerCaseNames} = 1;
delete $conf{-LowerCaseNames};
}
}
if (exists $conf{-IncludeRelative}) {
if ($conf{-IncludeRelative}) {
$self->{IncludeRelative} = 1;
delete $conf{-IncludeRelative};
}
}
# contributed by Thomas Klausner <domm@zsi.at>
if (exists $conf{-UseApacheInclude}) {
if ($conf{-UseApacheInclude}) {
$self->{UseApacheInclude} = 1;
delete $conf{-UseApacheInclude};
}
}
if (exists $conf{-MergeDuplicateBlocks}) {
if ($conf{-MergeDuplicateBlocks}) {
$self->{MergeDuplicateBlocks} = 1;
delete $conf{-MergeDuplicateBlocks};
}
}
if (exists $conf{-AutoTrue}) {
if ($conf{-AutoTrue}) {
$self->{AutoTrue} = 1;
$self->{AutoTrueFlags} = {
true => '^(on|yes|true|1)$',
false => '^(off|no|false|0)$',
};
delete $conf{-AutoTrue};
}
delete $conf{-String};
}
if (exists $conf{-FlagBits}) {
if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq "HASH") {
$self->{FlagBits} = 1;
$self->{FlagBitsFlags} = $conf{-FlagBits};
delete $conf{-FlagBits};
}
delete $conf{-FlagBits};
}
if (exists $conf{-DefaultConfig}) {
if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq "HASH") {
$self->{DefaultConfig} = $conf{-DefaultConfig};
}
elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq "") {
$self->_read($conf{-DefaultConfig}, "SCALAR");
$self->{DefaultConfig} = $self->_parse({}, $self->{content});
$self->{content} = ();
}
delete $conf{-DefaultConfig};
}
# handle options which may either be true or false
# allowing "human" logic about what is true and what is not
foreach my $entry (keys %conf) {
my $key = $entry;
$key =~ s/^\-//;
if (! exists $self->{$key}) {
croak "Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n";
}
if ($conf{$entry} =~ /$self->{AutoTrueFlags}->{true}/io) {
$self->{$key} = 1;
}
elsif ($conf{$entry} =~ /$self->{AutoTrueFlags}->{false}/io) {
$self->{$key} = 0;
}
}
if (%conf) {
croak "Unknown parameter(s): " . (join ", ", (keys %conf) ) . "\n";
if ($self->{MergeDuplicateOptions}) {
# override
$self->{AllowMultiOptions} = 0;
}
}
elsif ($#param == 0) {
# use of the old style
$configfile = $param[0];
}
else {
# this happens if $#param == -1, thus no param was given to new!
# this happens if $#param == -1,1 thus no param was given to new!
$self->{config} = {};
return $self;
}
### use Data::Dumper; print Dumper($self); exit;
# process as usual
if (exists $self->{StringContent}) {
# consider the supplied string as config file
$self->_read($self->{StringContent}, "SCALAR");
$self->{config} = $self->_parse({}, $self->{content});
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
elsif (ref($configfile) eq "HASH") {
# initialize with given hash
@@ -128,16 +143,16 @@ sub new {
elsif (ref($configfile) eq "GLOB") {
# use the file the glob points to
$self->_read($configfile);
$self->{config} = $self->_parse({}, $self->{content});
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
else {
# open the file and read the contents in
$self->{configfile} = $configfile;
# look if is is an absolute path and save the basename if it is
# look if is is an absolute path and save the basename if it is absolute
($self->{configpath}) = $configfile =~ /^(\/.*)\//;
$self->_open($self->{configfile});
# now, we parse immdediately, getall simply returns the whole hash
$self->{config} = $self->_parse({}, $self->{content});
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
return $self;
@@ -184,7 +199,7 @@ sub _read {
@stuff = @{$fh};
}
else {
@stuff = join "\n", $fh;
@stuff = split "\n", $fh;
}
}
else {
@@ -323,25 +338,29 @@ sub _parse {
}
else { # insert key/value pair into actual node
$option = lc($option) if $this->{LowerCaseNames};
if ($this->{NoMultiOptions}) { # configurable via special method ::NoMultiOptions()
if (exists $config->{$option}) {
croak "Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
}
$config->{$option} = $this->_parse_value($option, $value);
}
else {
if (exists $config->{$option}) { # value exists more than once, make it an array
if (ref($config->{$option}) ne "ARRAY") { # convert scalar to array
my $savevalue = $config->{$option};
delete $config->{$option};
push @{$config->{$option}}, $savevalue;
}
push @{$config->{$option}}, $this->_parse_value($option, $value); # it's already an array, just push
if (exists $config->{$option}) {
if ($this->{MergeDuplicateOptions}) {
$config->{$option} = $this->_parse_value($option, $value);
}
else {
$config->{$option} = $this->_parse_value($option, $value); # standard config option, insert key/value pair into node
if (! $this->{AllowMultiOptions} ) {
# no, duplicates not allowed
croak "Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
}
else {
# yes, duplicates allowed
if (ref($config->{$option}) ne "ARRAY") { # convert scalar to array
my $savevalue = $config->{$option};
delete $config->{$option};
push @{$config->{$option}}, $savevalue;
}
push @{$config->{$option}}, $this->_parse_value($option, $value); # it's already an array, just push
}
}
}
else {
$config->{$option} = $this->_parse_value($option, $value); # standard config option, insert key/value pair into node
}
}
}
elsif (/^<([^\/]+?.*?)>$/) { # found a start block inside a block, don't forget it
@@ -356,7 +375,7 @@ sub _parse {
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 (exists $config->{$block}->{$blockname}) { # the named block already exists, make it an array
if ($this->{NoMultiOptions}) {
if (! $this->{AllowMultiOptions}) {
croak "Named block \"<$block $blockname>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
}
else {
@@ -386,7 +405,7 @@ sub _parse {
}
else { # standard block
if (exists $config->{$block}) { # the block already exists, make it an array
if ($this->{NoMultiOptions}) {
if (! $this->{AllowMultiOptions}) {
croak "Block \"<$block>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
}
else {
@@ -446,7 +465,7 @@ sub _parse_value {
my($this, $option, $value) =@_;
# avoid "Use of uninitialized value"
$value ||= "";
$value = '' unless defined $value;
# make true/false values to 1 or 0 (-AutoTrue)
if ($this->{AutoTrue}) {
@@ -483,12 +502,12 @@ sub _parse_value {
sub NoMultiOptions {
#
# turn NoMultiOptions off, still exists for backward compatibility.
# turn AllowMultiOptions off, still exists for backward compatibility.
# Since we do parsing from within new(), we must
# call it again if one turns NoMultiOptions on!
#
my($this) = @_;
$this->{NoMultiOptions} = 1;
$this->{AllowMultiOptions} = 0;
$this->{config} = $this->_parse({}, $this->{content});
}
@@ -853,6 +872,15 @@ The default behavior of Config::General is to create an array if some junk in a
config appears more than once.
=item B<-MergeDuplicateOptions>
If set to a true value, then duplicate options will be merged. That means, if the
same option occurs more than once, the last one will be used in the resulting
config hash.
Setting this option implies B<-AllowMultiOptions == false>.
=item B<-AutoTrue>
If set to a true value, then options in your config file, whose values are set to
@@ -943,6 +971,15 @@ would result in this hash structure:
"BLAH" will be ignored silently.
=item B<-DefaultConfig>
This can be a hash reference or a simple scalar (string) of a config. This
causes the module to preset the resulting config hash with the given values,
which allows you to set default values for particular config options directly.
=back
=item NoMultiOptions()
@@ -1477,7 +1514,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
1.35
1.36
=cut

11
General/Extended.pm
View File

@@ -22,7 +22,7 @@ use vars qw(@ISA);
use strict;
$Config::General::Extended::VERSION = "1.4";
$Config::General::Extended::VERSION = "1.5";
sub obj {
@@ -52,7 +52,7 @@ sub value {
# this can be a hashref or a scalar
#
my($this, $key, $value) = @_;
if ($value) {
if (defined $value) {
$this->{config}->{$key} = $value;
}
else {
@@ -157,6 +157,9 @@ sub keys {
if (exists $this->{config}->{$key} && ref($this->{config}->{$key}) eq "HASH") {
return map { $_ } keys %{$this->{config}->{$key}};
}
elsif (!$key) {
return map { $_ } keys %{$this->{config}};
}
else {
return ();
}
@@ -451,6 +454,8 @@ config above you yould do that:
print Dumper($conf->keys("individual");
$VAR1 = [ "martin", "joseph" ];
If no key name was supplied, then the keys of the object itself will be returned.
You can use this method in B<foreach> loops as seen in an example above(obj() ).
@@ -517,7 +522,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
1.4
1.5
=cut

2
README
View File

@@ -65,4 +65,4 @@ AUTHOR
VERSION
1.35
1.36

1
t/cfg.17 Normal file
View File

@@ -0,0 +1 @@
home = /home/users

46
t/run.t
View File

@@ -6,7 +6,7 @@
#
# Under normal circumstances every test should succeed.
BEGIN { $| = 1; print "1..16\n";}
BEGIN { $| = 1; print "1..18\n";}
use lib "blib/lib";
use Config::General;
use Config::General::Extended;
@@ -129,6 +129,50 @@ else {
# 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
);
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";
}
# 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
);
my %h18 = $conf18->getall();
if ($h18{home} eq "/home/users") {
print "ok\n";
print STDERR " .. ok # Testing value pre-setting using a hash\n";
}
else {
print "18 not ok\n";
print STDERR "18 not ok\n";
}
# all subs here
sub p {
my($cfg, $t) = @_;
open T, "<$cfg";