Implement "direct addressing"

An experimental feature that allows the programmer to access configuration
settings as if they were methods of the configuration class. E.g. the
following setting

  .foo.bar.baz: 45

can be accessed as

  $cfg->tree->Foo->Bar->Baz

(Keyword names are capitalized to help distinguish them from the regular
methods. Also a dash in the setting name should be represented as __ when
using it as a method. Thus 'temp-dir' would become Temp__dir).

* lib/Config/Tree.pm (subtree): New method.
* lib/Config/Tree/Node.pm (is_leaf, is_null): New methods.
Overload bool, eq, and "".
* lib/Config/Tree/Node/Null.pm: New module.
* lib/Config/Tree/Node/Section.pm: Implement AUTOLOAD for accessing
settings as methods.
* lib/Config/Tree/Node/Value.pm: Implement as_string.

6 files changed, 95 insertions, 3 deletions

diff --git a/lib/Config/Tree.pm b/lib/Config/Tree.pm
index e379efa..45b934b 100644
--- a/lib/Config/Tree.pm
+++ b/lib/Config/Tree.pm
@@ -502,6 +502,11 @@ sub tree {
     return $self->{_tree} //= new Config::Tree::Node::Section(locus => new Config::Tree::Locus);
 }
 
+sub subtree {
+    my $self = shift;
+    return $self->tree->subtree(@_);
+}
+
 sub _get_section_synt {
     my ($self, $kw, $name) = @_;
 
diff --git a/lib/Config/Tree/Node.pm b/lib/Config/Tree/Node.pm
index 90fb8c4..79e105f 100644
--- a/lib/Config/Tree/Node.pm
+++ b/lib/Config/Tree/Node.pm
@@ -143,6 +143,16 @@ Returns true if node is a leaf node
     
 =cut    
 
+sub is_leaf { 0 }
+
+=head2 is_null
+
+Returns true if node is a null node
+
+=cut    
+
+sub is_null { 0 }
+
 =head2 is_section()
 
 Returns true if node represents a section.
@@ -151,7 +161,7 @@ Returns true if node represents a section.
 
 sub is_section { ! shift->is_leaf }
 
-=head2 is_section()
+=head2 is_value()
 
 Returns true if node represents a value (or statement).
 
@@ -234,6 +244,15 @@ sub flatten {
     return &{$sort}(grep { $_->[1]->is_value } @ar);
 }       
 
+use overload
+    bool => sub { 1 },
+    '""' => sub { shift->as_string },
+    eq => sub {
+        my ($self,$other) = @_;
+        return $self->as_string eq $other
+    };
+        
+
 1;
 
         
diff --git a/lib/Config/Tree/Node/Null.pm b/lib/Config/Tree/Node/Null.pm
new file mode 100644
index 0000000..f03e7a1
--- /dev/null
+++ b/lib/Config/Tree/Node/Null.pm
@@ -0,0 +1,26 @@
+package Config::Tree::Node::Null;
+use parent 'Config::Tree::Node';
+use strict;
+use warnings;
+use Carp;
+
+sub is_null { 1 }
+
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+    my $self = shift;
+    my $key = $AUTOLOAD;
+    $key =~ s/.*:://;
+    if ($key =~ s/^([A-Z])(.*)/\l$1$2/) {
+        return $self;
+    }
+    confess "Can't locate method $AUTOLOAD";
+}
+
+sub as_string { '(null)' }
+
+use overload
+    bool => sub { 0 };
+
+1;
diff --git a/lib/Config/Tree/Node/Section.pm b/lib/Config/Tree/Node/Section.pm
index b9d0620..8fec46b 100644
--- a/lib/Config/Tree/Node/Section.pm
+++ b/lib/Config/Tree/Node/Section.pm
@@ -2,6 +2,8 @@ package Config::Tree::Node::Section;
 use parent 'Config::Tree::Node';
 use strict;
 use warnings;
+use Carp;
+use Config::Tree::Node::Null;
 
 sub new {
     my $class = shift;
@@ -36,8 +38,6 @@ sub delete {
     delete $self->{_subtree}{$key};
 }
 
-sub is_leaf { 0 }
-
 sub merge {
     my ($self, $other) = @_;
     while (my ($k, $v) = each %{$other->subtree}) {
@@ -57,4 +57,20 @@ sub merge {
     }
 }
 
+sub as_string { '(section)' }
+
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+    my $self = shift;
+    my $key = $AUTOLOAD;
+    $key =~ s/.*:://;
+    if ($key =~ s/^([A-Z])(.*)/\l$1$2/) {
+        $key =~ s/__/-/g;
+        return $self->subtree($self->{_ci} ? lc($key) : $key)
+               // new Config::Tree::Node::Null;
+    }
+    confess "Can't locate method $AUTOLOAD";
+}
+
 1;
diff --git a/lib/Config/Tree/Node/Value.pm b/lib/Config/Tree/Node/Value.pm
index ee14159..c46a139 100644
--- a/lib/Config/Tree/Node/Value.pm
+++ b/lib/Config/Tree/Node/Value.pm
@@ -31,4 +31,9 @@ sub value {
 
 sub is_leaf { 1 };
 
+sub as_string {
+    my $self = shift;
+    return $self->value
+}
+
 1;
diff --git a/t/02conf01.t b/t/02conf01.t
new file mode 100644
index 0000000..b06d0dd
--- /dev/null
+++ b/t/02conf01.t
@@ -0,0 +1,21 @@
+# -*- perl -*-
+use lib qw(t lib);
+use strict;
+use Test;
+use TestConfig;
+use Data::Dumper;
+
+plan(tests => 4);
+
+my $t = new TestConfig(
+    config => [
+        base => '/etc',
+        'file.passwd.mode' => '0644',
+        'file.passwd.root.uid' => 0,
+        'file.passwd.root.dir' => '/root',
+    ]);
+
+ok($t->tree->File->Passwd->Root->Dir);
+ok($t->tree->File->Passwd->Root->Dir,'/root');
+ok($t->tree->File->Base->Name->is_null);
+ok(!$t->tree->File->Base->Name);