diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2019-08-23 13:40:38 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2019-08-23 13:40:48 +0300 |
commit | a4a87bed9b7dbb2c8d35ad3b32b39b53b1eae517 (patch) | |
tree | 2aa084bc29a818284bd5f6b4075888b93a937363 | |
parent | a9ee653da53f5e4e8158620d44a458f48400ac52 (diff) | |
download | config-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.
-rw-r--r-- | lib/Config/AST.pm | 42 | ||||
-rw-r--r-- | lib/Config/AST/Follow.pm | 106 | ||||
-rw-r--r-- | lib/Config/AST/Node/Section.pm | 14 | ||||
-rw-r--r-- | lib/Config/AST/Node/Value.pm | 39 | ||||
-rw-r--r-- | t/01conf12.t | 22 | ||||
-rw-r--r-- | t/02conf01.t | 46 |
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; | |||
23 | use Config::AST::Node qw(:sort); | 23 | use Config::AST::Node qw(:sort); |
24 | use Config::AST::Node::Section; | 24 | use Config::AST::Node::Section; |
25 | use Config::AST::Node::Value; | 25 | use Config::AST::Node::Value; |
26 | use Config::AST::Follow; | ||
26 | use Data::Dumper; | 27 | use Data::Dumper; |
27 | 28 | ||
28 | require Exporter; | 29 | require Exporter; |
@@ -670,7 +671,7 @@ node at path | |||
670 | 671 | ||
671 | one can write: | 672 | one can write: |
672 | 673 | ||
673 | $node = $cfg->tree->Foo->Bar->Baz | 674 | $node = $cfg->foo->bar->baz |
674 | 675 | ||
675 | This statement is equivalent to | 676 | This statement is equivalent to |
676 | 677 | ||
@@ -678,20 +679,45 @@ This statement is equivalent to | |||
678 | 679 | ||
679 | except that if the node in question does not exist, direct access returns | 680 | except that if the node in question does not exist, direct access returns |
680 | a I<null node>, and B<getnode> returns C<undef>. Null node is a special node | 681 | a I<null node>, and B<getnode> returns C<undef>. Null node is a special node |
681 | representing a missing node. Its B<is_null> method returns true and it can | 682 | representing a missing node. Its B<is_null> method returns true and it can |
682 | be used in conditional context as a boolean value, e.g.: | 683 | be used in conditional context as a boolean value, e.g.: |
683 | 684 | ||
684 | if (my $node = $cfg->tree->Foo->Bar->Baz) { | 685 | if (my $node = $cfg->foo->bar->baz) { |
685 | $val = $node->value; | 686 | $val = $node->value; |
686 | } | 687 | } |
687 | 688 | ||
688 | To compose direct access statement, first capitalize each path component. If | 689 | Direct addressing is enabled only if lexicon is provided (either during |
689 | the component name contains dashes, replace them with double underscores. Use | 690 | creation of the object, or later, via the B<lexicon> method). |
690 | the resulting names as methods of B<$cfg-E<gt>tree>. For example, to | ||
691 | retrieve the C<qw(files temp-dir)> node, use | ||
692 | 691 | ||
693 | $cfg->tree->Files->Temp__dir; | 692 | Obviously, statements that have names coinciding with one of the methods of |
693 | the B<Config::AST> class (or any of its subclasses) can't be used in direct | ||
694 | addressing. In other words, you can't have a top-level statement called | ||
695 | C<tree> and access it as | ||
694 | 696 | ||
697 | $cfg->tree | ||
698 | |||
699 | This statement will always refer to the method B<tree> of the B<Config::AST> | ||
700 | class. | ||
701 | |||
702 | Another possible problem when using direct access are keywords with dashes. | ||
703 | Currently a kludge is implemented to make it possible to access such | ||
704 | keywords: when looking for a matching keyword, double underscores compare | ||
705 | equal to a single dash. For example, to retrieve the C<qw(files temp-dir)> | ||
706 | node, use | ||
707 | |||
708 | $cfg->files->temp__dir; | ||
709 | |||
710 | =cut | ||
711 | |||
712 | our $AUTOLOAD; | ||
713 | sub AUTOLOAD { | ||
714 | my $self = shift; | ||
715 | $AUTOLOAD =~ s/(?:(.*)::)?(.+)//; | ||
716 | my ($p, $m) = ($1, $2); | ||
717 | croak "Can't locate object method \"$m\" via package \"$p\"" | ||
718 | if @_ || !$self->lexicon; | ||
719 | return Config::AST::Follow->new($self->tree, $self->lexicon)->${\$m}; | ||
720 | } | ||
695 | 721 | ||
696 | =head1 CONSTRUCTING THE SYNTAX TREE | 722 | =head1 CONSTRUCTING THE SYNTAX TREE |
697 | 723 | ||
diff --git a/lib/Config/AST/Follow.pm b/lib/Config/AST/Follow.pm new file mode 100644 index 0000000..671e947 --- /dev/null +++ b/lib/Config/AST/Follow.pm | |||
@@ -0,0 +1,106 @@ | |||
1 | package Config::AST::Follow; | ||
2 | use Config::AST::Node; | ||
3 | use Config::AST::Node::Null; | ||
4 | use strict; | ||
5 | use warnings; | ||
6 | use Carp; | ||
7 | |||
8 | =head1 NAME | ||
9 | |||
10 | Config::AST::Follow - direct addressing engine | ||
11 | |||
12 | =head1 DESCRIPTION | ||
13 | |||
14 | This class implements direct node addressing in B<Config::AST>. | ||
15 | Objects of this class are created as | ||
16 | |||
17 | $obj = Config::AST::Follow->new($node, $lexicon) | ||
18 | |||
19 | where B<$node> is the start node, and B<$lexicon> is the lexicon | ||
20 | corresponding to that node. A B<Config::AST::Follow> object transparently | ||
21 | delegates its methods to the underlying I<$node>, provided that such | ||
22 | method is defined for I<$node>. If it is not, it reproduces itself | ||
23 | with the new B<$node>, obtained as a result of the call to B<$node-E<gt>subtree> | ||
24 | with the method name as its argument. If the result of the B<subtree> call | ||
25 | is a leaf node, it is returned verbatim. The lexicon hash is consulted to | ||
26 | check if the requested node name is allowed or not. If it is not, B<croak> | ||
27 | is called. As a result, the following call: | ||
28 | |||
29 | $obj->A->B->C | ||
30 | |||
31 | is equivalent to | ||
32 | |||
33 | $node->getnode('X', 'Y', 'Z') | ||
34 | |||
35 | except that it will consult the lexicon to see if each name is allowed | ||
36 | within a particular section. | ||
37 | |||
38 | =head1 SEE ALSO | ||
39 | |||
40 | B<Config::AST>(3). | ||
41 | |||
42 | =cut | ||
43 | |||
44 | sub new { | ||
45 | my ($class, $node, $lex) = @_; | ||
46 | bless { _node => $node, _lex => $lex }, $class; | ||
47 | } | ||
48 | |||
49 | our $AUTOLOAD; | ||
50 | sub AUTOLOAD { | ||
51 | my $self = shift; | ||
52 | |||
53 | $AUTOLOAD =~ s/(?:(.*)::)?(.+)//; | ||
54 | my ($p, $m) = ($1, $2); | ||
55 | |||
56 | if ($self->{_node}->can($m)) { | ||
57 | return $self->{_node}->${\$m}; | ||
58 | } | ||
59 | |||
60 | croak "Can't locate object method \"$m\" via package \"$p\"" | ||
61 | if @_; | ||
62 | |||
63 | croak "Can't locate object method \"$m\" via package \"$p\" \ | ||
64 | (and no lexical info exists to descend to $m)" | ||
65 | unless ref($self->{_lex}) eq 'HASH'; | ||
66 | |||
67 | (my $key = $m) =~ s/__/-/g; | ||
68 | my $lex = $self->{_lex}; | ||
69 | if (ref($lex) eq 'HASH') { | ||
70 | if (exists($lex->{$key})) { | ||
71 | $lex = $lex->{$key}; | ||
72 | } elsif (exists($lex->{'*'})) { | ||
73 | $lex = $lex->{'*'}; | ||
74 | } else { | ||
75 | $lex = undef; | ||
76 | } | ||
77 | croak "Can't locate object method \"$m\" via package \"$p\"" | ||
78 | unless $lex; | ||
79 | } else { | ||
80 | croak "Can't locate object method \"$m\" via package \"$p\"" | ||
81 | } | ||
82 | |||
83 | if (!ref($lex)) { | ||
84 | if ($lex eq '*') { | ||
85 | $lex = { '*' => '*' }; | ||
86 | } else { | ||
87 | $lex = undef; | ||
88 | } | ||
89 | } elsif ($lex->{section}) { | ||
90 | $lex = $lex->{section}; | ||
91 | } else { | ||
92 | $lex = undef; | ||
93 | } | ||
94 | |||
95 | if (!$self->{_node}->is_null) { | ||
96 | my $next = $self->{_node}->subtree($self->{_ci} ? lc($key) : $key) | ||
97 | // new Config::AST::Node::Null; | ||
98 | return $next if $next->is_leaf || !$lex; | ||
99 | $self->{_node} = $next; | ||
100 | } | ||
101 | |||
102 | $self->{_lex} = $lex; | ||
103 | $self; | ||
104 | } | ||
105 | |||
106 | 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)". | |||
164 | 164 | ||
165 | sub as_string { '(section)' } | 165 | sub as_string { '(section)' } |
166 | 166 | ||
167 | our $AUTOLOAD; | ||
168 | |||
169 | sub AUTOLOAD { | ||
170 | my $self = shift; | ||
171 | my $key = $AUTOLOAD; | ||
172 | $key =~ s/.*:://; | ||
173 | if ($key =~ s/^([A-Z])(.*)/\l$1$2/) { | ||
174 | $key =~ s/__/-/g; | ||
175 | return $self->subtree($self->{_ci} ? lc($key) : $key) | ||
176 | // new Config::AST::Node::Null; | ||
177 | } | ||
178 | confess "Can't locate method $AUTOLOAD"; | ||
179 | } | ||
180 | |||
181 | =head1 SEE ALSO | 167 | =head1 SEE ALSO |
182 | 168 | ||
183 | B<Config::AST>, | 169 | 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 | |||
137 | my $res = $self->as_string cmp "$other"; | 137 | my $res = $self->as_string cmp "$other"; |
138 | return $swap ? - $res : $res; | 138 | return $swap ? - $res : $res; |
139 | }, | 139 | }, |
140 | '+' => sub { | 140 |