diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2019-08-27 15:24:29 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2019-08-27 15:24:29 +0300 |
commit | 745a02db1c53ed90e89bb9c6f57db450d2011106 (patch) | |
tree | 659e1d828417cc08ada30a12e8d1bfd3d4a2a3a4 | |
parent | 058e552bd37c0acf9d3a10fc743ac4d76d579b45 (diff) | |
download | config-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.pm | 60 |
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; |