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

1.28:

Browse Source 
- added contributed sub module Config::General::Interpolated
	   by "Wei-Hon Chen" <plasmaball@pchome.com.tw> with
	   help from "Autrijus Tang" <autrijus@autrijus.org>
	   which makes it possible to use variables inside
	   config files.
	 - _read() accepts now c-comments inside c-comments if
	   they are on a single line.
	 - _read() is now more tolerant to here-identifiers
	   (the ends of here-docs), whitespaces right after
	   such an identifier are allowed (i.e. "EOF  ").
	 - _read() does now behave somewhat different with
	   C-comments, they will be the first thing being
	   processed in a config, so the parser really
	   ignores everything inside C-comments. Previously
	   it did not do that, for example here-docs has
	   not been ignored.


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@16 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:14:18 +00:00
parent 2c5ee3d876
commit b906f49050
4 changed files with 272 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
Changelog
View File

@@ -1,3 +1,21 @@
1.28:
- added contributed sub module Config::General::Interpolated
by "Wei-Hon Chen" <plasmaball@pchome.com.tw> with
help from "Autrijus Tang" <autrijus@autrijus.org>
which makes it possible to use variables inside
config files.
- _read() accepts now c-comments inside c-comments if
they are on a single line.
- _read() is now more tolerant to here-identifiers
(the ends of here-docs), whitespaces right after
such an identifier are allowed (i.e. "EOF ").
- _read() does now behave somewhat different with
C-comments, they will be the first thing being
processed in a config, so the parser really
ignores everything inside C-comments. Previously
it did not do that, for example here-docs has
not been ignored.
1.27: - "make test" complained about uninitialized value
in :146, which is now fixed.

81
General.pm
View File

