=> 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:
Thomas von Dein
2013-07-03 08:37:11 +00:00
parent 1ee3fcec91
commit e690b33942
7 changed files with 258 additions and 109 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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.
# #

View File

@@ -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 \

View File

@@ -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(