Bundle-PBib
view release on metacpan or search on metacpan
lib/Config/General.pm view on Meta::CPAN
#
# Config::General.pm - Generic Config Module
#
# Purpose: Provide a convenient way for loading
# config values from a given file and
# return it as hash structure
#
# Copyright (c) 2000-2002 Thomas Linden <tom@daemon.de>.
# All Rights Reserved. Std. disclaimer applies.
# Artificial License, same as perl itself. Have fun.
#
# namespace
package Config::General;
use FileHandle;
use File::Spec::Functions qw(catfile catpath splitpath file_name_is_absolute);
use strict;
use Carp;
use Exporter;
$Config::General::VERSION = "2.18";
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(ParseConfig SaveConfig SaveConfigString);
sub new {
#
# create new Config::General object
#
my($this, @param ) = @_;
my $class = ref($this) || $this;
# define default options
my $self = {
AllowMultiOptions => 1,
MergeDuplicateOptions => 0,
MergeDuplicateBlocks => 0,
LowerCaseNames => 0,
UseApacheInclude => 0,
IncludeRelative => 0,
AutoTrue => 0,
AutoTrueFlags => {
true => '^(on|yes|true|1)$',
false => '^(off|no|false|0)$',
},
DefaultConfig => {},
level => 1,
InterPolateVars => 0,
ExtendedAccess => 0,
SplitPolicy => 'guess', # also possible: whitespace, equalsign and custom
SplitDelimiter => 0, # must be set by the user if SplitPolicy is 'custom'
StoreDelimiter => 0, # will be set by me unless user uses 'custom' policy
CComments => 1, # by default turned on
StrictObjects => 1, # be strict on non-existent keys in OOP mode
StrictVars => 1, # be strict on undefined variables in Interpolate mode
parsed => 0,
upperkey => "",
lastkey => "",
prevkey => " ",
};
# create the class instance
bless($self,$class);
if ($#param >= 1) {
# use of the new hash interface!
my %conf = @param;
# save the parameter list for ::Extended's new() calls
$self->{Params} = \%conf;
# be backwards compatible
$self->{ConfigFile} = delete $conf{-file} if(exists $conf{-file});
$self->{ConfigHash} = delete $conf{-hash} if(exists $conf{-hash});
# store input, file, handle, or array
$self->{ConfigFile} = delete $conf{-ConfigFile} if(exists $conf{-ConfigFile});
$self->{ConfigPath} = delete $conf{-ConfigPath} if(exists $conf{-ConfigPath});
$self->{ConfigHash} = delete $conf{-ConfigHash} if(exists $conf{-ConfigHash});
# handle options which contains values we are needing (strings, hashrefs or the like)
if (exists $conf{-String} ) {
if ($conf{-String}) {
$self->{StringContent} = $conf{-String};
}
delete $conf{-String};
}
if (exists $conf{-FlagBits}) {
if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq "HASH") {
$self->{FlagBits} = 1;
$self->{FlagBitsFlags} = $conf{-FlagBits};
}
delete $conf{-FlagBits};
}
if (exists $conf{-DefaultConfig}) {
if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq "HASH") {
$self->{DefaultConfig} = $conf{-DefaultConfig};
}
elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq "") {
$self->_read($conf{-DefaultConfig}, "SCALAR");
$self->{DefaultConfig} = $self->_parse({}, $self->{content});
$self->{content} = ();
}
delete $conf{-DefaultConfig};
delete $conf{-BaseHash}; # ignore BaseHash if a default one was given
}
# handle options which may either be true or false
# allowing "human" logic about what is true and what is not
foreach my $entry (keys %conf) {
my $key = $entry;
$key =~ s/^\-//;
if (! exists $self->{$key}) {
croak "Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n";
}
if ($conf{$entry} =~ /$self->{AutoTrueFlags}->{true}/io) {
$self->{$key} = 1;
}
elsif ($conf{$entry} =~ /$self->{AutoTrueFlags}->{false}/io) {
$self->{$key} = 0;
}
else {
# keep it untouched
$self->{$key} = $conf{$entry};
}
}
if ($self->{MergeDuplicateOptions}) {
# override if not set by user
if (! exists $conf{-AllowMultiOptions}) {
$self->{AllowMultiOptions} = 0;
}
}
}
elsif ($#param == 0) {
# use of the old style
$self->{ConfigFile} = $param[0];
}
else {
# this happens if $#param == -1,1 thus no param was given to new!
$self->{config} = {};
$self->{parsed} = 1;
}
# prepare the split delimiter if needed
if ($self->{SplitPolicy} ne 'guess') {
if ($self->{SplitPolicy} eq 'whitespace') {
$self->{SplitDelimiter} = '\s+';
$self->{StoreDelimiter} = " " if(!$self->{StoreDelimiter});
}
elsif ($self->{SplitPolicy} eq 'equalsign') {
$self->{SplitDelimiter} = '\s*=\s*';
$self->{StoreDelimiter} = " = " if(!$self->{StoreDelimiter});
}
elsif ($self->{SplitPolicy} eq 'custom') {
if (! $self->{SplitDelimiter} ) {
croak "SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
}
}
else {
croak "Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
}
}
else {
$self->{StoreDelimiter} = " " if(!$self->{StoreDelimiter});
}
if ($self->{InterPolateVars}) {
#
# we are blessing here again, to get into the ::InterPolated namespace
# for inheriting the methods available overthere, which we doesn't have.
#
bless($self, "Config::General::Interpolated");
eval {
require Config::General::Interpolated;
};
if ($@) {
croak $@;
}
# pre-compile the variable regexp
$self->{regex} = $self->_set_regex();
}
# process as usual
if (!$self->{parsed}) {
if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
$self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig});
}
if (exists $self->{StringContent}) {
# consider the supplied string as config file
$self->_read($self->{StringContent}, "SCALAR");
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
elsif (exists $self->{ConfigHash}) {
if (ref($self->{ConfigHash}) eq "HASH") {
# initialize with given hash
$self->{config} = $self->{ConfigHash};
$self->{parsed} = 1;
}
else {
croak "Parameter -ConfigHash must be a hash reference!\n";
}
}
elsif (ref($self->{ConfigFile}) eq "GLOB" || ref($self->{ConfigFile}) eq "FileHandle") {
# use the file the glob points to
$self->_read($self->{ConfigFile});
lib/Config/General.pm view on Meta::CPAN
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) {
# inside here-doc, only look for $hierend marker
if (/^(\s*)\Q$hierend\E\s*$/) {
my $indent = $1; # preserve indentation
$hier .= " " . chr(182); # append a "¶" to the here-doc-name, so
# _parse will also preserver indentation
if ($indent) {
foreach (@hierdoc) {
s/^$indent//; # i.e. the end was: " EOF" then we remove " " from every here-doc line
$hier .= $_ . "\n"; # and store it in $hier
}
}
else {
$hier .= join "\n", @hierdoc; # there was no indentation of the end-string, so join it 1:1
}
push @{$this->{content}}, $hier; # push it onto the content stack
@hierdoc = ();
undef $hier;
undef $hierend;
}
else {
# everything else onto the stack
push @hierdoc, $_;
}
next;
}
###
### non-heredoc entries from now on
##
# Remove comments and empty lines
s/(?<!\\)#.+$//;
next if /^\s*#/;
next if /^\s*$/;
# remove the \ char in front of masked "#", if any
s/\\#/#/g;
# look for here-doc identifier
if ($this->{SplitPolicy} eq 'guess') {
if (/^\s*(\S+?)(\s*=\s*|\s+)<<\s*(.+?)\s*$/) {
$hier = $1; # the actual here-doc variable name
$hierend = $3; # the here-doc identifier, i.e. "EOF"
next;
}
}
else {
# no guess, use one of the configured strict split policies
if (/^\s*(\S+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) {
$hier = $1; # the actual here-doc variable name
$hierend = $3; # the here-doc identifier, i.e. "EOF"
next;
}
}
# look for multiline option, indicated by a trailing backslash
if (/\\$/) {
chop;
s/^\s*//;
$longline .= $_;
next;
}
###
### any "normal" config lines from now on
###
if ($longline) {
# previous stuff was a longline and this is the last line of the longline
s/^\s*//;
$longline .= $_;
push @{$this->{content}}, $longline; # push it onto the content stack
undef $longline;
next;
}
else {
# look for include statement(s)
my $incl_file;
if (/^\s*<<include\s+(.+?)>>\s*$/i || (/^\s*include\s+(.+?)\s*$/i && $this->{UseApacheInclude})) {
$incl_file = $1;
if ( $this->{IncludeRelative} && $this->{configpath} && !file_name_is_absolute($incl_file) ) {
# include the file from within location of $this->{configfile}
$this->_open($incl_file);
}
else {
# include the file from within pwd, or absolute
$this->_open($incl_file);
}
}
else {
# standard entry, (option = value)
push @{$this->{content}}, $_;
}
}
}
return 1;
}
sub _parse {
#
# parse the contents of the file
#
my($this, $config, $content) = @_;
my(@newcontent, $block, $blockname, $grab, $chunk,$block_level);
local $_;
my $indichar = chr(182); # ¶, inserted by _open, our here-doc indicator
foreach (@{$content}) { # loop over content stack
chomp;
$chunk++;
$_ =~ s/^\s*//; # strip spaces @ end and begin
$_ =~ s/\s*$//;
#
# build option value assignment, split current input
# using whitespace, equal sign or optionally here-doc
# separator (ascii 182).
my ($option,$value);
if (/$indichar/) {
($option,$value) = split /\s*$indichar\s*/, $_, 2; # separated by heredoc-finding in _open()
}
else {
if ($this->{SplitPolicy} eq 'guess') {
# again the old regex. use equalsign SplitPolicy to get the
# 2.00 behavior. the new regexes were too odd.
($option,$value) = split /\s*=\s*|\s+/, $_, 2;
}
else {
# no guess, use one of the configured strict split policies
($option,$value) = split /$this->{SplitDelimiter}/, $_, 2;
}
}
if ($value && $value =~ /^"/ && $value =~ /"$/) {
$value =~ s/^"//; # remove leading and trailing "
$value =~ s/"$//;
}
if (! defined $block) { # not inside a block @ the moment
if (/^<([^\/]+?.*?)>$/) { # look if it is a block
$block = $1; # store block name
($grab, $blockname) = split /\s\s*/, $block, 2; # is it a named block? if yes, store the name separately
if ($blockname) {
$block = $grab;
}
if ($this->{InterPolateVars}) {
# interpolate block(name), add "<" and ">" to the key, because
# it is sure that such keys does not exist otherwise.
$block = $this->_interpolate("<$block>", $block);
if ($blockname) {
$blockname = $this->_interpolate("<$blockname>", $blockname);
}
}
$block = lc($block) if $this->{LowerCaseNames}; # only for blocks lc(), if configured via new()
$this->{level} += 1;
undef @newcontent;
next;
}
elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block!
croak "EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
}
else { # insert key/value pair into actual node
$option = lc($option) if $this->{LowerCaseNames};
if (exists $config->{$option}) {
if ($this->{MergeDuplicateOptions}) {
$config->{$option} = $this->_parse_value($option, $value);
}
else {
if (! $this->{AllowMultiOptions} ) {
# no, duplicates not allowed
croak "Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
}
else {
# yes, duplicates allowed
if (ref($config->{$option}) ne "ARRAY") { # convert scalar to array
my $savevalue = $config->{$option};
delete $config->{$option};
push @{$config->{$option}}, $savevalue;
}
eval {
# check if arrays are supported by the underlying hash
my $i = scalar @{$config->{$option}};
};
if ($@) {
$config->{$option} = $this->_parse_value($option, $value);
}
else {
push @{$config->{$option}}, $this->_parse_value($option, $value); # it's already an array, just push
}
}
lib/Config/General.pm view on Meta::CPAN
# rcfile
Mode = BLAH | CLEAR
would result in this hash structure:
%config = (
Mode => {
CLEAR => 1,
UNSECURE => undef,
STRONG => undef,
}
);
"BLAH" will be ignored silently.
=item B<-DefaultConfig>
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,
which allows you to set default values for particular config options directly.
This hash will be used as the 'backing hash' instead of a standard perl hash,
which allows you to affect the way, variable storing will be done. You could, for
example supply a tied hash, say Tie::DxHash, which preserves ordering of the
keys in the config (which a standard perl hash won't do). Or, you could supply
a hash tied to a DBM file to save the parsed variables to disk.
There are many more things to do in tie-land, see L<tie> to get some interesting
ideas.
=item B<-InterPolateVars>
If set to a true value, variable interpolation will be done on your config
input. See L<Config::General::Interpolated> for more informations.
=item B<-ExtendedAccess>
If set to a true value, you can use object oriented (extended) methods to
access the parsed config. See L<Config::General::Extended> for more informations.
=item B<-StrictObjects>
By default this is turned on, which causes Config::General to croak with an
error if you try to access a non-existent key using the oop-way (B<-ExtendedAcess>
enabled). If you turn B<-StrictObjects> off (by setting to 0 or "no") it will
just return an empty object/hash/scalar. This is valid for OOP-access 8via AUTOLOAD
and for the methods obj(), hash() and value().
=item B<-StrictVars>
By default this is turned on, which causes Config::General to croak with an
error if an undefined variable with B<InterPolateVars> turned on occurs
in a config. Set to I<false> (i.e. 0) to avoid such error messages.
=item B<-SplitPolicy>
You can influence the way how Config::General decides which part of a line
in a config file is the key and which one is the value. By default it tries
it's best to guess. That means you can mix equalsign assignments and whitespace
assignments.
However, somtimes 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
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
latter case you must also set B<-SplitDelimiter> to some regular expression
of your choice. For example:
-SplitDelimiter => '\s*:\s*'
will cause the module to split by colon while whitespaces which surrounds
the delimiter will be removed.
Please note that the delimiter used when saving a config (save_file() or save_string())
will be choosen accordingto the current B<-SplitPolicy>. If -SplitPolicy is
set to 'guess' or 'whitespace', 3 whitespaces will be used to delimit saved
options. If 'custom' is set, then you need to set B<-StoreDelimiter>.
=item B<-SplitDelimiter>
Set this to any arbitrary regular expression which will be used for option/value
splitting. B<-SplitPolicy> must be set to 'custom' to make this work.
=item B<-StoreDelimiter>
You can use this parameter to specify a custom delimiter to use when saving
configs to a file or string. You only need to set it if you want to store
the config back to disk and if you have B<-SplitPolicy> set to 'custom'.
Be very carefull with this parameter.
=item B<-CComments>
Config::General is able to notice c-style comments (see section COMMENTS).
But for some reason you might no need this. In this case you can turn
this feature off by setting B<-CComments> to a false value('no', 0, 'off').
By default B<-CComments> is turned on.
=back
=item getall()
Returns a hash structure which represents the whole config.
=item save_file()
Writes the config hash back to the harddisk. This method takes one or two
parameters. The first parameter must be the filename where the config
should be written to. The second parameter is optional, it must be a
reference to a hash structure, if you set it. If you do not supply this second parameter
then the internal config hash, which has already been parsed, will be
used.
Please note, that any occurence of comments will be ignored by getall()
and thus be lost after you call this method.
You need also to know that named blocks will be converted to nested blocks
(which is the same from the perl point of view). An example:
<user hans>
id 13
</user>
will become the following after saving:
<user>
<hans>
id 13
</hans>
</user>
( run in 0.683 second using v1.01-cache-2.11-cpan-39bf76dae61 )