aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-03-04 18:05:51 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2017-03-04 18:05:51 +0200
commit9dbc51556ad400f03495b3b85b0b5995362cd35c (patch)
tree20416ffc86e3a3c5d0614a37cebe629bc30479cc
parentbf855bb78bb759d1f733cdb21032e5fbfa403572 (diff)
downloadbeam-9dbc51556ad400f03495b3b85b0b5995362cd35c.tar.gz
beam-9dbc51556ad400f03495b3b85b0b5995362cd35c.tar.bz2
Improve config syntax verification.
Fix processing of the '*' entry in the syntax hashes. The entry '*' => '*' in the syntax hash declares that any settings and any subsections are also allowed.
-rw-r--r--lib/App/Beam/Config.pm64
-rw-r--r--t/TestConfig.pm3
-rw-r--r--t/conf02.t6
-rw-r--r--t/conf06.t2
-rw-r--r--t/conf07.t57
5 files changed, 119 insertions, 13 deletions
diff --git a/lib/App/Beam/Config.pm b/lib/App/Beam/Config.pm
index 32c1a32..829e6e3 100644
--- a/lib/App/Beam/Config.pm
+++ b/lib/App/Beam/Config.pm
@@ -126,6 +126,16 @@ of the statement appends its value to the end of the array.
Defines a regular expression to which must be matched by the value of the
setting, otherwise a syntax error will be reported.
+=item select => I<coderef>
+
+Points to a function to be called to decide whether to apply this hash to
+a particular configuration setting. The function is called as
+
+ &{$coderef}($vref, @path)
+
+where $vref is a reference to the setting (use $vref->{-value}, to obtain
+the actual value), and @path is its patname.
+
=item check => I<coderef>
Defines a code which will be called after parsing the statement in order to
@@ -168,7 +178,28 @@ and is allowed to have any other settings as well.
'*' => 1
}
}
-
+
+Everything said above applies to the B<'*'> as well. E.g. the following
+example declares the B<[code]> section, which must have the B<pidfile>
+setting and is allowed to have I<subsections> with arbitrary settings.
+
+ code => {
+ section => {
+ pidfile = { mandatory => 1 },
+ '*' => {
+ section => {
+ '*' => 1
+ }
+ }
+ }
+ }
+
+The special entry
+
+ '*' => '*'
+
+means "any settings and any subsections".
+
=cut
sub new {
@@ -313,9 +344,26 @@ sub parse_section {
} unless ref($ref->{$name}) eq 'HASH';
$ref = $ref->{$name};
- if (defined($kw)
- and ref($kw) eq 'HASH' and exists($kw->{$name}{section})) {
- $kw = $kw->{$name}{section};
+ if (defined($kw) and ref($kw) eq 'HASH') {
+ my $synt;
+ if (exists($kw->{$name})) {
+ $synt = $kw->{$name};
+ } elsif (exists($kw->{'*'})) {
+ $synt = $kw->{'*'};
+ if ($synt eq '*') {
+ $name = undef;
+ next;
+ }
+ }
+ if (defined($synt)
+ && ref($synt) eq 'HASH'
+ && exists($synt->{section})) {
+ $kw = $synt->{section};
+ } else {
+ $kw = undef;
+ }
+ } else {
+ $kw = undef;
}
$name = undef;
@@ -416,13 +464,9 @@ sub readconfig {
new App::Beam::Config::Locus($file, $line));
if (exists($self->{parameters}) and !defined($kw)) {
$self->error("unknown section",
- locus => new App::Beam::Config::Locus($file, $line));
+ locus => $section->{-locus});
$self->{error_count}++;
}
- $section->{-locus} =
- new App::Beam::Config::Locus($file, $line)
- unless exists $section->{-locus};
- $section->{-order} = $self->{order}++;
}
} elsif (/([\w_-]+)\s*=\s*(.*)/) {
my ($k, $v) = ($1, $2);
@@ -1037,6 +1081,6 @@ sub lint {
$self->check_mandatory($synt, $self->{conf});
return 0 if $self->{error_count};
$self->fixup($synt);
- return !$self->{error_count};
+ return $self->{error_count} == 0;
}
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
index 7f8f232..f1577a5 100644
--- a/t/TestConfig.pm
+++ b/t/TestConfig.pm
@@ -96,10 +96,11 @@ sub lint {
my $exp = $self->{expected_errors} = delete $_{expect};
carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_));
- $self->SUPER::lint($synt);
+ my $ret = $self->SUPER::lint($synt);
if ($exp && @{$self->{expected_errors}}) {
$self->{status} = 0;
$self->error("not all expected errors reported");
}
+ return $ret;
}
diff --git a/t/conf02.t b/t/conf02.t
index 55e7b86..b6a45d6 100644
--- a/t/conf02.t
+++ b/t/conf02.t
@@ -16,7 +16,11 @@ my %keywords = (
},
backend => {
section => {
- file => 1
+ '*' => {
+ section => {
+ file => 1
+ }
+ }
}
}
);
diff --git a/t/conf06.t b/t/conf06.t
index af40c24..5e5176f 100644
--- a/t/conf06.t
+++ b/t/conf06.t
@@ -15,7 +15,7 @@ my %keywords = (
'verbose' => 1,
}
},
- '*' => 1
+ '*' => '*'
);
my $cfg = new TestConfig(parameters => \%keywords);
diff --git a/t/conf07.t b/t/conf07.t
new file mode 100644
index 0000000..20b2ecf
--- /dev/null
+++ b/t/conf07.t
@@ -0,0 +1,57 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use Test;
+use TestConfig;
+use Data::Dumper;
+
+plan(tests => 2);
+
+my %keywords = (
+ core => {
+ section => {
+ 'retain-interval' => { mandatory => 1 },
+ 'tempdir' => 1,
+ 'verbose' => 1,
+ }
+ },
+ '*' => '*'
+);
+
+my $cfg = new TestConfig(parameters => \%keywords);
+ok($cfg->canonical, 'core.retain-interval=10 item.bar.backend="mysql" item.bar.database="quux" item.foo.backend="tar" item.foo.directory="baz"');
+
+my %subkw = (
+ item => {
+ section => {
+ '*' => {
+ select => sub {
+ my ($vref) = @_;
+ return 0 unless ref($vref) eq 'HASH';
+ return $vref->{backend}->{-value} eq 'tar';
+ },
+ section => {
+ backend => 1,
+ directory => {
+ mandatory => 1,
+ }
+ }
+ }
+ }
+ }
+);
+
+ok($cfg->lint(\%subkw));
+
+__DATA__
+# This is a sample configuration file
+[core]
+ retain-interval = 10
+[item foo]
+ backend = tar
+ directory = baz
+[item bar]
+ backend = mysql
+ database = quux
+
+

Return to:

Send suggestions and report system problems to the System administrator.