summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2018-05-04 06:49:19 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2018-05-04 06:49:19 (GMT)
commit783e1a2e76f1bdc90fd72557b9117c4a5101a36f (patch) (side-by-side diff)
tree0bf278403e8107fa86a80f6da392c9e81dedfd0b
parent150fc09a517fa8708690a0f9384f168a124d0a75 (diff)
downloadconfig-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.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--lib/Config/Tree.pm5
-rw-r--r--lib/Config/Tree/Node.pm21
-rw-r--r--lib/Config/Tree/Node/Null.pm26
-rw-r--r--lib/Config/Tree/Node/Section.pm20
-rw-r--r--lib/Config/Tree/Node/Value.pm5
-rw-r--r--t/02conf01.t21
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
--- a/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
--- a/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);

Return to:

Send suggestions and report system problems to the System administrator.