diff --git a/Changelog b/Changelog index 1787faf..0579269 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,22 @@ + 2.28 + - added internal list of files opened so far to avoid + reading in the same file multiple times. + Suggested by Michael Graham. + + - added new method files() which returns the above list. + + - added workaround for foolish perl installation on + debian systems (croak() doesn't work anymore as of + 5.8.4, it's a shame!) + + - applied patch by Michael Graham which fixes IncludeRelative + feature, now an included file is being included relative + to the calling config file, not the first one. + + - added 'make test' targets for files() and include + stuff. (by Michael too) + + 2.27 - bugfix in _store, which caused warning when saving a config containing empty hashes. Reported by diff --git a/General.pm b/General.pm index 7ccbfaa..dfe3e07 100644 --- a/General.pm +++ b/General.pm @@ -5,7 +5,7 @@ # config values from a given file and # return it as hash structure # -# Copyright (c) 2000-2004 Thomas Linden . +# Copyright (c) 2000-2005 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artificial License, same as perl itself. Have fun. # @@ -15,10 +15,18 @@ package Config::General; use FileHandle; use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath); use strict; + +# on debian with perl > 5.8.4 croak() doesn't work anymore without this. +# There is some require statement which dies 'cause it can't find Carp::Heavy, +# I really don't understand, what the hell they made, but the debian perl +# installation is definetly bullshit, damn! +use Carp::Heavy; + + use Carp; use Exporter; -$Config::General::VERSION = "2.27"; +$Config::General::VERSION = "2.28"; use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @@ -80,6 +88,7 @@ sub new { upperkey => "", lastkey => "", prevkey => " ", + files => {}, # which files we have read, if any }; # create the class instance @@ -298,6 +307,14 @@ sub getall { } +sub files { + # + # return a list of files opened so far + # + my($this) = @_; + return (exists $this->{files} ? keys %{$this->{files}} : () ); +} + sub _open { # @@ -323,8 +340,22 @@ sub _open { } if (-e $configfile) { - open $fh, "<$configfile" or croak "Could not open $configfile!($!)\n"; - $this->_read($fh); + if (exists $this->{files}->{$configfile} ) { + # do not read the same file twice, just return + # FIXME: should we croak here, when some "debugging" is enabled? + return; + } + else { + open $fh, "<$configfile" or croak "Could not open $configfile!($!)\n"; + + $this->{files}->{$configfile} = 1; + + my ($volume, $path, undef) = splitpath($configfile); + $this->{'CurrentConfigFilePath'} = catpath($volume, $path, ''); + + $this->_read($fh); + undef $this->{'CurrentConfigFilePath'}; + } } else { if (defined $this->{ConfigPath}) { @@ -496,7 +527,10 @@ sub _read { # look for include statement(s) my $incl_file; my $path = ""; - if (defined($this->{ConfigPath})) { + if ( $this->{IncludeRelative} and defined($this->{CurrentConfigFilePath})) { + $path = $this->{CurrentConfigFilePath}; + } + elsif (defined($this->{ConfigPath})) { # fetch pathname of base config file, assuming the 1st one is the path of it $path = $this->{ConfigPath}->[0]; } @@ -567,9 +601,15 @@ sub _parse { 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 ($block =~ /^"/ && $block =~ /"$/) { + # quoted block, unquote it and do not split + $block =~ s/"//g; + } + else { + ($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 @@ -965,6 +1005,11 @@ sub _write_hash { my $indent = " " x $level; my $config_string; + if ($entry =~ /\s/) { + # quote the entry if it contains whitespaces + $entry = '"' . $entry . '"'; + } + $config_string .= $indent . "<" . $entry . ">\n"; $config_string .= $this->_store($level + 1, %{$line}); $config_string .= $indent . "\n"; @@ -1333,7 +1378,7 @@ 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. +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 @@ -1450,6 +1495,9 @@ By default it is turned off. Returns a hash structure which represents the whole config. +=item files() + +Returns a list of all files read in. =item save_file() @@ -1657,6 +1705,42 @@ You cannot have more than one named block with the same name because it will be stored in a hashref and therefore be overwritten if a block occurs once more. +=head1 WHITESPACES IN BLOCKS + +The normal behavior of Config::General is to look for whitespaces in +block names to decide if it's a named block or just a simple block. + +Sometimes you may need blocknames which have whitespaces in their names. + +With named blocks this is no problem, as the module only looks for the +first whitespace: + + + + +would be parsed to: + + $VAR1 = { + 'person' => { + 'hugo gera' => { + }, + } + }; + +The problem occurs, if you want to have a simple block containing whitespaces: + + + + +This would be parsed as a named block, which is not what you wanted. In this +very case you may use quotation marks to indicate that it is not a named block: + + <"hugo gera"> + + +The save() method of the module inserts automatically quotation marks in such +cases. + =head1 EXPICIT EMPTY BLOCKS @@ -1688,7 +1772,7 @@ Example: log log2 You will get a scalar if the option occured only once or an array if it occured -more than once. If you expect multiple identical options, then you may need to +more than once. If you expect multiple identical options, then you may need to check if an option occured more than once: $allowed = $hash{jonas}->{tablestructure}->{allowed}; @@ -1968,7 +2052,7 @@ I recommend you to read the following documentations, which are supplied with pe =head1 COPYRIGHT -Copyright (c) 2000-2004 Thomas Linden +Copyright (c) 2000-2005 Thomas Linden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -1985,7 +2069,7 @@ Thomas Linden =head1 VERSION -2.27 +2.28 =cut diff --git a/General/Extended.pm b/General/Extended.pm index 7482c5d..18b60ac 100644 --- a/General/Extended.pm +++ b/General/Extended.pm @@ -1,7 +1,7 @@ # # Config::General::Extended - special Class based on Config::General # -# Copyright (c) 2000-2004 Thomas Linden . +# Copyright (c) 2000-2005 Thomas Linden . # All Rights Reserved. Std. disclaimer applies. # Artificial License, same as perl itself. Have fun. # @@ -522,7 +522,7 @@ values under the given key will be overwritten. =head1 COPYRIGHT -Copyright (c) 2000-2004 Thomas Linden +Copyright (c) 2000-2005 Thomas Linden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/General/Interpolated.pm b/General/Interpolated.pm index 06db12e..ee9acf1 100644 --- a/General/Interpolated.pm +++ b/General/Interpolated.pm @@ -1,3 +1,12 @@ +# +# Config::General::Interpolated - special Class based on Config::General +# +# Copyright (c) 2001 by Wei-Hon Chen . +# Copyright (c) 2000-2005 by Thomas Linden . +# All Rights Reserved. Std. disclaimer applies. +# Artificial License, same as perl itself. Have fun. +# + package Config::General::Interpolated; $Config::General::Interpolated::VERSION = "2.04"; diff --git a/Makefile.PL b/Makefile.PL index 53ccc6e..92a9950 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,3 +1,11 @@ +# +# Makefile.PL - build file for Config::General +# +# Copyright (c) 2000-2005 Thomas Linden . +# All Rights Reserved. Std. disclaimer applies. +# Artificial License, same as perl itself. Have fun. +# + use ExtUtils::MakeMaker; diff --git a/README b/README index 229646c..57578c4 100644 --- a/README +++ b/README @@ -80,11 +80,11 @@ UPDATE COPYRIGHT Config::General Config::General::Extended - Copyright (c) 2000-2003 by Thomas Linden + Copyright (c) 2000-2005 by Thomas Linden Config::General::Interpolated Copyright (c) 2001 by Wei-Hon Chen - Copyright (c) 2002-2003 by Thomas Linden . + Copyright (c) 2002-2005 by Thomas Linden . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -104,4 +104,4 @@ AUTHOR VERSION - 2.27 + 2.28 diff --git a/t/cfg.20.b b/t/cfg.20.b new file mode 100644 index 0000000..53af75b --- /dev/null +++ b/t/cfg.20.b @@ -0,0 +1,2 @@ +seen_cfg.20.b = true +<> diff --git a/t/cfg.20.c b/t/cfg.20.c new file mode 100644 index 0000000..ba9e0fd --- /dev/null +++ b/t/cfg.20.c @@ -0,0 +1,2 @@ +seen_cfg.20.c = true +last = cfg.20.c diff --git a/t/run.t b/t/run.t index a598fdd..551fcca 100644 --- a/t/run.t +++ b/t/run.t @@ -6,7 +6,7 @@ # # Under normal circumstances every test should succeed. -BEGIN { $| = 1; print "1..19\n";} +BEGIN { $| = 1; print "1..22\n";} use lib "blib/lib"; use Config::General; use Data::Dumper; @@ -194,6 +194,87 @@ else { pause; +# testing files() method +my $conf20 = Config::General->new( + -file => "t/cfg.20.a", + -MergeDuplicateOptions => 1 +); +my %h20 = $conf20->getall(); + +my %expected_h20 = ( + 'seen_cfg.20.a' => 'true', + 'seen_cfg.20.b' => 'true', + 'seen_cfg.20.c' => 'true', + 'last' => 'cfg.20.c', +); + +my %files = map { $_ => 1 } $conf20->files(); + +my %expected_files = map { $_ => 1 } ( + 't/cfg.20.a', + 't/cfg.20.b', + 't/cfg.20.c', +); + +if (&comp(\%h20, \%expected_h20) and &comp(\%files, \%expected_files)) { + print "ok\n"; + print STDERR " .. ok # testing files() method\n"; +} +else { + print "20 not ok\n"; + print STDERR "20 not ok\n"; +} +pause; + +# testing improved IncludeRelative option + +# First try without -IncludeRelative +# this should fail +eval { + my $conf21 = Config::General->new( + -file => "t/sub1/sub2/sub3/cfg.sub3", + -MergeDuplicateOptions => 1, + ); +}; +if ($@) { + print "ok\n"; + print STDERR " .. ok # prevented from loading relative cfgs without -IncludeRelative\n"; +} +else { + print "21 not ok\n"; + print STDERR "21 not ok\n"; +} +pause; + +# Now try with -IncludeRelative +# this should fail + +my $conf22 = Config::General->new( + -file => "t/sub1/sub2/sub3/cfg.sub3", + -MergeDuplicateOptions => 1, + -IncludeRelative => 1, +); + +my %h22 = $conf22->getall; +my %expected_h22 = ( + 'sub3_seen' => 'yup', + 'sub2_seen' => 'yup', + 'sub1_seen' => 'yup', + 'fruit' => 'mango', +); + +if (&comp(\%h22, \%expected_h22)) { + print "ok\n"; + print STDERR " .. ok # loaded relative to included files\n"; +} +else { + print "22 not ok\n"; + print STDERR "22 not ok\n"; +} +pause; + + + # all subs here diff --git a/t/sub1/cfg.sub1 b/t/sub1/cfg.sub1 new file mode 100644 index 0000000..1ad8c8c --- /dev/null +++ b/t/sub1/cfg.sub1 @@ -0,0 +1,3 @@ +fruit = mango +sub3_seen = yup + diff --git a/t/sub1/sub2/cfg.sub2 b/t/sub1/sub2/cfg.sub2 new file mode 100644 index 0000000..a6aaf96 --- /dev/null +++ b/t/sub1/sub2/cfg.sub2 @@ -0,0 +1,4 @@ +fruit = pear +sub2_seen = yup + +<> \ No newline at end of file diff --git a/t/sub1/sub2/sub3/cfg.sub3 b/t/sub1/sub2/sub3/cfg.sub3 new file mode 100644 index 0000000..450ffd7 --- /dev/null +++ b/t/sub1/sub2/sub3/cfg.sub3 @@ -0,0 +1,5 @@ +fruit = apple +sub3_seen = yup + +<> +