@@ -17,7 +17,7 @@ use FileHandle;
use strict;
use Carp;
$Config::General::VERSION = "1.27";
$Config::General::VERSION = "1.28";
sub new {
#
@@ -157,18 +157,39 @@ sub _read {
foreach (@stuff) {
chomp;
# patch by "Manuel Valente" <manuel@ripe.net>:
if (!$hierend) {
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 (!$hierend) { # patch by "Manuel Valente" <manuel@ripe.net>:
s/(?<!\\)#.+$//; # Remove comments
next if /^#/; # Remove lines beginning with "#"
next if /^\s*$/; # Skip empty lines
s/\\#/#/g; # remove the \ char in front of masked "#"
}
if (/^\s*(\S+?)(\s*=\s*|\s+)<<(.+?)$/) { # we are @ the beginning of a here-doc
$hier = $1; # $hier is the actual here-doc
$hier = $1; # $hier is the actual here-doc
$hierend = $3; # the here-doc end string, i.e. "EOF"
}
elsif (defined $hierend && /^(\s*)\Q$hierend\E$/) { # the current here-doc ends here
elsif (defined $hierend && /^(\s*)\Q$hierend\E\s*$/) { # the current here-doc ends here (allow spaces)
my $indent = $1; # preserve indentation
$hier .= " " . chr(182); # append a "<22>" to the here-doc-name, so _parse will also preserver indentation
if ($indent) {
@@ -185,29 +206,16 @@ sub _read {
undef $hier;
undef $hierend;
}
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
}
elsif (/\\$/) { # a multiline option, indicated by a trailing backslash
chop;
s/^\s*//;
$longline .= $_ if(!$c_comment); # store in $longline
$longline .= $_; # store in $longline
}
else { # any "normal" config lines
if ($longline) { # previous stuff was a longline and this is the last line of the longline
s/^\s*//;
$longline .= $_ if(!$c_comment);
$longline .= $_;
push @{$this->{content}}, $longline; # push it onto the content stack
undef $longline;
}
@@ -216,23 +224,21 @@ sub _read {
}
else {
# look for include statement(s)
if (!$c_comment) {
my $incl_file;
if (/^\s*<<include (.+?)>>\s*$/i || (/^\s*include (.+?)\s*$/i && $this->{UseApacheInclude})) {
$incl_file = $1;
if ($this->{IncludeRelative} && $this->{configpath} && $incl_file !~ /^\//) {
# include the file from within location of $this->{configfile}
$this->_open($this->{configpath} . "/" . $incl_file);
}
else {
# include the file from within pwd, or absolute
$this->_open($incl_file);
}
my $incl_file;
if (/^\s*<<include (.+?)>>\s*$/i || (/^\s*include (.+?)\s*$/i && $this->{UseApacheInclude})) {
$incl_file = $1;
if ($this->{IncludeRelative} && $this->{configpath} && $incl_file !~ /^\//) {
# include the file from within location of $this->{configfile}
$this->_open($this->{configpath} . "/" . $incl_file);
}
else {
push @{$this->{content}}, $_;
# include the file from within pwd, or absolute
$this->_open($incl_file);
}
}
else {
push @{$this->{content}}, $_;
}
}
}
}
@@ -979,6 +985,11 @@ There is a way to access a parsed config the OO-way.
Use the module B<Config::General::Extended>, which is
supplied with the Config::General distribution.
=head1 VARIABLE INTERPOLATION
You can use variables inside your configfiles if you like. To do
that you have to use the module B<Config::General::Interpolated>,
which is supplied with the Config::General distribution.
=head1 SEE ALSO
@@ -1011,7 +1022,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
1.27
1.28
=cut

207
General/Interpolated.pm Normal file
View File

@@ -0,0 +1,207 @@
package Config::General::Interpolated;
$Config::General::Interpolated::VERSION = "1.0";
use strict;
use Carp;
use Config::General;
# Import stuff from Config::General
use vars qw(@ISA);
@ISA = qw(Config::General);
sub new {
#
# overwrite new() with our own version
# and call the parent class new()
#
my $class = shift;
my $self = $class->SUPER::new(@_);
# the following regex is provided by Autrijus Tang
# <autrijus@autrijus.org>, and I made some modifications.
# thanx, autrijus. :)
$self->{regex} = qr{
(^|[^\\]) # can be the beginning of the line
# but can't begin with a '\'
\$ # dollar sign
(\{)? # $1: optional opening curly
([a-zA-Z_]\w*) # $2: capturing variable name
(
?(2) # $3: if there's the opening curly...
\} # ... match closing curly
)
}x;
$self->{config} = $self->vars($self->{config}, {});
return $self;
}
sub vars {
my ($this, $config, $stack) = @_;
my %varstack;
$stack = {} unless defined $stack; # make sure $stack is assigned.
# collect values that don't need to be substituted first
while (my ($key, $value) = each %{$config}) {
$varstack{$key} = $value
unless ref($value) or $value =~ $this->{regex};
}
my $sub_interpolate = sub {
my ($value) = @_;
# this is a scalar
if ($value =~ m/^'/ and $value =~ m/'$/) {
# single-quote, remove it and don't do variable interpolation
$value =~ s/^'//; $value =~ s/'$//;
}
else {
$value =~ s{$this->{regex}}{
my $v = $varstack{$3} || $stack->{$3};
$v = '' if ref($v);
$1 . $v;
}egx;
}
return $value;
};
# interpolate variables
while (my ($key, $value) = each %{$config}) {
if (my $reftype = ref($value)) {
next unless $reftype eq 'ARRAY';
# we encounter multiple options
@{$value} = map { $sub_interpolate->($_) } @{$value};
}
else {
$value = $sub_interpolate->($value);
$config->{$key} = $value;
$varstack{$key} = $value;
}
}
# traverse the hierarchy part
while (my ($key, $value) = each %{$config}) {
# this is not a scalar recursive call to myself
$this->vars($value, {%{$stack}, %varstack})
if ref($value) eq 'HASH';
}
return $config;
}
1;
__END__
=head1 NAME
Config::General::Interpolated - Parse variables within Config files
=head1 SYNOPSIS
use Config::General::Interpolated;
$conf = new Config::General::Interpolated("rcfile");
# or
$conf = new Config::General::Interpolated(\%somehash);
=head1 DESCRIPTION
This module is a subclass of B<Config::General>. You can use it if
your config file contains perl-style variables (i.e. C<$variable>
or C<${variable}>). The following methods are directly inherited
from Config::General: B<new() getall()>.
Please refer to the L<Config::General> for the module's usage and the
format of config files.
=head1 VARIABLES
Variables can be defined everywhere in the config and can be used
afterwards. If you define a variable inside a block or a named block
then it is only visible within this block or within blocks which
are defined inside this block. Well - let's take a look to an example:
# sample config which uses variables
basedir = /opt/ora
user = t_space
sys = unix
<table intern>
instance = INTERN
owner = $user # "t_space"
logdir = $basedir/log # "/opt/ora/log"
sys = macos
<procs>
misc1 = ${sys}_${instance} # macos_INTERN
misc2 = $user # "t_space"
</procs>
</table>
This will result in the following structure:
{
'basedir' => '/opt/ora',
'user' => 't_space'
'sys' => 'unix',
'table' => {
'intern' => {
'sys' => 'macos',
'logdir' => '/opt/ora/log',
'instance' => 'INTERN',
'owner' => 't_space',
'procs' => {
'misc1' => 'macos_INTERN',
'misc2' => 't_space'
}
}
}
As you can see, the variable B<sys> has been defined twice. Inside
the <procs> block a variable ${sys} has been used, which then were
interpolated into the value of B<sys> defined inside the <table>
block, not the sys variable one level above. If sys were not defined
inside the <table> block then the "global" variable B<sys> would have
been used instead with the value of "unix".
Variables inside double quotes will be interpolated, but variables
inside single quotes will B<not> interpolated. This is the same
behavior as you know of perl itself.
In addition you can surround variable names with curly braces to
avoid misinterpretation by the parser.
=head1 SEE ALSO
L<Config::General>
=head1 AUTHORS
Thomas Linden <tom@daemon.de>
Autrijus Tang <autrijus@autrijus.org>
Wei-Hon Chen <plasmaball@pchome.com.tw>
=head1 COPYRIGHT
Copyright 2001 by Wei-Hon Chen E<lt>plasmaball@pchome.com.twE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See L<http://www.perl.com/perl/misc/Artistic.html>
=head1 VERSION
This document describes version 1.0 of B<Config::General::Interpolated>.
=cut

1
MANIFEST
View File

@@ -1,5 +1,6 @@
Changelog
General/Extended.pm
General/Interpolated.pm
General.pm
MANIFEST
Makefile.PL