From b906f49050fc5c1ce2fcd4da3f78dd291674c9a3 Mon Sep 17 00:00:00 2001 From: Thomas von Dein Date: Sat, 10 Oct 2009 16:14:18 +0000 Subject: [PATCH] 1.28: - added contributed sub module Config::General::Interpolated by "Wei-Hon Chen" with help from "Autrijus Tang" 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 --- Changelog | 18 ++++ General.pm | 81 +++++++++------- General/Interpolated.pm | 207 ++++++++++++++++++++++++++++++++++++++++ MANIFEST | 1 + 4 files changed, 272 insertions(+), 35 deletions(-) create mode 100644 General/Interpolated.pm diff --git a/Changelog b/Changelog index 61ee7e1..678e40d 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,21 @@ + 1.28: + - added contributed sub module Config::General::Interpolated + by "Wei-Hon Chen" with + help from "Autrijus Tang" + 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. diff --git a/General.pm b/General.pm index f9bfae3..4994939 100644 --- a/General.pm +++ b/General.pm @@ -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" : - 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" : s/(?{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*<>\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*<>\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, 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, +which is supplied with the Config::General distribution. =head1 SEE ALSO @@ -1011,7 +1022,7 @@ Thomas Linden =head1 VERSION -1.27 +1.28 =cut diff --git a/General/Interpolated.pm b/General/Interpolated.pm new file mode 100644 index 0000000..43f9c74 --- /dev/null +++ b/General/Interpolated.pm @@ -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 + # , 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. 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. + + +Please refer to the L 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 + + instance = INTERN + owner = $user # "t_space" + logdir = $basedir/log # "/opt/ora/log" + sys = macos + + misc1 = ${sys}_${instance} # macos_INTERN + misc2 = $user # "t_space" + +
+ +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 has been defined twice. Inside +the block a variable ${sys} has been used, which then were +interpolated into the value of B defined inside the +block, not the sys variable one level above. If sys were not defined +inside the
block then the "global" variable B would have +been used instead with the value of "unix". + +Variables inside double quotes will be interpolated, but variables +inside single quotes will B 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 + +=head1 AUTHORS + + Thomas Linden + Autrijus Tang + Wei-Hon Chen + +=head1 COPYRIGHT + +Copyright 2001 by Wei-Hon Chen Eplasmaball@pchome.com.twE. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See L + +=head1 VERSION + +This document describes version 1.0 of B. + +=cut + diff --git a/MANIFEST b/MANIFEST index 2f1511e..5dcecb5 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,5 +1,6 @@ Changelog General/Extended.pm +General/Interpolated.pm General.pm MANIFEST Makefile.PL