mirror of
https://codeberg.org/scip/Config-General.git
synced 2025-12-18 13:10:59 +01:00
2.14 - fixed bug reported by Francisco Olarte Sanz
<folarte@peoplecall.com>, which caused _parse to ignore blocks with the name "0": <0> .. </0>, because it checked just if $block (the name between < and >) is true, and from the perl point of view "0" is not. Changed it to check for defined. Normally I avoid using 'defined' but in this case it will not be possible that $block contains the empty string, so defined is ok here. git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@40 be1acefe-a474-0410-9a34-9b3221f2030f
This commit is contained in:
10
Changelog
10
Changelog
@@ -1,3 +1,13 @@
|
|||||||
|
2.14 - fixed bug reported by Francisco Olarte Sanz
|
||||||
|
<folarte@peoplecall.com>, which caused _parse to
|
||||||
|
ignore blocks with the name "0":
|
||||||
|
<0> .. </0>, because it checked just if $block (the name
|
||||||
|
between < and >) is true, and from the perl point
|
||||||
|
of view "0" is not. Changed it to check for defined.
|
||||||
|
Normally I avoid using 'defined' but in this case
|
||||||
|
it will not be possible that $block contains the
|
||||||
|
empty string, so defined is ok here.
|
||||||
|
|
||||||
2.13 - fixed bug reported by Steffen Schwigon <schwigon@webit.de>.
|
2.13 - fixed bug reported by Steffen Schwigon <schwigon@webit.de>.
|
||||||
the parser was still active inside a here-doc, which
|
the parser was still active inside a here-doc, which
|
||||||
cause weird results if the here-doc contained
|
cause weird results if the here-doc contained
|
||||||
|
|||||||
@@ -17,7 +17,7 @@ use strict;
|
|||||||
use Carp;
|
use Carp;
|
||||||
use Exporter;
|
use Exporter;
|
||||||
|
|
||||||
$Config::General::VERSION = "2.13";
|
$Config::General::VERSION = "2.14";
|
||||||
|
|
||||||
use vars qw(@ISA @EXPORT);
|
use vars qw(@ISA @EXPORT);
|
||||||
@ISA = qw(Exporter);
|
@ISA = qw(Exporter);
|
||||||
@@ -491,7 +491,7 @@ sub _parse {
|
|||||||
$value =~ s/^"//; # remove leading and trailing "
|
$value =~ s/^"//; # remove leading and trailing "
|
||||||
$value =~ s/"$//;
|
$value =~ s/"$//;
|
||||||
}
|
}
|
||||||
if (!$block) { # not inside a block @ the moment
|
if (! defined $block) { # not inside a block @ the moment
|
||||||
if (/^<([^\/]+?.*?)>$/) { # look if it is a block
|
if (/^<([^\/]+?.*?)>$/) { # look if it is a block
|
||||||
$this->{level} += 1;
|
$this->{level} += 1;
|
||||||
$block = $1; # store block name
|
$block = $1; # store block name
|
||||||
@@ -1788,7 +1788,7 @@ Thomas Linden <tom@daemon.de>
|
|||||||
|
|
||||||
=head1 VERSION
|
=head1 VERSION
|
||||||
|
|
||||||
2.13
|
2.14
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|||||||
8
t/cfg.4
8
t/cfg.4
@@ -1,12 +1,4 @@
|
|||||||
/*
|
|
||||||
# Here-document test
|
# Here-document test
|
||||||
message = <<EOF
|
|
||||||
yes. we are not here. you
|
|
||||||
can reach us somewhere in
|
|
||||||
outerspace.
|
|
||||||
# and this line will remain inside the here-doc!
|
|
||||||
EOF
|
|
||||||
*/
|
|
||||||
|
|
||||||
header = <<EOF
|
header = <<EOF
|
||||||
<table border="0">
|
<table border="0">
|
||||||
|
|||||||
47
t/run.t
47
t/run.t
@@ -11,12 +11,15 @@ use lib "blib/lib";
|
|||||||
use Config::General;
|
use Config::General;
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
|
|
||||||
|
sub pause;
|
||||||
|
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # loading Config::General\n";
|
print STDERR " .. ok # loading Config::General\n";
|
||||||
|
|
||||||
|
|
||||||
foreach (2..7) {
|
foreach (2..7) {
|
||||||
&p("t/cfg." . $_, $_);
|
&p("t/cfg." . $_, $_);
|
||||||
|
pause;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $conf = new Config::General("t/cfg.8");
|
my $conf = new Config::General("t/cfg.8");
|
||||||
@@ -33,13 +36,13 @@ my $b = \%copyhash;
|
|||||||
# one we got from cfg.8
|
# one we got from cfg.8
|
||||||
if (&comp($a,$b)) {
|
if (&comp($a,$b)) {
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Writing Config Hash to disk and compare with original\n";
|
print STDERR " ... ok # Writing Config Hash to disk and compare with original\n";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
print "8 not ok\n";
|
print "8 not ok\n";
|
||||||
print STDERR "8 .. not ok\n";
|
print STDERR "8 ... not ok\n";
|
||||||
}
|
}
|
||||||
|
pause;
|
||||||
|
|
||||||
############## Extended Tests #################
|
############## Extended Tests #################
|
||||||
|
|
||||||
@@ -47,8 +50,8 @@ $conf = new Config::General(
|
|||||||
-ExtendedAccess => 1,
|
-ExtendedAccess => 1,
|
||||||
-ConfigFile => "t/test.rc");
|
-ConfigFile => "t/test.rc");
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Creating a new object from config file\n";
|
print STDERR " ... ok # Creating a new object from config file\n";
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -59,29 +62,29 @@ my $conf2 = new Config::General(
|
|||||||
-AllowMultiOptions => "yes"
|
-AllowMultiOptions => "yes"
|
||||||
);
|
);
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Creating a new object using the hash parameter way\n";
|
print STDERR " ... ok # Creating a new object using the hash parameter way\n";
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
my $domain = $conf->obj("domain");
|
my $domain = $conf->obj("domain");
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Creating a new object from a block\n";
|
print STDERR " .. ok # Creating a new object from a block\n";
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
my $addr = $domain->obj("bar.de");
|
my $addr = $domain->obj("bar.de");
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Creating a new object from a sub block\n";
|
print STDERR " .. ok # Creating a new object from a sub block\n";
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
my @keys = $conf->keys("domain");
|
my @keys = $conf->keys("domain");
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Getting values from the object\n";
|
print STDERR " .. ok # Getting values from the object\n";
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -98,7 +101,7 @@ if ($conf->is_hash("domain")) {
|
|||||||
}
|
}
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Using keys() and values() \n";
|
print STDERR " .. ok # Using keys() and values() \n";
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -115,7 +118,7 @@ $conf3->save_file("t/test.cfg");
|
|||||||
|
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Using AUTOLOAD methods\n";
|
print STDERR " .. ok # Using AUTOLOAD methods\n";
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -130,7 +133,7 @@ else {
|
|||||||
print "16 not ok\n";
|
print "16 not ok\n";
|
||||||
print STDERR "16 not ok\n";
|
print STDERR "16 not ok\n";
|
||||||
}
|
}
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
# testing value pre-setting using a hash
|
# testing value pre-setting using a hash
|
||||||
@@ -149,6 +152,7 @@ else {
|
|||||||
print "17 not ok\n";
|
print "17 not ok\n";
|
||||||
print STDERR "17 not ok\n";
|
print STDERR "17 not ok\n";
|
||||||
}
|
}
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
# testing value pre-setting using a string
|
# testing value pre-setting using a string
|
||||||
@@ -167,10 +171,10 @@ else {
|
|||||||
print "18 not ok\n";
|
print "18 not ok\n";
|
||||||
print STDERR "18 not ok\n";
|
print STDERR "18 not ok\n";
|
||||||
}
|
}
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
# testing various otion/value assignment notations
|
||||||
# testing various otion/value assignemnt notations
|
|
||||||
my $conf19 = new Config::General(-file => "t/cfg.19");
|
my $conf19 = new Config::General(-file => "t/cfg.19");
|
||||||
my %h19 = $conf19->getall();
|
my %h19 = $conf19->getall();
|
||||||
my $works = 1;
|
my $works = 1;
|
||||||
@@ -181,13 +185,13 @@ foreach my $key (keys %h19) {
|
|||||||
}
|
}
|
||||||
if ($works) {
|
if ($works) {
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok # Testing various otion/value assignemnt notations\n";
|
print STDERR " .. ok # Testing various otion/value assignment notations\n";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
print "19 not ok\n";
|
print "19 not ok\n";
|
||||||
print STDERR "19 not ok\n";
|
print STDERR "19 not ok\n";
|
||||||
}
|
}
|
||||||
|
pause;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -203,7 +207,7 @@ sub p {
|
|||||||
my $conf = new Config::General($cfg);
|
my $conf = new Config::General($cfg);
|
||||||
my %hash = $conf->getall;
|
my %hash = $conf->getall;
|
||||||
print "ok\n";
|
print "ok\n";
|
||||||
print STDERR " .. ok $fst\n";
|
print STDERR " ... ok $fst\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
sub comp {
|
sub comp {
|
||||||
@@ -221,3 +225,10 @@ sub comp {
|
|||||||
}
|
}
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub pause {
|
||||||
|
# we are pausing between tests
|
||||||
|
# so the output gets not confused
|
||||||
|
# by stderr/stdout "collisions"
|
||||||
|
select undef, undef, undef, 0.3;
|
||||||
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user