mirror of
https://codeberg.org/scip/Config-General.git
synced 2025-12-16 20:21:01 +01:00
=> 2.52, see changelog
git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@96 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
33
Changelog
33
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<74>, 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
|
2.51 - fixed rt.cpan.org#77667 which resulted in invalid configs
|
||||||
written to file when using save_file() and a named block,
|
written to file when using save_file() and a named block,
|
||||||
whose 2nd part starts with a /.
|
whose 2nd part starts with a /.
|
||||||
@@ -81,7 +104,7 @@
|
|||||||
configuration variable EOFseparator, which contains
|
configuration variable EOFseparator, which contains
|
||||||
a 256 bit SHA checksum of the date I fixed the bug.
|
a 256 bit SHA checksum of the date I fixed the bug.
|
||||||
This will prevent future conflicts hopefully. In addition
|
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.
|
in a future release.
|
||||||
|
|
||||||
- fixed rt.cpan.org#42721, return undef for empty values
|
- fixed rt.cpan.org#42721, return undef for empty values
|
||||||
@@ -583,7 +606,7 @@
|
|||||||
know, perl hashes doesn't preserve the order. So,
|
know, perl hashes doesn't preserve the order. So,
|
||||||
in our case the module sometimes was unable to
|
in our case the module sometimes was unable to
|
||||||
resolve variablenames, because they were stored
|
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
|
The change is, that Config::General now calls
|
||||||
::Interpolate.pm (new sub: _interpolate()) itself
|
::Interpolate.pm (new sub: _interpolate()) itself
|
||||||
directly on a per-key/value pair basis. The internal
|
directly on a per-key/value pair basis. The internal
|
||||||
@@ -618,7 +641,7 @@
|
|||||||
same config as their parents.
|
same config as their parents.
|
||||||
|
|
||||||
2.08 - added option -StrictVars, which causes Interpolate.pm to
|
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.
|
with the emppty string.
|
||||||
|
|
||||||
- applied patch by Stefan Moser <sm@open.ch>, which fixes
|
- applied patch by Stefan Moser <sm@open.ch>, which fixes
|
||||||
@@ -673,7 +696,7 @@
|
|||||||
-ConfigFile parameter. This makes it possible to use locking.
|
-ConfigFile parameter. This makes it possible to use locking.
|
||||||
|
|
||||||
2.05 - fixed bug in ::Extended. It exported for some weird
|
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.
|
keys() exists() and delete(), which are perl internals.
|
||||||
If one used keys() on a normal hash, then the ::Extended
|
If one used keys() on a normal hash, then the ::Extended
|
||||||
own keys() were used instead of perls own one. I removed
|
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
|
1.24: - AllowMultiOptions printed out the value and not the
|
||||||
option itself, if more than one of this particular
|
option itself, if more than one of this particular
|
||||||
option occured.
|
option occurred.
|
||||||
- added -UseApacheInclude feature, contributed by
|
- added -UseApacheInclude feature, contributed by
|
||||||
Thomas Klausner <domm@zsi.at>
|
Thomas Klausner <domm@zsi.at>
|
||||||
- fixed bug with multiple options stuff, which did not
|
- fixed bug with multiple options stuff, which did not
|
||||||
|
|||||||
278
General.pm
278
General.pm
@@ -5,7 +5,7 @@
|
|||||||
# config values from a given file and
|
# config values from a given file and
|
||||||
# return it as hash structure
|
# 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.
|
# All Rights Reserved. Std. disclaimer applies.
|
||||||
# Artistic License, same as perl itself. Have fun.
|
# 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.
|
# 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,
|
# 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
|
# 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::Heavy;
|
||||||
|
|
||||||
|
|
||||||
use Carp;
|
use Carp;
|
||||||
use Exporter;
|
use Exporter;
|
||||||
|
|
||||||
$Config::General::VERSION = "2.51";
|
$Config::General::VERSION = "2.52";
|
||||||
|
|
||||||
use vars qw(@ISA @EXPORT_OK);
|
use vars qw(@ISA @EXPORT_OK);
|
||||||
use base qw(Exporter);
|
use base qw(Exporter);
|
||||||
@@ -93,6 +93,7 @@ sub new {
|
|||||||
NormalizeBlock => 0,
|
NormalizeBlock => 0,
|
||||||
NormalizeOption => 0,
|
NormalizeOption => 0,
|
||||||
NormalizeValue => 0,
|
NormalizeValue => 0,
|
||||||
|
Plug => {}
|
||||||
};
|
};
|
||||||
|
|
||||||
# create the class instance
|
# create the class instance
|
||||||
@@ -118,7 +119,7 @@ sub new {
|
|||||||
# find split policy to use for option/value separation
|
# find split policy to use for option/value separation
|
||||||
$self->_splitpolicy();
|
$self->_splitpolicy();
|
||||||
|
|
||||||
# bless into variable interpolation module if neccessary
|
# bless into variable interpolation module if necessary
|
||||||
$self->_blessvars();
|
$self->_blessvars();
|
||||||
|
|
||||||
# process as usual
|
# process as usual
|
||||||
@@ -171,7 +172,7 @@ sub _process {
|
|||||||
# open the file and read the contents in
|
# open the file and read the contents in
|
||||||
$self->{configfile} = $self->{ConfigFile};
|
$self->{configfile} = $self->{ConfigFile};
|
||||||
if ( file_name_is_absolute($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});
|
my ($volume, $path, undef) = splitpath($self->{ConfigFile});
|
||||||
$path =~ s#/$##; # remove eventually existing trailing slash
|
$path =~ s#/$##; # remove eventually existing trailing slash
|
||||||
if (! $self->{ConfigPath}) {
|
if (! $self->{ConfigPath}) {
|
||||||
@@ -180,7 +181,7 @@ sub _process {
|
|||||||
unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
|
unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
|
||||||
}
|
}
|
||||||
$self->_open($self->{configfile});
|
$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->_hashref();
|
||||||
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
|
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
|
||||||
}
|
}
|
||||||
@@ -195,11 +196,11 @@ sub _process {
|
|||||||
|
|
||||||
sub _blessoop {
|
sub _blessoop {
|
||||||
#
|
#
|
||||||
# bless into ::Extended if neccessary
|
# bless into ::Extended if necessary
|
||||||
my($self) = @_;
|
my($self) = @_;
|
||||||
if ($self->{ExtendedAccess}) {
|
if ($self->{ExtendedAccess}) {
|
||||||
# we are blessing here again, to get into the ::Extended namespace
|
# 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';
|
bless $self, 'Config::General::Extended';
|
||||||
eval {
|
eval {
|
||||||
require Config::General::Extended;
|
require Config::General::Extended;
|
||||||
@@ -213,7 +214,7 @@ sub _blessoop {
|
|||||||
|
|
||||||
sub _blessvars {
|
sub _blessvars {
|
||||||
#
|
#
|
||||||
# bless into ::Interpolated if neccessary
|
# bless into ::Interpolated if necessary
|
||||||
my($self) = @_;
|
my($self) = @_;
|
||||||
if ($self->{InterPolateVars} || $self->{InterPolateEnv}) {
|
if ($self->{InterPolateVars} || $self->{InterPolateEnv}) {
|
||||||
# InterPolateEnv implies InterPolateVars
|
# InterPolateEnv implies InterPolateVars
|
||||||
@@ -409,6 +410,11 @@ sub _open {
|
|||||||
# open the config file, or expand a directory or glob
|
# open the config file, or expand a directory or glob
|
||||||
#
|
#
|
||||||
my($this, $basefile, $basepath) = @_;
|
my($this, $basefile, $basepath) = @_;
|
||||||
|
my $cont;
|
||||||
|
|
||||||
|
($cont, $basefile, $basepath) = $this->_hook('pre_open', $basefile, $basepath);
|
||||||
|
return if(!$cont);
|
||||||
|
|
||||||
my($fh, $configfile);
|
my($fh, $configfile);
|
||||||
|
|
||||||
if($basepath) {
|
if($basepath) {
|
||||||
@@ -441,7 +447,7 @@ sub _open {
|
|||||||
else {
|
else {
|
||||||
# Multiple results or no expansion results (which is fine,
|
# Multiple results or no expansion results (which is fine,
|
||||||
# include foo/* shouldn't fail if there isn't anything matching)
|
# include foo/* shouldn't fail if there isn't anything matching)
|
||||||
local $this->{IncludeGlob};
|
# rt.cpan.org#79869: local $this->{IncludeGlob};
|
||||||
for (@include) {
|
for (@include) {
|
||||||
$this->_open($_);
|
$this->_open($_);
|
||||||
}
|
}
|
||||||
@@ -485,7 +491,7 @@ sub _open {
|
|||||||
if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) {
|
if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) {
|
||||||
# support re-read if used urged us to do so, otherwise ignore the file
|
# support re-read if used urged us to do so, otherwise ignore the file
|
||||||
if ($this->{UTF8}) {
|
if ($this->{UTF8}) {
|
||||||
$fh = new IO::File;
|
$fh = IO::File->new;
|
||||||
open( $fh, "<:utf8", $file)
|
open( $fh, "<:utf8", $file)
|
||||||
or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
|
or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
|
||||||
}
|
}
|
||||||
@@ -511,7 +517,7 @@ sub _open {
|
|||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
if ($this->{UTF8}) {
|
if ($this->{UTF8}) {
|
||||||
$fh = new IO::File;
|
$fh = IO::File->new;
|
||||||
open( $fh, "<:utf8", $configfile)
|
open( $fh, "<:utf8", $configfile)
|
||||||
or croak "Config::General: Could not open $configfile in UTF8 mode!($!)\n";
|
or croak "Config::General: Could not open $configfile in UTF8 mode!($!)\n";
|
||||||
}
|
}
|
||||||
@@ -539,6 +545,8 @@ sub _read {
|
|||||||
# (comments, continuing lines, and stuff)
|
# (comments, continuing lines, and stuff)
|
||||||
#
|
#
|
||||||
my($this, $fh, $flag) = @_;
|
my($this, $fh, $flag) = @_;
|
||||||
|
|
||||||
|
|
||||||
my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc);
|
my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc);
|
||||||
local $_ = q();
|
local $_ = q();
|
||||||
|
|
||||||
@@ -554,6 +562,10 @@ sub _read {
|
|||||||
@stuff = <$fh>;
|
@stuff = <$fh>;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
my $cont;
|
||||||
|
($cont, $fh, @stuff) = $this->_hook('pre_read', $fh, @stuff);
|
||||||
|
return if(!$cont);
|
||||||
|
|
||||||
foreach (@stuff) {
|
foreach (@stuff) {
|
||||||
if ($this->{AutoLaunder}) {
|
if ($this->{AutoLaunder}) {
|
||||||
if (m/^(.*)$/) {
|
if (m/^(.*)$/) {
|
||||||
@@ -563,32 +575,6 @@ sub _read {
|
|||||||
|
|
||||||
chomp;
|
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) {
|
if ($hier) {
|
||||||
# inside here-doc, only look for $hierend marker
|
# inside here-doc, only look for $hierend marker
|
||||||
@@ -617,9 +603,31 @@ sub _read {
|
|||||||
next;
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
###
|
if ($this->{CComments}) {
|
||||||
### non-heredoc entries from now on
|
# 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
|
# Remove comments and empty lines
|
||||||
s/(?<!\\)#.*$//; # .+ => .* bugfix rt.cpan.org#44600
|
s/(?<!\\)#.*$//; # .+ => .* bugfix rt.cpan.org#44600
|
||||||
@@ -628,8 +636,6 @@ sub _read {
|
|||||||
|
|
||||||
|
|
||||||
# look for multiline option, indicated by a trailing backslash
|
# look for multiline option, indicated by a trailing backslash
|
||||||
#my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : q();
|
|
||||||
#if (/$extra\\$/) {
|
|
||||||
if (/(?<!\\)\\$/) {
|
if (/(?<!\\)\\$/) {
|
||||||
chop;
|
chop;
|
||||||
s/^\s*//;
|
s/^\s*//;
|
||||||
@@ -637,19 +643,9 @@ sub _read {
|
|||||||
next;
|
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
|
# 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;
|
my $block = $1;
|
||||||
if ($block !~ /\"/) {
|
if ($block !~ /\"/) {
|
||||||
if ($block !~ /\s[^\s]/) {
|
if ($block !~ /\s[^\s]/) {
|
||||||
@@ -754,6 +750,8 @@ sub _read {
|
|||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
($cont, $this->{content}) = $this->_hook('post_read', $this->{content});
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -961,7 +959,7 @@ sub _parse {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# the first occurence of this particular named block
|
# the first occurrence of this particular named block
|
||||||
my $tmphash = $this->_hashref();
|
my $tmphash = $this->_hashref();
|
||||||
|
|
||||||
if ($this->{InterPolateVars}) {
|
if ($this->{InterPolateVars}) {
|
||||||
@@ -1015,7 +1013,7 @@ sub _parse {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# the first occurence of this particular block
|
# the first occurrence of this particular block
|
||||||
my $tmphash = $this->_hashref();
|
my $tmphash = $this->_hashref();
|
||||||
|
|
||||||
if ($this->{InterPolateVars}) {
|
if ($this->{InterPolateVars}) {
|
||||||
@@ -1067,6 +1065,10 @@ sub _parse_value {
|
|||||||
#
|
#
|
||||||
my($this, $config, $option, $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"
|
# avoid "Use of uninitialized value"
|
||||||
if (! defined $value) {
|
if (! defined $value) {
|
||||||
# patch fix rt#54583
|
# patch fix rt#54583
|
||||||
@@ -1113,11 +1115,27 @@ sub _parse_value {
|
|||||||
$value =~ s/\\([\$\\\"#])/$1/g;
|
$value =~ s/\\([\$\\\"#])/$1/g;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
($cont, $option, $value) = $this->_hook('post_parse_value', $option, $value);
|
||||||
|
|
||||||
return $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 {
|
else {
|
||||||
if ($this->{UTF8}) {
|
if ($this->{UTF8}) {
|
||||||
$fh = new IO::File;
|
$fh = IO::File->new;
|
||||||
open($fh, ">:utf8", $file)
|
open($fh, ">:utf8", $file)
|
||||||
or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
|
or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
|
||||||
}
|
}
|
||||||
@@ -1446,7 +1464,7 @@ Config::General - Generic Config Module
|
|||||||
#
|
#
|
||||||
# the OOP way
|
# the OOP way
|
||||||
use Config::General;
|
use Config::General;
|
||||||
$conf = new Config::General("rcfile");
|
$conf = Config::General->new("rcfile");
|
||||||
my %config = $conf->getall;
|
my %config = $conf->getall;
|
||||||
|
|
||||||
#
|
#
|
||||||
@@ -1476,11 +1494,11 @@ C-style comments or multiline options.
|
|||||||
|
|
||||||
Possible ways to call B<new()>:
|
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.
|
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
|
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>
|
=item B<-FlagBits>
|
||||||
@@ -1672,7 +1690,7 @@ Multiple flags can be used, separated by the pipe character |.
|
|||||||
|
|
||||||
Well, an example will clarify things:
|
Well, an example will clarify things:
|
||||||
|
|
||||||
my $conf = new Config::General(
|
my $conf = Config::General->new(
|
||||||
-ConfigFile => "rcfile",
|
-ConfigFile => "rcfile",
|
||||||
-FlagBits => {
|
-FlagBits => {
|
||||||
Mode => {
|
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,
|
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.
|
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>
|
=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
|
its best to guess. That means you can mix equalsign assignments and whitespace
|
||||||
assignments.
|
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
|
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,
|
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
|
'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>
|
=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.
|
parameter on. It is not enabled by default.
|
||||||
|
|
||||||
=item B<-NormalizeBlock>
|
=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
|
then the internal config hash, which has already been parsed, will be
|
||||||
used.
|
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.
|
and thus be lost after you call this method.
|
||||||
|
|
||||||
You need also to know that named blocks will be converted to nested blocks
|
You need also to know that named blocks will be converted to nested blocks
|
||||||
@@ -2346,7 +2367,7 @@ command will become:
|
|||||||
=head1 HERE DOCUMENTS
|
=head1 HERE DOCUMENTS
|
||||||
|
|
||||||
You can also define a config value as a so called "here-document". You must tell
|
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 "<<".
|
identifier must follow a "<<".
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
@@ -2388,7 +2409,7 @@ line inside the here-document.
|
|||||||
|
|
||||||
=head1 INCLUDES
|
=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:
|
in your config file:
|
||||||
|
|
||||||
<<include externalconfig.rc>>
|
<<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!
|
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
|
=head1 OBJECT ORIENTED INTERFACE
|
||||||
|
|
||||||
There is a way to access a parsed config the OO-way.
|
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
|
=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
|
This library is free software; you can redistribute it and/or
|
||||||
modify it under the same terms as Perl itself.
|
modify it under the same terms as Perl itself.
|
||||||
@@ -2606,7 +2742,7 @@ Thomas Linden <tlinden |AT| cpan.org>
|
|||||||
|
|
||||||
=head1 VERSION
|
=head1 VERSION
|
||||||
|
|
||||||
2.51
|
2.52
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
#
|
#
|
||||||
# Config::General::Extended - special Class based on Config::General
|
# Config::General::Extended - special Class based on Config::General
|
||||||
#
|
#
|
||||||
# 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.
|
# All Rights Reserved. Std. disclaimer applies.
|
||||||
# Artistic License, same as perl itself. Have fun.
|
# Artistic License, same as perl itself. Have fun.
|
||||||
#
|
#
|
||||||
@@ -23,7 +23,7 @@ use vars qw(@ISA @EXPORT);
|
|||||||
use strict;
|
use strict;
|
||||||
|
|
||||||
|
|
||||||
$Config::General::Extended::VERSION = "2.05";
|
$Config::General::Extended::VERSION = "2.06";
|
||||||
|
|
||||||
|
|
||||||
sub new {
|
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 {
|
sub configfile {
|
||||||
@@ -386,7 +371,7 @@ Config::General::Extended - Extended access to Config files
|
|||||||
|
|
||||||
use Config::General;
|
use Config::General;
|
||||||
|
|
||||||
$conf = new Config::General(
|
$conf = Config::General->new(
|
||||||
-ConfigFile => 'configfile',
|
-ConfigFile => 'configfile',
|
||||||
-ExtendedAccess => 1
|
-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:
|
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.
|
Read operations on this empty object will return nothing or even fail.
|
||||||
But you can use an empty object for I<creating> a new config using write
|
But you can use an empty object for I<creating> 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')
|
=item keys('key')
|
||||||
|
|
||||||
Returns an array of the keys under the specified "key". If you use the example
|
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");
|
print Dumper($conf->keys("individual");
|
||||||
$VAR1 = [ "martin", "joseph" ];
|
$VAR1 = [ "martin", "joseph" ];
|
||||||
@@ -583,7 +568,7 @@ otherwise undef will be returned.
|
|||||||
|
|
||||||
=head1 AUTOLOAD METHODS
|
=head1 AUTOLOAD METHODS
|
||||||
|
|
||||||
Another usefull feature is implemented in this class using the B<AUTOLOAD> feature
|
Another useful feature is implemented in this class using the B<AUTOLOAD> feature
|
||||||
of perl. If you know the keynames of a block within your config, you can access to
|
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
|
the values of each individual key using the method notation. See the following example
|
||||||
and you will get it:
|
and you will get it:
|
||||||
@@ -598,7 +583,7 @@ We assume the following config:
|
|||||||
|
|
||||||
Now we read it in and process it:
|
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");
|
my $person = $conf->obj("person");
|
||||||
print $person->prename . " " . $person->name . " is " . $person->age . " years old\n";
|
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
|
=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
|
This library is free software; you can redistribute it and/or
|
||||||
modify it under the same terms as Perl itself.
|
modify it under the same terms as Perl itself.
|
||||||
@@ -638,7 +623,7 @@ Thomas Linden <tlinden |AT| cpan.org>
|
|||||||
|
|
||||||
=head1 VERSION
|
=head1 VERSION
|
||||||
|
|
||||||
2.05
|
2.06
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|||||||
@@ -2,13 +2,13 @@
|
|||||||
# Config::General::Interpolated - special Class based on Config::General
|
# Config::General::Interpolated - special Class based on Config::General
|
||||||
#
|
#
|
||||||
# Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>.
|
# Copyright (c) 2001 by Wei-Hon Chen <plasmaball@pchome.com.tw>.
|
||||||
# Copyright (c) 2000-2012 by Thomas Linden <tlinden |AT| cpan.org>.
|
# Copyright (c) 2000-2013 by Thomas Linden <tlinden |AT| cpan.org>.
|
||||||
# All Rights Reserved. Std. disclaimer applies.
|
# All Rights Reserved. Std. disclaimer applies.
|
||||||
# Artistic License, same as perl itself. Have fun.
|
# Artistic License, same as perl itself. Have fun.
|
||||||
#
|
#
|
||||||
|
|
||||||
package Config::General::Interpolated;
|
package Config::General::Interpolated;
|
||||||
$Config::General::Interpolated::VERSION = "2.14";
|
$Config::General::Interpolated::VERSION = "2.15";
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use Carp;
|
use Carp;
|
||||||
@@ -48,8 +48,7 @@ sub _set_regex {
|
|||||||
\$ # dollar sign
|
\$ # dollar sign
|
||||||
(\{)? # $2: optional opening curly
|
(\{)? # $2: optional opening curly
|
||||||
([a-zA-Z0-9_\-\.:\+,]+) # $3: capturing variable name (fix of #33447)
|
([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
|
\} # ... match closing curly
|
||||||
)
|
)
|
||||||
}x;
|
}x;
|
||||||
@@ -255,7 +254,7 @@ Config::General::Interpolated - Parse variables within Config files
|
|||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
use Config::General;
|
use Config::General;
|
||||||
$conf = new Config::General(
|
$conf = Config::General->new(
|
||||||
-ConfigFile => 'configfile',
|
-ConfigFile => 'configfile',
|
||||||
-InterPolateVars => 1
|
-InterPolateVars => 1
|
||||||
);
|
);
|
||||||
@@ -341,7 +340,7 @@ L<Config::General>
|
|||||||
=head1 COPYRIGHT
|
=head1 COPYRIGHT
|
||||||
|
|
||||||
Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
|
Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
|
||||||
Copyright 2002-2012 by Thomas Linden <tlinden |AT| cpan.org>.
|
Copyright 2002-2013 by Thomas Linden <tlinden |AT| cpan.org>.
|
||||||
|
|
||||||
This program is free software; you can redistribute it and/or
|
This program is free software; you can redistribute it and/or
|
||||||
modify it under the same terms as Perl itself.
|
modify it under the same terms as Perl itself.
|
||||||
@@ -350,7 +349,7 @@ See L<http://www.perl.com/perl/misc/Artistic.html>
|
|||||||
|
|
||||||
=head1 VERSION
|
=head1 VERSION
|
||||||
|
|
||||||
2.14
|
2.15
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
#
|
#
|
||||||
# Makefile.PL - build file for Config::General
|
# Makefile.PL - build file for Config::General
|
||||||
#
|
#
|
||||||
# Copyright (c) 2000-2012 Thomas Linden <tom@daemon.de>.
|
# Copyright (c) 2000-2013 Thomas Linden <tom@daemon.de>.
|
||||||
# All Rights Reserved. Std. disclaimer applies.
|
# All Rights Reserved. Std. disclaimer applies.
|
||||||
# Artistic License, same as perl itself. Have fun.
|
# Artistic License, same as perl itself. Have fun.
|
||||||
#
|
#
|
||||||
|
|||||||
4
t/cfg.8
4
t/cfg.8
@@ -16,6 +16,10 @@ message <<EOF
|
|||||||
can reach us somewhere in
|
can reach us somewhere in
|
||||||
outerspace.
|
outerspace.
|
||||||
EOF
|
EOF
|
||||||
|
nocomment <<EOF
|
||||||
|
Comments in a here-doc should not be treated as comments.
|
||||||
|
/* So this should appear in the output */
|
||||||
|
EOF
|
||||||
command = ssh -f -g orpheus.0x49.org \
|
command = ssh -f -g orpheus.0x49.org \
|
||||||
-l azrael -L:34777samir.okir.da.ru:22 \
|
-l azrael -L:34777samir.okir.da.ru:22 \
|
||||||
-L:31773:shane.sol1.rocket.de:22 \
|
-L:31773:shane.sol1.rocket.de:22 \
|
||||||
|
|||||||
4
t/run.t
4
t/run.t
@@ -8,7 +8,7 @@
|
|||||||
|
|
||||||
|
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use Test::More tests => 69;
|
use Test::More tests => 70;
|
||||||
#use Test::More qw(no_plan);
|
#use Test::More qw(no_plan);
|
||||||
|
|
||||||
# ahem, we deliver the test code with a local copy of
|
# 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;
|
my %copyhash = $copy->getall;
|
||||||
is_deeply(\%hash, \%copyhash, "Writing Config Hash to disk and compare with original");
|
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
|
### 9
|
||||||
$conf = new Config::General(
|
$conf = new Config::General(
|
||||||
|
|||||||
Reference in New Issue
Block a user