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

2.20

Browse Source 
- fixed bug reported by Stefano di Sandro <stedis@ulis.it>: in
 	   OOP mode (extended access) the obj() method returned the whole
	   config object if the given key does not exist. Now it returns
	   a new empty object.

	 - added patch by David Dick <david_dick@iprimus.com.au> which
	   sets $/ if it is unset.

	 - added patch by David Dick <david_dick@iprimus.com.au> which
	   calls the binmode() function in case the modules is being
	   used under win32 systems. Read perldoc -f binmode for more
	   informations on this issue.

	 - added feature suggested by Chase Phillips <cmp@uiuc.edu>:
	   the new() method has a new parameter -Tie which takes the
	   name of a Tie class that each new hash should be based off
	   of. This makes it possible to create a config hash with
	   ordered contents across nested structures.


git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@46 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
Thomas von Dein
2009-10-10 16:28:06 +00:00
parent 66621adfb8
commit 8167848582
4 changed files with 114 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

107
General.pm
View File

@@ -18,7 +18,7 @@ use strict;
use Carp;
use Exporter;
$Config::General::VERSION = "2.19";
$Config::General::VERSION = "2.20";
use vars qw(@ISA @EXPORT);
@ISA = qw(Exporter);
@@ -72,7 +72,9 @@ sub new {
StrictVars => 1, # be strict on undefined variables in Interpolate mode
parsed => 0,
Tie => "", # could be set to a perl module for tie'ing new hashes
parsed => 0, # internal state stuff for variable interpolation
upperkey => "",
lastkey => "",
prevkey => " ",
@@ -107,6 +109,14 @@ sub new {
}
delete $conf{-String};
}
if (exists $conf{-Tie}) {
if ($conf{-Tie}) {
$self->{Tie} = delete $conf{-Tie};
$self->{DefaultConfig} = $self->_hashref();
}
}
if (exists $conf{-FlagBits}) {
if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq "HASH") {
$self->{FlagBits} = 1;
@@ -121,11 +131,10 @@ sub new {
}
elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq "") {
$self->_read($conf{-DefaultConfig}, "SCALAR");
$self->{DefaultConfig} = $self->_parse({}, $self->{content});
$self->{DefaultConfig} = $self->_parse($self->_hashref(), $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
@@ -161,7 +170,7 @@ sub new {
}
else {
# this happens if $#param == -1,1 thus no param was given to new!
$self->{config} = {};
$self->{config} = $this->_hashref();
$self->{parsed} = 1;
}
@@ -207,7 +216,7 @@ sub new {
# process as usual
if (!$self->{parsed}) {
if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
$self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig});
$self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig}); # FIXME: _hashref() ?
}
if (exists $self->{StringContent}) {
# consider the supplied string as config file
@@ -242,11 +251,12 @@ sub new {
}
$self->_open($self->{configfile});
# now, we parse immdediately, getall simply returns the whole hash
$self->{config} = $self->_hashref();
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
}
else {
# hm, no valid config file given, so try it as an empty object
$self->{config} = {};
$self->{config} = $this->_hashref();
$self->{parsed} = 1;
}
}
@@ -301,8 +311,15 @@ sub _open {
}
}
local ($/) = $/;
unless ($/) {
carp("\$/ (INPUT_RECORD_SEPARATOR) is undefined. Guessing you want a line feed character");
$/ = "\n";
}
if (-e $configfile) {
open $fh, "<$configfile" or croak "Could not open $configfile!($!)\n";
binmode($fh);
$this->_read($fh);
}
else {
@@ -582,17 +599,17 @@ sub _parse {
}
}
}
elsif (/^<([^\/]+?.*?)>$/) { # found a start block inside a block, don't forget it
$block_level++; # $block_level indicates wether we are still inside a node
push @newcontent, $_; # push onto new content stack for later recursive call of _parse()
elsif (/^<([^\/]+?.*?)>$/) { # found a start block inside a block, don't forget it
$block_level++; # $block_level indicates wether we are still inside a node
push @newcontent, $_; # push onto new content stack for later recursive call of _parse()
}
elsif (/^<\/(.+?)>$/) {
if ($block_level) { # this endblock is not the one we are searching for, decrement and push
$block_level--; # if it is 0, then the endblock was the one we searched for, see below
push @newcontent, $_; # push onto new content stack
if ($block_level) { # this endblock is not the one we are searching for, decrement and push
$block_level--; # if it is 0, then the endblock was the one we searched for, see below
push @newcontent, $_; # push onto new content stack
}
else { # calling myself recursively, end of $block reached, $block_level is 0
if ($blockname) { # a named block, make it a hashref inside a hash within the current node
else { # calling myself recursively, end of $block reached, $block_level is 0
if ($blockname) { # a named block, make it a hashref inside a hash within the current node
$this->_savelast($blockname);
if (exists $config->{$block}->{$blockname}) { # the named block already exists, make it an array
if ($this->{MergeDuplicateBlocks}) {
@@ -614,7 +631,7 @@ sub _parse {
else {
push @ar, $savevalue;
}
push @ar, $this->_parse( {}, \@newcontent); # append it
push @ar, $this->_parse( $this->_hashref(), \@newcontent); # append it
$config->{$block}->{$blockname} = \@ar;
}
}
@@ -625,7 +642,8 @@ sub _parse {
}
else {
# the first occurence of this particular named block
$config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
#### $config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
$config->{$block}->{$blockname} = $this->_parse($this->_hashref(), \@newcontent);
}
$this->_backlast($blockname);
}
@@ -651,14 +669,15 @@ sub _parse {
else {
push @ar, $savevalue;
}
push @ar, $this->_parse( {}, \@newcontent);
push @ar, $this->_parse( $this->_hashref(), \@newcontent);
$config->{$block} = \@ar;
}
}
}
else {
# the first occurence of this particular block
$config->{$block} = $this->_parse($config->{$block}, \@newcontent);
#### $config->{$block} = $this->_parse($config->{$block}, \@newcontent);
$config->{$block} = $this->_parse($this->_hashref(), \@newcontent);
}
$this->_backlast($block);
}
@@ -925,6 +944,30 @@ sub _write_hash {
}
sub _hashref {
#
# return a probably tied new empty hash ref
#
my($this) = @_;
my ($package, $filename, $line, $subroutine, $hasargs,
$wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(0);
if ($this->{Tie}) {
eval {
eval "require $this->{Tie}";
};
if ($@) {
croak "Could not create a tied hash of type: " . $this->{Tie} . ": " . $@;
}
my %hash;
tie %hash, $this->{Tie};
return \%hash;
}
else {
return {};
}
}
#
# Procedural interface
@@ -1257,6 +1300,12 @@ 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.
=item B<-Tie>
B<-Tie> takes the name of a Tie class as argument that each new hash should be
based off of.
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
@@ -1266,6 +1315,24 @@ 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.
If you want to use the B<-Tie> feature together with B<-DefaultConfig> make sure
that the hash supplied to B<-DefaultConfig> must be tied to the same Tie class.
Make sure that the hash which receives the generated hash structure (e.g. which
you are using in the assignment: %hash = $config->getall()) must be tied to
the same Tie class.
Example:
use Config::General;
use Tie::IxHash;
tie my %hash, "Tie::IxHash";
%hash = ParseConfig(
-ConfigFile => shift(),
-Tie => "Tie::IxHash"
);
=item B<-InterPolateVars>
If set to a true value, variable interpolation will be done on your config
@@ -1861,7 +1928,7 @@ Thomas Linden <tom@daemon.de>
=head1 VERSION
2.19
2.20
=cut