summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2019-08-23 10:40:38 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2019-08-23 10:40:48 (GMT)
commita4a87bed9b7dbb2c8d35ad3b32b39b53b1eae517 (patch) (side-by-side diff)
tree2aa084bc29a818284bd5f6b4075888b93a937363
parenta9ee653da53f5e4e8158620d44a458f48400ac52 (diff)
downloadconfig-ast-a4a87bed9b7dbb2c8d35ad3b32b39b53b1eae517.tar.gz
config-ast-a4a87bed9b7dbb2c8d35ad3b32b39b53b1eae517.tar.bz2
Rewrite direct access engine
This changes the syntax of direct addressing. To access the node a.b.c, one can simply write $cfg->a->b->c Node names cannot coincide with existing method names, as the latter will take precedence. * lib/Config/AST.pm (AUTOLOAD): Bootstrap direct addressing mechanism. * lib/Config/AST/Follow.pm: New module. * lib/Config/AST/Node/Section.pm (AUTOLOAD): Remove. * t/01conf12.t: Use new direct addressing syntax. * t/02conf01.t: Likewise. * lib/Config/AST/Node/Value.pm: Use fallback instead of explicitly overloading particular operators.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--lib/Config/AST.pm42
-rw-r--r--lib/Config/AST/Follow.pm106
-rw-r--r--lib/Config/AST/Node/Section.pm14
-rw-r--r--lib/Config/AST/Node/Value.pm39
-rw-r--r--t/01conf12.t22
-rw-r--r--t/02conf01.t46
6 files changed, 186 insertions, 83 deletions
diff --git a/lib/Config/AST.pm b/lib/Config/AST.pm
index 721d515..958c106 100644
--- a/lib/Config/AST.pm
+++ b/lib/Config/AST.pm
@@ -23,6 +23,7 @@ use Text::Locus;
use Config::AST::Node qw(:sort);
use Config::AST::Node::Section;
use Config::AST::Node::Value;
+use Config::AST::Follow;
use Data::Dumper;
require Exporter;
@@ -670,7 +671,7 @@ node at path
one can write:
- $node = $cfg->tree->Foo->Bar->Baz
+ $node = $cfg->foo->bar->baz
This statement is equivalent to
@@ -678,20 +679,45 @@ This statement is equivalent to
except that if the node in question does not exist, direct access returns
a I<null node>, and B<getnode> returns C<undef>. Null node is a special node
-representing a missing node. Its B<is_null> method returns true and it can
+representing a missing node. Its B<is_null> method returns true and it can
be used in conditional context as a boolean value, e.g.:
- if (my $node = $cfg->tree->Foo->Bar->Baz) {
+ if (my $node = $cfg->foo->bar->baz) {
$val = $node->value;
}
-To compose direct access statement, first capitalize each path component. If
-the component name contains dashes, replace them with double underscores. Use
-the resulting names as methods of B<$cfg-E<gt>tree>. For example, to
-retrieve the C<qw(files temp-dir)> node, use
+Direct addressing is enabled only if lexicon is provided (either during
+creation of the object, or later, via the B<lexicon> method).
- $cfg->tree->Files->Temp__dir;
+Obviously, statements that have names coinciding with one of the methods of
+the B<Config::AST> class (or any of its subclasses) can't be used in direct
+addressing. In other words, you can't have a top-level statement called
+C<tree> and access it as
+ $cfg->tree
+
+This statement will always refer to the method B<tree> of the B<Config::AST>
+class.
+
+Another possible problem when using direct access are keywords with dashes.
+Currently a kludge is implemented to make it possible to access such
+keywords: when looking for a matching keyword, double underscores compare
+equal to a single dash. For example, to retrieve the C<qw(files temp-dir)>
+node, use
+
+ $cfg->files->temp__dir;
+
+=cut
+
+our $AUTOLOAD;
+sub AUTOLOAD {
+ my $self = shift;
+ $AUTOLOAD =~ s/(?:(.*)::)?(.+)//;
+ my ($p, $m) = ($1, $2);
+ croak "Can't locate object method \"$m\" via package \"$p\""
+ if @_ || !$self->lexicon;
+ return Config::AST::Follow->new($self->tree, $self->lexicon)->${\$m};
+}
=head1 CONSTRUCTING THE SYNTAX TREE
diff --git a/lib/Config/AST/Follow.pm b/lib/Config/AST/Follow.pm
new file mode 100644
index 0000000..671e947
--- a/dev/null
+++ b/lib/Config/AST/Follow.pm
@@ -0,0 +1,106 @@
+package Config::AST::Follow;
+use Config::AST::Node;
+use Config::AST::Node::Null;
+use strict;
+use warnings;
+use Carp;
+
+=head1 NAME
+
+Config::AST::Follow - direct addressing engine
+
+=head1 DESCRIPTION
+
+This class implements direct node addressing in B<Config::AST>.
+Objects of this class are created as
+
+ $obj = Config::AST::Follow->new($node, $lexicon)
+
+where B<$node> is the start node, and B<$lexicon> is the lexicon
+corresponding to that node. A B<Config::AST::Follow> object transparently
+delegates its methods to the underlying I<$node>, provided that such
+method is defined for I<$node>. If it is not, it reproduces itself
+with the new B<$node>, obtained as a result of the call to B<$node-E<gt>subtree>
+with the method name as its argument. If the result of the B<subtree> call
+is a leaf node, it is returned verbatim. The lexicon hash is consulted to
+check if the requested node name is allowed or not. If it is not, B<croak>
+is called. As a result, the following call:
+
+ $obj->A->B->C
+
+is equivalent to
+
+ $node->getnode('X', 'Y', 'Z')
+
+except that it will consult the lexicon to see if each name is allowed
+within a particular section.
+
+=head1 SEE ALSO
+
+B<Config::AST>(3).
+
+=cut
+
+sub new {
+ my ($class, $node, $lex) = @_;
+ bless { _node => $node, _lex => $lex }, $class;
+}
+
+our $AUTOLOAD;
+sub AUTOLOAD {
+ my $self = shift;
+
+ $AUTOLOAD =~ s/(?:(.*)::)?(.+)//;
+ my ($p, $m) = ($1, $2);
+
+ if ($self->{_node}->can($m)) {
+ return $self->{_node}->${\$m};
+ }
+
+ croak "Can't locate object method \"$m\" via package \"$p\""
+ if @_;
+
+ croak "Can't locate object method \"$m\" via package \"$p\" \
+ (and no lexical info exists to descend to $m)"
+ unless ref($self->{_lex}) eq 'HASH';
+
+ (my $key = $m) =~ s/__/-/g;
+ my $lex = $self->{_lex};
+ if (ref($lex) eq 'HASH') {
+ if (exists($lex->{$key})) {
+ $lex = $lex->{$key};
+ } elsif (exists($lex->{'*'})) {
+ $lex = $lex->{'*'};
+ } else {
+ $lex = undef;
+ }
+ croak "Can't locate object method \"$m\" via package \"$p\""
+ unless $lex;
+ } else {
+ croak "Can't locate object method \"$m\" via package \"$p\""
+ }
+
+ if (!ref($lex)) {
+ if ($lex eq '*') {
+ $lex = { '*' => '*' };
+ } else {
+ $lex = undef;
+ }
+ } elsif ($lex->{section}) {
+ $lex = $lex->{section};
+ } else {
+ $lex = undef;
+ }
+
+ if (!$self->{_node}->is_null) {
+ my $next = $self->{_node}->subtree($self->{_ci} ? lc($key) : $key)
+ // new Config::AST::Node::Null;
+ return $next if $next->is_leaf || !$lex;
+ $self->{_node} = $next;
+ }
+
+ $self->{_lex} = $lex;
+ $self;
+}
+
+1;
diff --git a/lib/Config/AST/Node/Section.pm b/lib/Config/AST/Node/Section.pm
index 95ec603..2353c89 100644
--- a/lib/Config/AST/Node/Section.pm
+++ b/lib/Config/AST/Node/Section.pm
@@ -164,20 +164,6 @@ Returns the string "(section)".
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::AST::Node::Null;
- }
- confess "Can't locate method $AUTOLOAD";
-}
-
=head1 SEE ALSO
B<Config::AST>,
diff --git a/lib/Config/AST/Node/Value.pm b/lib/Config/AST/Node/Value.pm
index b1036bf..98770c2 100644
--- a/lib/Config/AST/Node/Value.pm
+++ b/lib/Config/AST/Node/Value.pm
@@ -137,44 +137,7 @@ use overload
my $res = $self->as_string cmp "$other";
return $swap ? - $res : $res;
},
- '+' => sub {
- my ($self, $other) = @_;
- return $self->as_number + $other;
- },
- '-' => sub {
- my ($self, $other, $swap) = @_;
- my $d = $self->as_number - $other;
- return $swap ? - $d : $d;
- },
- '*' => sub {
- my ($self, $other) = @_;
- return $self->as_number * $other;
- },
- '/' => sub {
- my ($self, $other, $swap) = @_;
- if ($swap) {
- return $other / $self->as_number;
- } else {
- return $self->as_number / $other;
- }
- },
- '%' => sub {
- my ($self, $other, $swap) = @_;
- if ($swap) {
- return $other % $self->as_number;
- } else {
- return $self->as_number % $other;
- }
- },
- '**' => sub {
- my ($self, $other, $swap) = @_;
- if ($swap) {
- return $other ** $self->as_number;
- } else {
- return $self->as_number ** $other;
- }
- }
-;
+ fallback => 1;
=head1 SEE ALSO
diff --git a/t/01conf12.t b/t/01conf12.t
index 1435a70..c17f235 100644
--- a/t/01conf12.t
+++ b/t/01conf12.t
@@ -3,7 +3,6 @@ use lib qw(t lib);
use strict;
use Test;
use TestConfig;
-use Data::Dumper;
plan(tests => 2);
@@ -18,21 +17,10 @@ my $t = new TestConfig(
'file.passwd.root.dir' => '/root',
'core.group' => 'group'
- ]);
+ ],
+ lexicon => { '*' => '*' } );
-print $t->canonical,"\n";
-ok(Data::Dumper->new([$t->as_hash])
- ->Sortkeys(1)
- ->Useqq(1)
- ->Terse(1)
- ->Indent(0)
- ->Dump,
- '{"base" => "/etc","core" => {"file" => "passwd","group" => "group","home" => "/home"},"file" => {"passwd" => {"mode" => "0644","root" => {"dir" => "/root","uid" => 0}}}}');
+ok($t->canonical,
+ q{base="/etc" core.file="passwd" core.group="group" core.home="/home" file.passwd.mode="0644" file.passwd.root.dir="/root" file.passwd.root.uid=0});
-ok(Data::Dumper->new([$t->tree->File->as_hash])
- ->Sortkeys(1)
- ->Useqq(1)
- ->Terse(1)
- ->Indent(0)
- ->Dump,
- '{"passwd" => {"mode" => "0644","root" => {"dir" => "/root","uid" => 0}}}');
+ok($t->file->passwd->mode,'0644');
diff --git a/t/02conf01.t b/t/02conf01.t
index b59ff24..8176df8 100644
--- a/t/02conf01.t
+++ b/t/02conf01.t
@@ -4,7 +4,7 @@ use strict;
use Test;
use TestConfig;
-plan(tests => 4);
+plan(tests => 9);
my $t = new TestConfig(
config => [
@@ -12,9 +12,43 @@ my $t = new TestConfig(
'file.passwd.mode' => '0644',
'file.passwd.root.uid' => 0,
'file.passwd.root.dir' => '/root',
- ]);
+ ],
+ lexicon => {
+ base => 1,
+ file => {
+ section => {
+ passwd => {
+ section => {
+ mode => 1,
+ root => {
+ section => {
+ uid => 1,
+ dir => 1
+ }
+ },
+ }
+ },
+ skel => 1
+ }
+ },
+ other => {
+ section => {
+ x => {
+ section => {
+ y => 1
+ }
+ }
+ }
+ }
+ });
-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);
+ok($t->base->is_leaf);
+ok($t->base, '/etc');
+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->skel->is_null);
+eval { $t->nonexistent };
+ok($@ =~ m{Can't locate object method "nonexistent" via package "Config::AST::Follow"});
+ok($t->other->x->y->is_null);

Return to:

Send suggestions and report system problems to the System administrator.