File Coverage

lib/Config/AST/Root.pm
Criterion Covered Total %
statement 15 15 100.0
branch 1 2 50.0
condition 3 6 50.0
subroutine 7 7 100.0
pod 5 5 100.0
total 31 35 88.5


line stmt bran cond sub pod time code
1             # This file is part of Config::AST -*- perl -*-
2             # Copyright (C) 2017-2019 Sergey Poznyakoff
3             #
4             # Config::AST is free software; you can redistribute it and/or modify
5             # it under the terms of the GNU General Public License as published by
6             # the Free Software Foundation; either version 3, or (at your option)
7             # any later version.
8             #
9             # Config::AST is distributed in the hope that it will be useful,
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12             # GNU General Public License for more details.
13             #
14             # You should have received a copy of the GNU General Public License
15             # along with Config::AST. If not, see .
16              
17             package Config::AST::Root;
18 19     19   117 use strict;
  19         33  
  19         510  
19 19     19   85 use warnings;
  19         25  
  19         4468  
20              
21             =head1 NAME
22              
23             Config::AST::Root - root of the abstract syntax tree
24              
25             =head1 DESCRIPTION
26              
27             An auxiliary class representing the root of the abstract syntax tree.
28             It is necessary because the tree itself forms a circular structure
29             (due to the B attribute of B). Without
30             this intermediate class (if B pointed to B itself),
31             the structure would have never been destroyed, because each element
32             would remain referenced at least once.
33              
34             =head1 CONSTRUCTOR
35              
36             =head2 $obj = new($ci)
37              
38             I<$ci> is one to enable case-insensitive keyword lookup, and 0 otherwise.
39              
40             =cut
41              
42             sub new {
43 22     22 1 73 my ($class, $ci) = @_;
44 22         99 bless { _ci => $ci }, $class;
45             }
46              
47             =head1 METHODS
48              
49             =head2 $s = $r->mangle_key($name)
50              
51             Converts the string I<$name> to a form suitable for lookups, in accordance
52             with the _ci attribute.
53              
54             =cut
55              
56             sub mangle_key {
57 561     561 1 796 my ($self, $key) = @_;
58 561 50       1315 $self->{_ci} ? lc($key) : $key;
59             }
60              
61             =head2 $r->reset
62              
63             Destroys the underlying syntax tree.
64              
65             =cut
66              
67 61     61 1 2971 sub reset { delete shift->{_tree} }
68              
69              
70             =head2 $t = $r->tree
71              
72             Returns the root node of the tree, initializing it if necessary.
73              
74             =cut
75              
76             sub tree {
77 113     113 1 154 my $self = shift;
78              
79             return $self->{_tree} //=
80 113   66     378 new Config::AST::Node::Section($self,
81             locus => new Text::Locus);
82             }
83              
84             =head2 $bool = $r->empty
85              
86             Returns true if the tree is empty.
87              
88             =cut
89              
90             sub empty {
91 23     23 1 27 my $self = shift;
92 23   33     71 return !($self->{_tree} && $self->{_tree}->keys > 0);
93             }
94              
95             =head1 SEE ALSO
96              
97             L.
98              
99             =cut
100              
101             1;