Re-implement case-insensitive lookups

* lib/Config/AST.pm (new): Use the lexicon method to store the
new lexicon.
Create the root node.
(root,mangle_key): New method.
(lexicon): Deep-copy the passed lexicon and preprocess its keys
using the _clone_lexicon method.
(_clone_lexicon): Auxiliary method for lexicon.
(describe_keyword): New method.
(all methods): Pass the "$self" argument to the Config::AST::Node::Section
constructor calls.
(add_node): Preprocess key names using mangle_key.
(DESTROY): Destroy the tree to break circular references.
* lib/Config/AST/Root.pm: New file.
* lib/Config/AST/Node/Section.pm (new): First argument is mandatory:
a reference to the root node or the owning Config::AST object.
(is_leaf,is_section): Provide definitions.
(root): New method.
(subtree): Use root->mangle_key to prepare the lookup key.
* lib/Config/AST/Node.pm (is_section): Return 0
* lib/Config/AST/Node/Value.pm: Likewise.

* t/02conf01.t: The "root" name is now reserved and cannot be used
in direct addressing.
* t/02merge.t: Pass obligatory argument to the Config::AST::Node::Section
constructor.

* lib/Config/AST/Follow.pm: Use L<> for cross-references.
* lib/Config/AST/Node/Null.pm: Likewise.

10 files changed, 263 insertions, 56 deletions

diff --git a/lib/Config/AST.pm b/lib/Config/AST.pm
index 4020387..c279e2f 100644
--- a/lib/Config/AST.pm
+++ b/lib/Config/AST.pm
@@ -26,2 +26,3 @@ use Config::AST::Node::Value;
 use Config::AST::Follow;
+use Config::AST::Root;
 use Data::Dumper;
