mirror of
https://codeberg.org/scip/Config-General.git
synced 2025-12-16 20:21:01 +01:00
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. 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
207
General/Interpolated.pm
Normal file
207
General/Interpolated.pm
Normal 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
|
||||
|
||||
Reference in New Issue
Block a user