diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2018-05-04 08:49:19 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2018-05-04 08:49:19 +0200 |
commit | 783e1a2e76f1bdc90fd72557b9117c4a5101a36f (patch) | |
tree | 0bf278403e8107fa86a80f6da392c9e81dedfd0b | |
parent | 150fc09a517fa8708690a0f9384f168a124d0a75 (diff) | |
download | config-ast-783e1a2e76f1bdc90fd72557b9117c4a5101a36f.tar.gz config-ast-783e1a2e76f1bdc90fd72557b9117c4a5101a36f.tar.bz2 |
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.
-rw-r--r-- | lib/Config/Tree.pm | 5 | ||||
-rw-r--r-- | lib/Config/Tree/Node.pm | 21 | ||||
-rw-r--r-- | lib/Config/Tree/Node/Null.pm | 26 | ||||
-rw-r--r-- | lib/Config/Tree/Node/Section.pm | 20 | ||||
-rw-r--r-- | lib/Config/Tree/Node/Value.pm | 5 | ||||
-rw-r--r-- | t/02conf01.t | 21 |
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); |