From c3eced799c90c3c9b8c43434858d3d5a4c43c5b3 Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Sat, 10 Oct 2009 16:19:00 +0000 Subject: [PATCH] 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 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 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 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 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 --- Changelog | 34 ++++++++ General.pm | 195 ++++++++++++++++++++++++++------------------ General/Extended.pm | 11 ++- README | 2 +- t/cfg.17 | 1 + t/run.t | 46 ++++++++++- 6 files changed, 205 insertions(+), 84 deletions(-) create mode 100644 t/cfg.17 diff --git a/Changelog b/Changelog index 1aa1edb..0d151c9 100644 --- a/Changelog +++ b/Changelog @@ -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 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 + 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 + 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 + 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 diff --git a/General.pm b/General.pm index 47be2f6..57a7572 100644 --- a/General.pm +++ b/General.pm @@ -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 - 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 =head1 VERSION -1.35 +1.36 =cut diff --git a/General/Extended.pm b/General/Extended.pm index f41a811..9b5c4c3 100644 --- a/General/Extended.pm +++ b/General/Extended.pm @@ -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 loops as seen in an example above(obj() ). @@ -517,7 +522,7 @@ Thomas Linden =head1 VERSION -1.4 +1.5 =cut diff --git a/README b/README index 0cc801f..b484453 100644 --- a/README +++ b/README @@ -65,4 +65,4 @@ AUTHOR VERSION - 1.35 + 1.36 diff --git a/t/cfg.17 b/t/cfg.17 new file mode 100644 index 0000000..785764e --- /dev/null +++ b/t/cfg.17 @@ -0,0 +1 @@ +home = /home/users diff --git a/t/run.t b/t/run.t index 6ad0a81..7ccc73c 100644 --- a/t/run.t +++ b/t/run.t @@ -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";