mirror of
https://codeberg.org/scip/Config-General.git
synced 2025-12-17 04:31:00 +01:00
2.09 - added bugfix in '#' comment parsing. If current state
was within a block, then /^ #/ was not ignored as comment but instead added as variable. Reported by Lupe Christoph <lupe@lupe-christoph.de> - added -StrictObjects parameter support in the following ::Extended methods: hash() and value(). - added better parameter checks in the ::Extended::obj() method. Its now no more possible to create a new (sub-) object from an undefined key or a key which does not point to a hash reference. - simplified storing of ConfigFile and ConfigHash in new() removed my variable $configfile. - the original parameter list will now be saved, which is required for ::Extended to create new objects with the same config as their parents. git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@35 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
20
Changelog
20
Changelog
@@ -1,3 +1,23 @@
|
|||||||
|
2.09 - added bugfix in '#' comment parsing. If current state
|
||||||
|
was within a block, then /^ #/ was not ignored as
|
||||||
|
comment but instead added as variable. Reported by
|
||||||
|
Lupe Christoph <lupe@lupe-christoph.de>
|
||||||
|
|
||||||
|
- added -StrictObjects parameter support in the following
|
||||||
|
::Extended methods: hash() and value().
|
||||||
|
|
||||||
|
- added better parameter checks in the ::Extended::obj()
|
||||||
|
method. Its now no more possible to create a new (sub-)
|
||||||
|
object from an undefined key or a key which does not
|
||||||
|
point to a hash reference.
|
||||||
|
|
||||||
|
- simplified storing of ConfigFile and ConfigHash in new()
|
||||||
|
removed my variable $configfile.
|
||||||
|
|
||||||
|
- the original parameter list will now be saved, which is
|
||||||
|
required for ::Extended to create new objects with the
|
||||||
|
same config as their parents.
|
||||||
|
|
||||||
2.08 - added option -StrictVars, which causes Interpolate.pm to
|
2.08 - added option -StrictVars, which causes Interpolate.pm to
|
||||||
ignore undefined variables and replaces such occurences
|
ignore undefined variables and replaces such occurences
|
||||||
with the emppty string.
|
with the emppty string.
|
||||||
|
|||||||
52
General.pm
52
General.pm
@@ -17,7 +17,7 @@ use strict;
|
|||||||
use Carp;
|
use Carp;
|
||||||
use Exporter;
|
use Exporter;
|
||||||
|
|
||||||
$Config::General::VERSION = "2.08";
|
$Config::General::VERSION = "2.09";
|
||||||
|
|
||||||
use vars qw(@ISA @EXPORT);
|
use vars qw(@ISA @EXPORT);
|
||||||
@ISA = qw(Exporter);
|
@ISA = qw(Exporter);
|
||||||
@@ -28,10 +28,8 @@ sub new {
|
|||||||
# create new Config::General object
|
# create new Config::General object
|
||||||
#
|
#
|
||||||
my($this, @param ) = @_;
|
my($this, @param ) = @_;
|
||||||
my($configfile);
|
|
||||||
my $class = ref($this) || $this;
|
my $class = ref($this) || $this;
|
||||||
|
|
||||||
|
|
||||||
# define default options
|
# define default options
|
||||||
my $self = {
|
my $self = {
|
||||||
AllowMultiOptions => 1,
|
AllowMultiOptions => 1,
|
||||||
@@ -81,12 +79,17 @@ sub new {
|
|||||||
if ($#param >= 1) {
|
if ($#param >= 1) {
|
||||||
# use of the new hash interface!
|
# use of the new hash interface!
|
||||||
my %conf = @param;
|
my %conf = @param;
|
||||||
$configfile = delete $conf{-file} if(exists $conf{-file}); # be backwards compatible
|
|
||||||
$configfile = delete $conf{-ConfigFile} if(exists $conf{-ConfigFile});
|
|
||||||
$configfile = delete $conf{-hash} if(exists $conf{-hash}); # be backwards compatible
|
|
||||||
$configfile = delete $conf{-ConfigHash} if(exists $conf{-ConfigHash});
|
|
||||||
|
|
||||||
|
# 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->{ConfigHash} = delete $conf{-ConfigHash} if(exists $conf{-ConfigHash});
|
||||||
|
|
||||||
# handle options which contains values we are needing (strings, hashrefs or the like)
|
# handle options which contains values we are needing (strings, hashrefs or the like)
|
||||||
if (exists $conf{-String} ) {
|
if (exists $conf{-String} ) {
|
||||||
@@ -145,7 +148,7 @@ sub new {
|
|||||||
}
|
}
|
||||||
elsif ($#param == 0) {
|
elsif ($#param == 0) {
|
||||||
# use of the old style
|
# use of the old style
|
||||||
$configfile = $param[0];
|
$self->{ConfigFile} = $param[0];
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# this happens if $#param == -1,1 thus no param was given to new!
|
# this happens if $#param == -1,1 thus no param was given to new!
|
||||||
@@ -183,22 +186,27 @@ sub new {
|
|||||||
$self->_read($self->{StringContent}, "SCALAR");
|
$self->_read($self->{StringContent}, "SCALAR");
|
||||||
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
|
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
|
||||||
}
|
}
|
||||||
elsif (ref($configfile) eq "HASH") {
|
elsif (exists $self->{ConfigHash}) {
|
||||||
# initialize with given hash
|
if (ref($self->{ConfigHash}) eq "HASH") {
|
||||||
$self->{config} = $configfile;
|
# initialize with given hash
|
||||||
$self->{parsed} = 1;
|
$self->{config} = $self->{ConfigHash};
|
||||||
|
$self->{parsed} = 1;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
croak "Parameter -ConfigHash must be a hash reference!\n";
|
||||||
|
}
|
||||||
}
|
}
|
||||||
elsif (ref($configfile) eq "GLOB" || ref($configfile) eq "FileHandle") {
|
elsif (ref($self->{ConfigFile}) eq "GLOB" || ref($self->{ConfigFile}) eq "FileHandle") {
|
||||||
# use the file the glob points to
|
# use the file the glob points to
|
||||||
$self->_read($configfile);
|
$self->_read($self->{ConfigFile});
|
||||||
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
|
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
if ($configfile) {
|
if ($self->{ConfigFile}) {
|
||||||
# open the file and read the contents in
|
# open the file and read the contents in
|
||||||
$self->{configfile} = $configfile;
|
$self->{configfile} = $self->{ConfigFile};
|
||||||
# look if is is an absolute path and save the basename if it is absolute
|
# look if is is an absolute path and save the basename if it is absolute
|
||||||
($self->{configpath}) = $configfile =~ /^(\/.*)\//;
|
($self->{configpath}) = $self->{ConfigFile} =~ /^(\/.*)\//;
|
||||||
$self->_open($self->{configfile});
|
$self->_open($self->{configfile});
|
||||||
# now, we parse immdediately, getall simply returns the whole hash
|
# now, we parse immdediately, getall simply returns the whole hash
|
||||||
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
|
$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
|
||||||
@@ -317,7 +325,7 @@ sub _read {
|
|||||||
|
|
||||||
if (!$hierend) { # patch by "Manuel Valente" <manuel@ripe.net>:
|
if (!$hierend) { # patch by "Manuel Valente" <manuel@ripe.net>:
|
||||||
s/(?<!\\)#.+$//; # Remove comments
|
s/(?<!\\)#.+$//; # Remove comments
|
||||||
next if /^#/; # Remove lines beginning with "#"
|
next if /^\s*#/; # Remove lines beginning with "#"
|
||||||
next if /^\s*$/; # Skip empty lines
|
next if /^\s*$/; # Skip empty lines
|
||||||
s/\\#/#/g; # remove the \ char in front of masked "#"
|
s/\\#/#/g; # remove the \ char in front of masked "#"
|
||||||
}
|
}
|
||||||
@@ -1123,8 +1131,10 @@ access the parsed config. See L<Config::General::Extended> for more informations
|
|||||||
=item B<-StrictObjects>
|
=item B<-StrictObjects>
|
||||||
|
|
||||||
By default this is turned on, which causes Config::General to croak with an
|
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. If you turn
|
error if you try to access a non-existent key using the oop-way (B<-ExtendedAcess
|
||||||
B<-StrictObjects> off (by setting to 0 or "no") it will just return undef.
|
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<-SplitPolicy>
|
=item B<-SplitPolicy>
|
||||||
|
|
||||||
@@ -1697,7 +1707,7 @@ Thomas Linden <tom@daemon.de>
|
|||||||
|
|
||||||
=head1 VERSION
|
=head1 VERSION
|
||||||
|
|
||||||
2.08
|
2.09
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|||||||
@@ -23,7 +23,7 @@ use vars qw(@ISA @EXPORT);
|
|||||||
use strict;
|
use strict;
|
||||||
|
|
||||||
|
|
||||||
$Config::General::Extended::VERSION = "1.8";
|
$Config::General::Extended::VERSION = "1.9";
|
||||||
|
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
@@ -40,15 +40,21 @@ sub obj {
|
|||||||
#
|
#
|
||||||
my($this, $key) = @_;
|
my($this, $key) = @_;
|
||||||
if (exists $this->{config}->{$key}) {
|
if (exists $this->{config}->{$key}) {
|
||||||
if (!$this->{config}->{$key}) {
|
if (!$this->{config}->{$key} || ref($this->{config}->{$key}) ne "HASH") {
|
||||||
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => {} ); # empty object!
|
if ($this->{StrictObjects}) {
|
||||||
|
croak "key \"$key\" does not point to a hash reference!\n";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
# be cool, create an empty object!
|
||||||
|
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => {}, %{$this->{Params}} );
|
||||||
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => $this->{config}->{$key} );
|
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => $this->{config}->{$key}, %{$this->{Params}} );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => $this->{config} );
|
return $this->SUPER::new( -ExtendedAccess => 1, -ConfigHash => $this->{config}, %{$this->{Params}} );
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -63,7 +69,17 @@ sub value {
|
|||||||
$this->{config}->{$key} = $value;
|
$this->{config}->{$key} = $value;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return $this->{config}->{$key} if(exists $this->{config}->{$key});
|
if (exists $this->{config}->{$key}) {
|
||||||
|
return $this->{config}->{$key};
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if ($this->{StrictObjects}) {
|
||||||
|
croak "Key \"$key\" does not exist within current object\n";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -74,7 +90,17 @@ sub hash {
|
|||||||
# as hash
|
# as hash
|
||||||
#
|
#
|
||||||
my($this, $key) = @_;
|
my($this, $key) = @_;
|
||||||
return %{$this->{config}->{$key}} if(exists $this->{config}->{$key});
|
if (exists $this->{config}->{$key}) {
|
||||||
|
return %{$this->{config}->{$key}};
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if ($this->{StrictObjects}) {
|
||||||
|
croak "Key \"$key\" does not exist within current object\n";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return ();
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@@ -84,7 +110,15 @@ sub array {
|
|||||||
# as array
|
# as array
|
||||||
#
|
#
|
||||||
my($this, $key) = @_;
|
my($this, $key) = @_;
|
||||||
return @{$this->{config}->{$key}} if(exists $this->{config}->{$key});
|
if (exists $this->{config}->{$key}) {
|
||||||
|
return @{$this->{config}->{$key}};
|
||||||
|
}
|
||||||
|
if ($this->{StrictObjects}) {
|
||||||
|
croak "Key \"$key\" does not exist within current object\n";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return ();
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@@ -232,10 +266,10 @@ sub AUTOLOAD {
|
|||||||
}
|
}
|
||||||
elsif (exists $this->{config}->{$key}) {
|
elsif (exists $this->{config}->{$key}) {
|
||||||
if ($this->is_hash($key)) {
|
if ($this->is_hash($key)) {
|
||||||
croak "\"$key\" points to a hash and cannot be automatically accessed\n";
|
croak "Key \"$key\" points to a hash and cannot be automatically accessed\n";
|
||||||
}
|
}
|
||||||
elsif ($this->is_array($key)) {
|
elsif ($this->is_array($key)) {
|
||||||
croak "\"$key\" points to an array and cannot be automatically accessed\n";
|
croak "Key \"$key\" points to an array and cannot be automatically accessed\n";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return $this->{config}->{$key};
|
return $this->{config}->{$key};
|
||||||
@@ -243,11 +277,11 @@ sub AUTOLOAD {
|
|||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
if ($this->{StrictObjects}) {
|
if ($this->{StrictObjects}) {
|
||||||
croak "\"$key\" does not exist within current object\n";
|
croak "Key \"$key\" does not exist within current object\n";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
# be cool
|
# be cool
|
||||||
return undef;
|
return "";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -505,7 +539,7 @@ Thomas Linden <tom@daemon.de>
|
|||||||
|
|
||||||
=head1 VERSION
|
=head1 VERSION
|
||||||
|
|
||||||
1.8
|
1.9
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user