From e690b33942b68f4aeade37eee20fc6ed9db2130c Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Wed, 3 Jul 2013 08:37:11 +0000 Subject: [PATCH] => 2.52, see changelog git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@96 be1acefe-a474-0410-9a34-9b3221f2030f --- Changelog | 33 ++++- General.pm | 278 ++++++++++++++++++++++++++++++---------- General/Extended.pm | 33 ++--- General/Interpolated.pm | 13 +- Makefile.PL | 2 +- t/cfg.8 | 4 + t/run.t | 4 +- 7 files changed, 258 insertions(+), 109 deletions(-) diff --git a/Changelog b/Changelog index 322c4ca..eb6e90b 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,26 @@ + 2.52 - applied pod patch rt.cpan.org#79603 + + - fixed rt.cpan.org#80006, it tolerates now whitespaces + after the block closing > + + - added -Plug parameter, which introduces plugin closures. + idea from rt.cpan.org#79694. + Currently available hooks are: + pre_open, pre_read, post_read, pre_parse_value, post_parse_value + + - applied patch by Ville Skyttä, spelling fixes. + + - fixed rt.cpan.org#85080, more spelling fixes. + + - applied patch rt.cpan.org#85132, which fixes a deprecation + warning in perl 5.18 and above. Fixes #85668 as well. + + - applied patch rt.cpan.org#85538, c-style comments + are ignored inside here-docs. + + - fixed rt.cpan.org#82637, don't use indirect object syntax + in pod and code. + 2.51 - fixed rt.cpan.org#77667 which resulted in invalid configs written to file when using save_file() and a named block, whose 2nd part starts with a /. @@ -81,7 +104,7 @@ configuration variable EOFseparator, which contains a 256 bit SHA checksum of the date I fixed the bug. This will prevent future conflicts hopefully. In addition - it makes it possible to make it customizable, if neccessary, + it makes it possible to make it customizable, if necessary, in a future release. - fixed rt.cpan.org#42721, return undef for empty values @@ -583,7 +606,7 @@ know, perl hashes doesn't preserve the order. So, in our case the module sometimes was unable to resolve variablenames, because they were stored - in a different location as it occured in the config. + in a different location as it occurred in the config. The change is, that Config::General now calls ::Interpolate.pm (new sub: _interpolate()) itself directly on a per-key/value pair basis. The internal @@ -618,7 +641,7 @@ same config as their parents. 2.08 - added option -StrictVars, which causes Interpolate.pm to - ignore undefined variables and replaces such occurences + ignore undefined variables and replaces such occurrences with the emppty string. - applied patch by Stefan Moser , which fixes @@ -673,7 +696,7 @@ -ConfigFile parameter. This makes it possible to use locking. 2.05 - fixed bug in ::Extended. It exported for some weird - reason I cant remember all of its methods. This included + reason I can't remember all of its methods. This included keys() exists() and delete(), which are perl internals. If one used keys() on a normal hash, then the ::Extended own keys() were used instead of perls own one. I removed @@ -898,7 +921,7 @@ 1.24: - AllowMultiOptions printed out the value and not the option itself, if more than one of this particular - option occured. + option occurred. - added -UseApacheInclude feature, contributed by Thomas Klausner - fixed bug with multiple options stuff, which did not diff --git a/General.pm b/General.pm index 95b1262..36260bf 100644 --- a/General.pm +++ b/General.pm @@ -5,7 +5,7 @@ # config values from a given file and # return it as hash structure # -# Copyright (c) 2000-2012 Thomas Linden . +# Copyright (c) 2000-2013 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artistic License, same as perl itself. Have fun. # @@ -25,14 +25,14 @@ use File::Glob qw/:glob/; # 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, # I really don't understand, what the hell they made, but the debian perl -# installation is definetly bullshit, damn! +# installation is definitely bullshit, damn! use Carp::Heavy; use Carp; use Exporter; -$Config::General::VERSION = "2.51"; +$Config::General::VERSION = "2.52"; use vars qw(@ISA @EXPORT_OK); use base qw(Exporter); @@ -93,6 +93,7 @@ sub new { NormalizeBlock => 0, NormalizeOption => 0, NormalizeValue => 0, + Plug => {} }; # create the class instance @@ -118,7 +119,7 @@ sub new { # find split policy to use for option/value separation $self->_splitpolicy(); - # bless into variable interpolation module if neccessary + # bless into variable interpolation module if necessary $self->_blessvars(); # process as usual @@ -171,7 +172,7 @@ sub _process { # open the file and read the contents in $self->{configfile} = $self->{ConfigFile}; if ( file_name_is_absolute($self->{ConfigFile}) ) { - # look if is is an absolute path and save the basename if it is absolute + # look if this 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 if (! $self->{ConfigPath}) { @@ -180,7 +181,7 @@ sub _process { unshift @{$self->{ConfigPath}}, catpath($volume, $path, q()); } $self->_open($self->{configfile}); - # now, we parse immdediately, getall simply returns the whole hash + # now, we parse immediately, getall simply returns the whole hash $self->{config} = $self->_hashref(); $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content}); } @@ -195,11 +196,11 @@ sub _process { sub _blessoop { # - # bless into ::Extended if neccessary + # bless into ::Extended if necessary my($self) = @_; if ($self->{ExtendedAccess}) { # we are blessing here again, to get into the ::Extended namespace - # for inheriting the methods available overthere, which we doesn't have. + # for inheriting the methods available over there, which we doesn't have. bless $self, 'Config::General::Extended'; eval { require Config::General::Extended; @@ -213,7 +214,7 @@ sub _blessoop { sub _blessvars { # - # bless into ::Interpolated if neccessary + # bless into ::Interpolated if necessary my($self) = @_; if ($self->{InterPolateVars} || $self->{InterPolateEnv}) { # InterPolateEnv implies InterPolateVars @@ -409,6 +410,11 @@ sub _open { # open the config file, or expand a directory or glob # my($this, $basefile, $basepath) = @_; + my $cont; + + ($cont, $basefile, $basepath) = $this->_hook('pre_open', $basefile, $basepath); + return if(!$cont); + my($fh, $configfile); if($basepath) { @@ -441,7 +447,7 @@ sub _open { else { # Multiple results or no expansion results (which is fine, # include foo/* shouldn't fail if there isn't anything matching) - local $this->{IncludeGlob}; + # rt.cpan.org#79869: local $this->{IncludeGlob}; for (@include) { $this->_open($_); } @@ -485,7 +491,7 @@ sub _open { if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) { # support re-read if used urged us to do so, otherwise ignore the file if ($this->{UTF8}) { - $fh = new IO::File; + $fh = IO::File->new; open( $fh, "<:utf8", $file) or croak "Config::General: Could not open $file in UTF8 mode!($!)\n"; } @@ -511,7 +517,7 @@ sub _open { } else { if ($this->{UTF8}) { - $fh = new IO::File; + $fh = IO::File->new; open( $fh, "<:utf8", $configfile) or croak "Config::General: Could not open $configfile in UTF8 mode!($!)\n"; } @@ -539,6 +545,8 @@ sub _read { # (comments, continuing lines, and stuff) # my($this, $fh, $flag) = @_; + + my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc); local $_ = q(); @@ -554,6 +562,10 @@ sub _read { @stuff = <$fh>; } + my $cont; + ($cont, $fh, @stuff) = $this->_hook('pre_read', $fh, @stuff); + return if(!$cont); + foreach (@stuff) { if ($this->{AutoLaunder}) { if (m/^(.*)$/) { @@ -563,32 +575,6 @@ sub _read { chomp; - if ($this->{CComments}) { - # look for C-Style comments, if activated - if (/(\s*\/\*.*\*\/\s*)/) { - # single c-comment on one line - s/\s*\/\*.*\*\/\s*//; - } - elsif (/^\s*\/\*/) { - # the beginning of a C-comment ("/*"), from now on ignore everything. - if (/\*\/\s*$/) { - # C-comment end is already there, so just ignore this line! - $c_comment = 0; - } - else { - $c_comment = 1; - } - } - elsif (/\*\//) { - if (!$c_comment) { - warn "invalid syntax: found end of C-comment without previous start!\n"; - } - $c_comment = 0; # the current C-comment ends here, go on - s/^.*\*\///; # if there is still stuff, it will be read - } - next if($c_comment); # ignore EVERYTHING from now on, IF it IS a C-Comment - } - if ($hier) { # inside here-doc, only look for $hierend marker @@ -617,9 +603,31 @@ sub _read { next; } - ### - ### non-heredoc entries from now on - ## + if ($this->{CComments}) { + # look for C-Style comments, if activated + if (/(\s*\/\*.*\*\/\s*)/) { + # single c-comment on one line + s/\s*\/\*.*\*\/\s*//; + } + elsif (/^\s*\/\*/) { + # the beginning of a C-comment ("/*"), from now on ignore everything. + if (/\*\/\s*$/) { + # C-comment end is already there, so just ignore this line! + $c_comment = 0; + } + else { + $c_comment = 1; + } + } + elsif (/\*\//) { + if (!$c_comment) { + warn "invalid syntax: found end of C-comment without previous start!\n"; + } + $c_comment = 0; # the current C-comment ends here, go on + s/^.*\*\///; # if there is still stuff, it will be read + } + next if($c_comment); # ignore EVERYTHING from now on, IF it IS a C-Comment + } # Remove comments and empty lines s/(? .* bugfix rt.cpan.org#44600 @@ -628,8 +636,6 @@ sub _read { # look for multiline option, indicated by a trailing backslash - #my $extra = $this->{BackslashEscape} ? '(?{BackslashEscape}) { - # s/\\(.)/$1/g; - #} - #else { - # # remove the \ char in front of masked "#", if any - # s/\\#/#/g; - #} - - # transform explicit-empty blocks to conforming blocks - if (!$this->{ApacheCompatible} && /\s*<([^\/]+?.*?)\/>$/) { + # rt.cpan.org#80006 added \s* before $/ + if (!$this->{ApacheCompatible} && /\s*<([^\/]+?.*?)\/>\s*$/) { my $block = $1; if ($block !~ /\"/) { if ($block !~ /\s[^\s]/) { @@ -754,6 +750,8 @@ sub _read { } } + + ($cont, $this->{content}) = $this->_hook('post_read', $this->{content}); return 1; } @@ -961,7 +959,7 @@ sub _parse { } } else { - # the first occurence of this particular named block + # the first occurrence of this particular named block my $tmphash = $this->_hashref(); if ($this->{InterPolateVars}) { @@ -1015,7 +1013,7 @@ sub _parse { } } else { - # the first occurence of this particular block + # the first occurrence of this particular block my $tmphash = $this->_hashref(); if ($this->{InterPolateVars}) { @@ -1067,6 +1065,10 @@ sub _parse_value { # my($this, $config, $option, $value) =@_; + my $cont; + ($cont, $option, $value) = $this->_hook('pre_parse_value', $option, $value); + return $value if(!$cont); + # avoid "Use of uninitialized value" if (! defined $value) { # patch fix rt#54583 @@ -1113,11 +1115,27 @@ sub _parse_value { $value =~ s/\\([\$\\\"#])/$1/g; } + ($cont, $option, $value) = $this->_hook('post_parse_value', $option, $value); + return $value; } +sub _hook { + my ($this, $hook, @arguments) = @_; + if(exists $this->{Plug}->{$hook}) { + my $sub = $this->{Plug}->{$hook}; + my @hooked = &$sub(@arguments); + return @hooked; + } + return (1, @arguments); +} + + + + + @@ -1166,7 +1184,7 @@ sub save_file { } else { if ($this->{UTF8}) { - $fh = new IO::File; + $fh = IO::File->new; open($fh, ">:utf8", $file) or croak "Config::General: Could not open $file in UTF8 mode!($!)\n"; } @@ -1446,7 +1464,7 @@ Config::General - Generic Config Module # # the OOP way use Config::General; - $conf = new Config::General("rcfile"); + $conf = Config::General->new("rcfile"); my %config = $conf->getall; # @@ -1476,11 +1494,11 @@ C-style comments or multiline options. Possible ways to call B: - $conf = new Config::General("rcfile"); + $conf = Config::General->new("rcfile"); - $conf = new Config::General(\%somehash); + $conf = Config::General->new(\%somehash); - $conf = new Config::General( %options ); # see below for description of possible options + $conf = Config::General->new( %options ); # see below for description of possible options This method returns a B object (a hash blessed into "Config::General" namespace. @@ -1656,7 +1674,7 @@ The following values will be considered as B: no, off, 0, false -This effect is case-insensitive, i.e. both "Yes" or "oN" will result in 1. +This effect is case-insensitive, i.e. both "Yes" or "No" will result in 1. =item B<-FlagBits> @@ -1672,7 +1690,7 @@ Multiple flags can be used, separated by the pipe character |. Well, an example will clarify things: - my $conf = new Config::General( + my $conf = Config::General->new( -ConfigFile => "rcfile", -FlagBits => { Mode => { @@ -1740,6 +1758,9 @@ 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. +Note that you probably want to use this with B<-MergeDuplicateOptions>, otherwise +a default value already in the configuration file will produce an array of two +values. =item B<-Tie> @@ -1817,7 +1838,7 @@ in a config file is the key and which one is the value. By default it tries its best to guess. That means you can mix equalsign assignments and whitespace assignments. -However, somtime you may wish to make it more strictly for some reason. In +However, sometime you may wish to make it more strictly for some reason. In this case you can set B<-SplitPolicy>. The possible values are: 'guess' which is the default, 'whitespace' which causes the module to split by whitespace, 'equalsign' which causes it to split strictly by equal sign, or 'custom'. In the @@ -1941,7 +1962,7 @@ parameter on. It is not enabled by default. =item B<-NoEscape> -If you want to use the data ( scalar or final leaf ) without escaping special charatecter, turn this +If you want to use the data ( scalar or final leaf ) without escaping special character, turn this parameter on. It is not enabled by default. =item B<-NormalizeBlock> @@ -1987,7 +2008,7 @@ reference to a hash structure, if you set it. If you do not supply this second p then the internal config hash, which has already been parsed, will be used. -Please note that any occurence of comments will be ignored by getall() +Please note that any occurrence of comments will be ignored by getall() and thus be lost after you call this method. You need also to know that named blocks will be converted to nested blocks @@ -2346,7 +2367,7 @@ command will become: =head1 HERE DOCUMENTS You can also define a config value as a so called "here-document". You must tell -the module an identifier which idicates the end of a here document. An +the module an identifier which indicates the end of a here document. An identifier must follow a "<<". Example: @@ -2388,7 +2409,7 @@ line inside the here-document. =head1 INCLUDES -You can include an external file at any posision in your config file using the following statement +You can include an external file at any position in your config file using the following statement in your config file: <> @@ -2496,6 +2517,121 @@ the number sign as the begin of a comment because of the leading backslash. Inside here-documents escaping of number signs is NOT required! +=head1 PARSER PLUGINS + +You can alter the behavior of the parser by supplying closures +which will be called on certain hooks during config file processing +and parsing. + +The general aproach works like this: + + sub ck { + my($file, $base) = @_; + print "_open() tries $file ... "; + if($file =~ /blah/) { + print "ignored\n"; + return (0); + } + else { + print "allowed\n"; + return (1, @_); + } + } + + my %c = ParseConfig( + -IncludeGlob => 1, + -UseApacheInclude => 1, + -ConfigFile => shift, + -Plug => { pre_open => *ck } + ); + +Output: + + _open() tries cfg ... allowed + _open() tries x/*.conf ... allowed + _open() tries x/1.conf ... allowed + _open() tries x/2.conf ... allowed + _open() tries x/blah.conf ... ignored + +As you can see, we wrote a little sub which takes a filename +and a base directory as parameters. We tell Config::General via +the B parameter of B to call this sub everytime +before it attempts to open a file. + +General processing continues as usual if the first value of +the returned array is true. The second value of that array +depends on the kind of hook being called. + +The following hooks are available so far: + +=over + +=item B + +Takes two parameters: filename and basedirectory. + +Has to return an array consisting of 3 values: + + - 1 or 0 (continue processing or not) + - filename + - base directory + +=item B + +Takes two parameters: the filehandle of the file to be read +and an array containing the raw contents of said file. + +This hook will be applied in _read(). File contents are already +available at this stage, comments will be removed, here-docs normalized +and the like. This hook gets the unaltered, original contents. + +Has to return an array of 3 values: + + - 1 or 0 (continue processing or not) + - the filehandle + - an array of strings + +You can use this hook to apply your own normalizations or whatever. + +Be careful when returning the abort value (1st value of returned array 0), +since in this case nothing else would be done on the contents. If it still +contains comments or something, they will be parsed as legal config options. + +=item B + +Takes one parameter: a reference to an array containing the prepared +config lines (after being processed by _read()). + +This hook will be applied in _read() when everything else has been done. + +Has to return an array of 2 values: + + - 1 or 0 (continue processing or not) [Ignored for post hooks] + - a reference to an array containing the config lines + +=item B + +Takes 2 parameters: an option name and its value. + +This hook will be applied in _parse_value() before any processing. + +Has to return an array of 3 values: + + - 1 or 0 (continue processing or not) + - option name + - value of the option + +=item B + +Almost identical to pre_parse_value, but will be applied after _parse_value() +is finished and all usual processing and normalization is done. + +=back + +Not implemented yet: hooks for variable interpolation and block +parsing. + + =head1 OBJECT ORIENTED INTERFACE There is a way to access a parsed config the OO-way. @@ -2577,7 +2713,7 @@ I recommend you to read the following documents, which are supplied with Perl: =head1 LICENSE AND COPYRIGHT -Copyright (c) 2000-2012 Thomas Linden +Copyright (c) 2000-2013 Thomas Linden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -2606,7 +2742,7 @@ Thomas Linden =head1 VERSION -2.51 +2.52 =cut diff --git a/General/Extended.pm b/General/Extended.pm index a49bc8f..a57e381 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-2012 Thomas Linden . +# Copyright (c) 2000-2013 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artistic License, same as perl itself. Have fun. # @@ -23,7 +23,7 @@ use vars qw(@ISA @EXPORT); use strict; -$Config::General::Extended::VERSION = "2.05"; +$Config::General::Extended::VERSION = "2.06"; sub new { @@ -301,21 +301,6 @@ sub delete { } -# -# removed, use save() of General.pm now -# sub save { -# # -# # save the config back to disk -# # -# my($this,$file) = @_; -# my $fh = new FileHandle; -# -# if (!$file) { -# $file = $this->{configfile}; -# } -# -# $this->save_file($file); -# } sub configfile { @@ -386,7 +371,7 @@ Config::General::Extended - Extended access to Config files use Config::General; - $conf = new Config::General( + $conf = Config::General->new( -ConfigFile => 'configfile', -ExtendedAccess => 1 ); @@ -456,7 +441,7 @@ object will be returned. If you run the following on the above config: Then $obj will be empty, just like if you have had run this: - $obj = new Config::General::Extended( () ); + $obj = Config::General::Extended->new( () ); Read operations on this empty object will return nothing or even fail. But you can use an empty object for I a new config using write @@ -562,7 +547,7 @@ This method returns just true if the given key exists in the config. =item keys('key') Returns an array of the keys under the specified "key". If you use the example -config above you yould do that: +config above you could do that: print Dumper($conf->keys("individual"); $VAR1 = [ "martin", "joseph" ]; @@ -583,7 +568,7 @@ otherwise undef will be returned. =head1 AUTOLOAD METHODS -Another usefull feature is implemented in this class using the B feature +Another useful feature is implemented in this class using the B feature of perl. If you know the keynames of a block within your config, you can access to the values of each individual key using the method notation. See the following example and you will get it: @@ -598,7 +583,7 @@ We assume the following config: Now we read it in and process it: - my $conf = new Config::General::Extended("configfile"); + my $conf = Config::General::Extended->new("configfile"); my $person = $conf->obj("person"); print $person->prename . " " . $person->name . " is " . $person->age . " years old\n"; @@ -621,7 +606,7 @@ values under the given key will be overwritten. =head1 COPYRIGHT -Copyright (c) 2000-2012 Thomas Linden +Copyright (c) 2000-2013 Thomas Linden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -638,7 +623,7 @@ Thomas Linden =head1 VERSION -2.05 +2.06 =cut diff --git a/General/Interpolated.pm b/General/Interpolated.pm index df7f6e3..f0d48d6 100644 --- a/General/Interpolated.pm +++ b/General/Interpolated.pm @@ -2,13 +2,13 @@ # Config::General::Interpolated - special Class based on Config::General # # Copyright (c) 2001 by Wei-Hon Chen . -# Copyright (c) 2000-2012 by Thomas Linden . +# Copyright (c) 2000-2013 by Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artistic License, same as perl itself. Have fun. # package Config::General::Interpolated; -$Config::General::Interpolated::VERSION = "2.14"; +$Config::General::Interpolated::VERSION = "2.15"; use strict; use Carp; @@ -48,8 +48,7 @@ sub _set_regex { \$ # dollar sign (\{)? # $2: optional opening curly ([a-zA-Z0-9_\-\.:\+,]+) # $3: capturing variable name (fix of #33447) - ( - ?(2) # $4: if there's the opening curly... + (?(2) # $4: if there's the opening curly... \} # ... match closing curly ) }x; @@ -255,7 +254,7 @@ Config::General::Interpolated - Parse variables within Config files =head1 SYNOPSIS use Config::General; - $conf = new Config::General( + $conf = Config::General->new( -ConfigFile => 'configfile', -InterPolateVars => 1 ); @@ -341,7 +340,7 @@ L =head1 COPYRIGHT Copyright 2001 by Wei-Hon Chen Eplasmaball@pchome.com.twE. -Copyright 2002-2012 by Thomas Linden . +Copyright 2002-2013 by Thomas Linden . This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -350,7 +349,7 @@ See L =head1 VERSION -2.14 +2.15 =cut diff --git a/Makefile.PL b/Makefile.PL index d697bde..a20b6da 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,7 +1,7 @@ # # Makefile.PL - build file for Config::General # -# Copyright (c) 2000-2012 Thomas Linden . +# Copyright (c) 2000-2013 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artistic License, same as perl itself. Have fun. # diff --git a/t/cfg.8 b/t/cfg.8 index 75b0d2f..ca9b600 100644 --- a/t/cfg.8 +++ b/t/cfg.8 @@ -16,6 +16,10 @@ message < 69; +use Test::More tests => 70; #use Test::More qw(no_plan); # ahem, we deliver the test code with a local copy of @@ -49,6 +49,8 @@ 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"); +# 8a +like($copyhash{nocomment}, qr/this should appear/, "C-comments not processed in here-doc"); ### 9 $conf = new Config::General(