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

=> 2.52, see changelog

Browse Source 
git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@96 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2013-07-03 08:37:11 +00:00
parent 1ee3fcec91
commit e690b33942
7 changed files with 258 additions and 109 deletions
Download Patch File Download Diff File Expand all files Collapse all files

278
General.pm
View File

@@ -5,7 +5,7 @@
# config values from a given file and
# return it as hash structure
#
# Copyright (c) 2000-2012 Thomas Linden <tlinden |AT| cpan.org>.
# Copyright (c) 2000-2013 Thomas Linden <tlinden |AT| cpan.org>.
# 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} ? '(?<!\\\\)' : q();
#if (/$extra\\$/) {
if (/(?<!\\)\\$/) {
chop;
s/^\s*//;
@@ -637,19 +643,9 @@ sub _read {
next;
}
# remove the \ from all characters if BackslashEscape is turned on
# FIXME (rt.cpan.org#33218
#if ($this->{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<new()>:
$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<Config::General> object (a hash blessed into "Config::General" namespace.
@@ -1656,7 +1674,7 @@ The following values will be considered as B<false>:
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:
<<include externalconfig.rc>>
@@ -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<Plug> parameter of B<new()> 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<pre_open>
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<pre_read>
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<post_read>
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<pre_parse_value>
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<post_parse_value>
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 <tlinden |AT| cpan.org>
=head1 VERSION
2.51
2.52
=cut