summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2019-08-27 15:24:29 +0300
committerSergey Poznyakoff <gray@gnu.org.ua>2019-08-27 15:24:29 +0300
commit745a02db1c53ed90e89bb9c6f57db450d2011106 (patch)
tree659e1d828417cc08ada30a12e8d1bfd3d4a2a3a4
parent058e552bd37c0acf9d3a10fc743ac4d76d579b45 (diff)
downloadconfig-ast-745a02db1c53ed90e89bb9c6f57db450d2011106.tar.gz
config-ast-745a02db1c53ed90e89bb9c6f57db450d2011106.tar.bz2
Improve commit / lint API
* lib/Config/AST.pm (commit): Take optional keyword arguments. (lint): The argument (reference to a lexicon) is optional.
-rw-r--r--lib/Config/AST.pm60
1 files changed, 44 insertions, 16 deletions
diff --git a/lib/Config/AST.pm b/lib/Config/AST.pm
index 837bbac..fb10569 100644
--- a/lib/Config/AST.pm
+++ b/lib/Config/AST.pm
@@ -370,37 +370,57 @@ Abstract method that is supposed to actually parse the configuration file
and build the parse tree from it. Derived classes must overload it.
The must return true on success and false on failure. Eventual errors in
the configuration should be reported using B<error>.
=cut
sub parse {
my ($self) = @_;
croak "call to abstract method"
}
-=head2 $cfg->commit
+=head2 $cfg->commit([%hash])
Must be called after B<parse> to finalize the parse tree. This function
-does the actual syntax checking and applied default values to the statements
-where such are defined. Returns true on success.
+applies default values on settings where such are defined.
+
+Optional arguments control what steps are performed.
+
+=over 4
+
+=item lint => 1
+
+Forse syntax checking. This can be necessary if new nodes were added to
+the tree after parsing.
+
+=item lexicon => I<$hashref>
+
+Override the lexicon used for syntax checking and default value processing.
+
+=back
+
+Returns true on success.
=cut
sub commit {
- my ($self) = @_;
- # FIXME
- $self->fixup_tree($self->tree, $self->{_lexicon})
- if exists $self->{_lexicon};
+ my ($self, %opts) = @_;
+ my $lint = delete $opts{lint};
+ my $lexicon = delete $opts{lexicon} // $self->lexicon;
+ croak "unrecognized arguments" if keys(%opts);
+ if ($lexicon) {
+ $self->lint_subtree($lexicon, $self->tree) if $lint;
+ $self->fixup_tree($self->tree, $lexicon);
+ }
return $self->{_error_count} == 0;
}
sub fixup_tree {
my ($self, $section, $params, @path) = @_;
while (my ($k, $d) = each %{$params}) {
next unless ref($d) eq 'HASH';
if (exists($d->{default}) && !$section->has_key($k)) {
my $n;
my $dfl = ref($d->{default}) eq 'CODE'
@@ -756,25 +776,29 @@ sub _section_lexicon {
use constant TAINT => eval '${^TAINT}';
use constant TESTS => TAINT && defined eval 'require Taint::Util';
=head2 $cfg->add_node($path, $node)
Adds the node in the node corresponding to B<$path>. B<$path> can be
either a list of keyword names, or its string representation, where
names are separated by dots. I.e., the following two calls are equivalent:
$cfg->add_node(qw(core pidfile), $node)
$cfg->add_node('core.pidfile', $node)
-
+
+If the node already exists at B<$path>, new node is merged to it according
+to the lexical rules. I.e., for scalar value, new node overwrites the old
+one. For lists, it is appended to the list.
+
=cut
sub add_node {
my ($self, $path, $node) = @_;
unless (ref($path) eq 'ARRAY') {
$path = [ split(/\./, $path) ]
}
my $kw = $self->{_lexicon} // { '*' => '*' };
my $tree = $self->tree;
my $pn = $#{$path};
@@ -882,36 +906,43 @@ sub add_node {
$newnode = $tree->subtree($name => $node);
}
$newnode->order($self->{order}++);
$newnode->value($v);
return $newnode;
}
=head2 $cfg->add_value($path, $value, $locus)
Adds a statement node with the given B<$value> and B<$locus> in position,
indicated by $path.
+If the setting already exists at B<$path>, the new value is merged to it
+according to the lexical rules. I.e., for scalars, B<$value> overwrites
+prior setting. For lists, it is appended to the list.
+
=cut
sub add_value {
my ($self, $path, $value, $locus) = @_;
$self->add_node($path, new Config::AST::Node::Value(value => $value,
- locus => $locus));
+ locus => $locus));
}
=head2 $cfg->set(@path, $value)
Sets the configuration variable B<@path> to B<$value>.
+No syntax checking is performed. To enforce syntax checking use
+B<add_value>.
+
=cut
sub set {
my $self = shift;
my $node = $self->tree;
while ($#_ > 1) {
croak "not a section" unless $node->is_section;
my $arg = shift;
if (my $n = $node->subtree($arg)) {
$node = $n;
} else {
@@ -1160,42 +1191,39 @@ sub lint_subtree {
} elsif (exists($lexicon->{'*'})) {
$self->lint_node($lexicon->{'*'}, $value, @path, $var);
} elsif ($value->is_section) {
next;
} else {
$self->error("keyword \"$var\" is unknown",
locus => $value->locus);
$self->{_error_count}++;
}
}
}
-=head2 $cfg->lint(\%lex)
+=head2 $cfg->lint([\%lex])
-Checks the syntax according to the keyword lexicon B<%lex>. On success,
+Checks the syntax according to the keyword lexicon B<%lex> (or
+B<$cfg-E<gt>lexicon>, if called without arguments). On success,
applies eventual default values and returns true. On errors, reports
them using B<error> and returns false.
This method provides a way to delay syntax checking for a later time,
which is useful, e.g. if some parts of the parser are loaded as modules
after calling B<parse>.
=cut
sub lint {
my ($self, $lexicon) = @_;
-
-# $synt->{'*'} = { section => { '*' => 1 }} ;
- $self->lint_subtree($lexicon, $self->tree);
- $self->fixup_tree($self->tree, $lexicon);
- return $self->{_error_count} == 0;
+ return $self->commit(lint => 1, lexicon => $lexicon);
}
=head1 SEE ALSO
B<Config::AST::Node>.
B<Config::Parser>.
=cut
1;

Return to:

Send suggestions and report system problems to the System administrator.