@@ -301,23 +302,11 @@ sub new {
     my $v;
-    my $err;
 
     $self->{_debug} = delete $_{debug} || 0;
-    $self->{_ci} = delete $_{ci} || 0;
+    $self->{_root} = new Config::AST::Root(delete $_{ci} || 0);
 
     if (defined($v = delete $_{lexicon})) {
-	if (ref($v) eq 'HASH') {
-	    $self->{_lexicon} = $v;
-	} else {
-	    carp "lexicon must refer to a HASH";
-	    ++$err;
-	}
+	$self->lexicon($v);
     }
+    croak "unrecognized parameters" if keys(%_);
 
-    if (keys(%_)) {
-	foreach my $k (keys %_) {
-	    carp "unknown parameter $k"
-	}
-	++$err;
-    }
-    croak "can't create configuration instance" if $err;
     $self->reset;
@@ -326,2 +315,22 @@ sub new {
 
+=head2 $node = $cfg->root
+
+Returns the root node of the tree, initializing it if necessary.
+
+=cut
+
+sub root { shift->{_root} }
+
+=head2 $s = $r->mangle_key($name)
+
+Converts the string I<$name> to a form suitable for lookups, in accordance
+with the B<ci> parameter passed to the constructor.
+
+=cut
+
+sub mangle_key {
+    my ($self, $key) = @_;
+    return $self->root->mangle_key($key);
+}
+
 =head2 $cfg->lexicon($hashref)
@@ -340,3 +349,3 @@ sub lexicon {
 	$self->reset;
-        $self->{_lexicon} = $lexicon;
+        $self->_clone_lexicon($lexicon);
     }
@@ -345,2 +354,61 @@ sub lexicon {
 
+sub _clone_lexicon {
+    my ($self, $source_lex) = @_;
+    my @stk;
+    $self->{_lexicon} = {};
+    push @stk, [ $source_lex, $self->{_lexicon}, \&mangle_key ];
+    while (my $elt = pop @stk) {
+	while (my ($k, $v) = each %{$elt->[0]}) {
+	    if ($elt->[2]) {
+		$k = $self->${\$elt->[2]}($k);
+	    }
+	    
+	    my $copy;
+	    if (ref($v) eq 'HASH') {
+		$copy = {};
+   		push @stk, [ $v, $copy, 
+			     (!$elt->[2] && $k eq 'section')
+			       ? \&mangle_key : undef ];
+	    } else {
+		$copy = $v;
+	    }
+	    $elt->[1]{$k} = $copy;
+	}
+    }
+}
+
+=head2 $cfg->describe_keyword(@path)
+
+Returns a lexicon entry for the statement at I<@path>. If no such
+statement is defined, returns undef.
+
+=cut
+
+sub describe_keyword {
+    my $self = shift;
+    my $lex = $self->lexicon;
+    return '*' unless $lex;
+    while (my $k = shift @_) {
+	$k = $self->mangle_key($k);
+	if (my $next = (ref($lex) eq 'HASH'
+			? $lex->{$k} // $lex->{'*'}
+			: (($lex eq '*') ? $lex : undef))) {
+	    $lex = $next;
+	    if (ref($lex) eq 'HASH') {
+  	        if ($next = $lex->{section}) {
+		    $lex = $next if @_;
+		    next;
+		}
+	    } elsif ($lex eq '*') {
+		next;
+	    }
+	    last;
+	} else {
+	    return;
+	}
+    }
+    return if @_;
+    return $lex;
+}
+
 =head1 PARSING
@@ -451,2 +519,3 @@ sub fixup_tree {
 		$n = new Config::AST::Node::Section(
+		               $self,
 		               default => 1,
@@ -477,3 +546,4 @@ sub fixup_tree {
 		} else {
-		    my $node = new Config::AST::Node::Section;
+		    my $node =
+			new Config::AST::Node::Section($self);
 		    $self->fixup_tree($node, $d->{section}, @path, $k);
@@ -502,3 +572,3 @@ sub fixup_tree {
 		unless ($node = $section->subtree($k)) {
-		    $node = new Config::AST::Node::Section;
+		    $node = new Config::AST::Node::Section($self);
 		}
@@ -538,3 +608,5 @@ sub reset {
     $self->{_error_count} = 0;
-    delete $self->{_tree};
+    if ($self->root) {
+	$self->root->reset;
+    }
 }
@@ -618,6 +690,7 @@ sub getnode {
     my $self = shift;
-    
-    my $node = $self->{_tree} or return undef;
+
+    return undef if $self->root->empty;
+    my $node = $self->root->tree;
     for (@_) {
-	$node = $node->subtree($self->{_ci} ? lc($_) : $_)
+	$node = $node->subtree($_)
 	    or return undef;
@@ -687,6 +760,3 @@ sub is_variable {
 
-sub tree {
-    my $self = shift;
-    return $self->{_tree} //= new Config::AST::Node::Section(locus => new Text::Locus);
-}
+sub tree { shift->root->tree }
 
@@ -762,3 +832,6 @@ sub AUTOLOAD {
 
-sub DESTROY { }
+sub DESTROY {
+    my $self = shift;
+    $self->root->reset if $self->root;
+}
 
@@ -828,3 +901,3 @@ sub add_node {
     for (my $i = 0; $i < $pn; $i++) {
-	$name = ${$path}[$i];
+	$name = $self->mangle_key(${$path}[$i]);
 	
@@ -848,2 +921,3 @@ sub add_node {
 		$name => new Config::AST::Node::Section(
+		    $self,
 		    order => $self->{_order}++,
@@ -854,3 +928,3 @@ sub add_node {
 
-    $name = ${$path}[-1];
+    $name = $self->mangle_key(${$path}[-1]);
 
@@ -970,4 +1044,4 @@ sub set {
 	    $node = $node->subtree(
-		         $arg => new Config::AST::Node::Section
-		    );
+		$arg => new Config::AST::Node::Section($self)
+	    );
 	}
@@ -994,3 +1068,4 @@ sub unset {
 
-    my $node = $self->{_tree} or return;
+    return if $self->root->empty;
+    my $node = $self->root->tree;
     my @path;
@@ -1243,5 +1318,5 @@ sub lint {
 
-B<Config::AST::Node>.
+L<Config::AST::Node>.
 
-B<Config::Parser>.
+L<Config::Parser>.
 
@@ -1249,2 +1324,3 @@ B<Config::Parser>.
 
+
 1;
diff --git a/lib/Config/AST/Follow.pm b/lib/Config/AST/Follow.pm
index 4d996a5..cf05e34 100644
--- a/lib/Config/AST/Follow.pm
+++ b/lib/Config/AST/Follow.pm
@@ -55,3 +55,3 @@ within a particular section.
 
-B<Config::AST>(3).
+L<Config::AST>(3).
 
@@ -83,2 +83,4 @@ sub AUTOLOAD {
     (my $key = $m) =~ s/__/-/g;
+    $key = $self->{_node}->root->mangle_key($key)
+	if $self->{_node}->is_section;
     my $lex = $self->{_lex};
@@ -111,3 +113,3 @@ sub AUTOLOAD {
     if (!$self->{_node}->is_null) {
-	my $next = $self->{_node}->subtree($self->{_ci} ? lc($key) : $key)
+	my $next = $self->{_node}->subtree($key)
 	             // new Config::AST::Node::Null;
diff --git a/lib/Config/AST/Node.pm b/lib/Config/AST/Node.pm
index 131bc41..06da6db 100644
--- a/lib/Config/AST/Node.pm
+++ b/lib/Config/AST/Node.pm
@@ -184,3 +184,3 @@ Returns true if node represents a section.
 
-sub is_section { ! shift->is_leaf }
+sub is_section { 0 }
 
@@ -339,6 +339,6 @@ use overload
 
-B<Config::AST>,    
-B<Config::AST::Node::Null>,
-B<Config::AST::Node::Value>,
-B<Config::AST::Node::Section>.
+L<Config::AST>,    
+L<Config::AST::Node::Null>,
+L<Config::AST::Node::Value>,
+L<Config::AST::Node::Section>.
     
diff --git a/lib/Config/AST/Node/Null.pm b/lib/Config/AST/Node/Null.pm
index 699d49f..41242b1 100644
--- a/lib/Config/AST/Node/Null.pm
+++ b/lib/Config/AST/Node/Null.pm
@@ -81,4 +81,4 @@ use overload
 
-B<Config::AST>,    
-B<Config::AST::Node>.
+L<Config::AST>,    
+L<Config::AST::Node>.
 
diff --git a/lib/Config/AST/Node/Section.pm b/lib/Config/AST/Node/Section.pm
index 3343d95..4a825ab 100644
--- a/lib/Config/AST/Node/Section.pm
+++ b/lib/Config/AST/Node/Section.pm
@@ -33,2 +33,8 @@ Nodes of this class represent configuration sections in the AST.
     
+=head2 new(ROOT, ARG => VAL, ...)
+
+Creates new section object. I<ROOT> is the root object of the tree or the
+B<Config::AST> object. The I<ARG =E<gt> VAL> pairs are passed to
+the parent class constructor (see B<Config::AST::Node>).
+
 =cut
@@ -37,4 +43,10 @@ sub new {
     my $class = shift;
-    my $self = $class->SUPER::new(@_);
+    my $root = shift or croak "mandatory parameter missing";
+    local %_ = @_;
+    my $self = $class->SUPER::new(%_);
     $self->{_subtree} = {};
+    if ($root->isa('Config::AST')) {
+	$root = $root->root;
+    }
+    $self->{_root} = $root;
     return $self;
@@ -42,2 +54,7 @@ sub new {
 
+sub is_leaf { 0 }
+sub is_section { 1 }
+
+sub root { shift->{_root} }
+
 =head2 $t = $node->subtree
@@ -46,2 +63,11 @@ Returns tree containing all subordinate nodes of this node.
 
+=head2 $t = $node->subtree($key)
+
+Returns the subnode at I<$key> or B<undef> if there is no such subnode.
+
+=head2 $t = $node->subtree($key => $value)
+
+Creates new subnode with the given I<$key> and I<$value>.  Returns the
+created node.
+
 =cut    
@@ -51,2 +77,3 @@ sub subtree {
     if (my $key = shift) {
+	$key = $self->root->mangle_key($key);
 	if (my $val = shift) {
@@ -184,4 +211,4 @@ sub as_string { '(section)' }
 
-B<Config::AST>,    
-B<Config::AST::Node>.
+L<Config::AST>,    
+L<Config::AST::Node>.
 
diff --git a/lib/Config/AST/Node/Value.pm b/lib/Config/AST/Node/Value.pm
index 764c1b7..80da83e 100644
--- a/lib/Config/AST/Node/Value.pm
+++ b/lib/Config/AST/Node/Value.pm
@@ -89,2 +89,4 @@ sub is_leaf { 1 };
 
+sub is_section { 0 }
+
 =head2 $s = $node->as_string
@@ -160,4 +162,4 @@ use overload
 
-B<Config::AST>,    
-B<Config::AST::Node>.
+L<Config::AST>,    
+L<Config::AST::Node>.
 
diff --git a/lib/Config/AST/Root.pm b/lib/Config/AST/Root.pm
new file mode 100644
index 0000000..e0a6da8
--- /dev/null
+++ b/lib/Config/AST/Root.pm
@@ -0,0 +1,101 @@
+# This file is part of Config::AST                            -*- perl -*-
+# Copyright (C) 2017-2019 Sergey Poznyakoff <gray@gnu.org>
+#
+# Config::AST is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# Config::AST is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Config::AST.  If not, see <http://www.gnu.org/licenses/>.
+
+package Config::AST::Root;
+use strict;
+use warnings;
+
+=head1 NAME
+
+Config::AST::Root - root of the abstract syntax tree
+
+=head1 DESCRIPTION
+
+An auxiliary class representing the root of the abstract syntax tree.
+It is necessary because the tree itself forms a circular structure
+(due to the B<root> attribute of B<Config::AST::Node::Section>). Without
+this intermediate class (if B<root> pointed to B<Config::AST> itself),
+the structure would have never been destroyed, because each element
+would remain referenced at least once.
+
+=head1 CONSTRUCTOR
+
+=head2 $obj = new($ci)
+
+I<$ci> is one to enable case-insensitive keyword lookup, and 0 otherwise.
+
+=cut
+
+sub new {
+    my ($class, $ci) = @_;
+    bless { _ci => $ci }, $class;
+}
+
+=head1 METHODS
+
+=head2 $s = $r->mangle_key($name)
+
+Converts the string I<$name> to a form suitable for lookups, in accordance
+with the _ci attribute.
+
+=cut
+
+sub mangle_key {
+    my ($self, $key) = @_;
+    $self->{_ci} ? lc($key) : $key;
+}
+
+=head2 $r->reset
+
+Destroys the underlying syntax tree.
+
+=cut
+
+sub reset { delete shift->{_tree} }
+
+
+=head2 $t = $r->tree
+
+Returns the root node of the tree, initializing it if necessary.
+
+=cut
+
+sub tree {
+    my $self = shift;
+
+    return $self->{_tree} //=
+	        new Config::AST::Node::Section($self,
+	                                       locus => new Text::Locus);
+}
+
+=head2 $bool = $r->empty
+
+Returns true if the tree is empty.
+
+=cut
+
+sub empty {
+    my $self = shift;
+    return !($self->{_tree} && $self->{_tree}->keys > 0);
+}
+
+=head1 SEE ALSO
+
+L<Config::AST>.
+
+=cut
+
+1;
diff --git a/t/01conf01.t b/t/01conf01.t
index 5c91f7f..db307b7 100644
--- a/t/01conf01.t
+++ b/t/01conf01.t
@@ -17,2 +17 @@ ok($cfg->canonical, 'backend.foo.file="a" core.retain-interval=10 core.tempdir="
     
-    
diff --git a/t/02conf01.t b/t/02conf01.t
index 8176df8..b7becb7 100644
--- a/t/02conf01.t
+++ b/t/02conf01.t
@@ -12,4 +12,4 @@ my $t = new TestConfig(
 	'file.passwd.mode' => '0644',
-	'file.passwd.root.uid' => 0,
-	'file.passwd.root.dir' => '/root',
+	'file.passwd.main.uid' => 0,
+	'file.passwd.main.dir' => '/root',
     ],
@@ -22,3 +22,3 @@ my $t = new TestConfig(
 			mode => 1,
-			root => {
+			main => {
 			    section => {
@@ -48,4 +48,4 @@ ok($t->file->is_section);
 ok($t->file->passwd->is_section);
-ok($t->file->passwd->root->dir);
-ok($t->file->passwd->root->dir,'/root');
+ok($t->file->passwd->main->dir);
+ok($t->file->passwd->main->dir,'/root');
 ok($t->file->skel->is_null);
diff --git a/t/02merge.t b/t/02merge.t
index 5d3168c..f112271 100644
--- a/t/02merge.t
+++ b/t/02merge.t
@@ -18,3 +18,3 @@ my $t = new Config::AST(
 
-my $node = new Config::AST::Node::Section;
+my $node = new Config::AST::Node::Section($t);
 $node->subtree(number => new Config::AST::Node::Value(
@@ -27,3 +27,3 @@ $t->add_node(x => $node);
 
-$node = new Config::AST::Node::Section;
+$node = new Config::AST::Node::Section($t);
 $node->subtree(number => new Config::AST::Node::Value(