summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-12-03 14:14:21 +0100
committerSergey Poznyakoff <gray@gnu.org.ua>2017-12-03 14:14:21 +0100
commit9f89acb180d22d30bb4ffed659969d57cf5cabce (patch)
tree9dfe0b30b92cccd45b28158f4442c242dd988968
parentceb4bd03d48d161548e00f1db170b376583894a8 (diff)
downloadconfig-ast-9f89acb180d22d30bb4ffed659969d57cf5cabce.tar.gz
config-ast-9f89acb180d22d30bb4ffed659969d57cf5cabce.tar.bz2
Implement add_node and add_value methods
-rw-r--r--lib/Config/Tree.pm43
-rw-r--r--t/TestConfig.pm2
-rw-r--r--t/conf11.t2
3 files changed, 32 insertions, 15 deletions
diff --git a/lib/Config/Tree.pm b/lib/Config/Tree.pm
index 39e0de9..f22d8e5 100644
--- a/lib/Config/Tree.pm
+++ b/lib/Config/Tree.pm
@@ -504,42 +504,43 @@ sub _get_section_synt {
=head2 add_node($node, $path)
=cut
sub add_node {
- my ($self, $path, $v, $locus) = @_;
+ my ($self, $path, $node) = @_;
unless (ref($path) eq 'ARRAY') {
$path = [ split(/\./, $path) ]
}
my $kw = $self->{_parameters} // { '*' => '*' };
- my $node = $self->tree;
+ my $tree = $self->tree;
my $pn = $#{$path};
my $name;
+ my $locus = $node->locus;
for (my $i = 0; $i < $pn; $i++) {
$name = ${$path}[$i];
- unless ($node->is_section) {
+ unless ($tree->is_section) {
$self->error(join('.', @{$path}[0..$i]) . ": not a section");
$self->{_error_count}++;
return;
}
$kw = $self->_get_section_synt($kw, $name);
unless ($kw) {
$self->error(join('.', @{$path}[0..$i]) . ": unknown section");
$self->{_error_count}++;
return;
}
- if (my $subtree = $node->subtree($name)) {
- $node = $subtree;
+ if (my $subtree = $tree->subtree($name)) {
+ $tree = $subtree;
} else {
- $node = $node->subtree(
+ $tree = $tree->subtree(
$name => new Config::Tree::Node::Section(
order => $self->{_order}++,
locus => $locus->clone)
);
}
}
@@ -550,18 +551,30 @@ sub add_node {
if (!defined($x)) {
$self->error("keyword \"$name\" is unknown", locus => $locus);
$self->{_error_count}++;
return;
}
+ if ($node->is_section) {
+ if ($tree->has_key($name)) {
+ $tree->locus->add($locus);
+ $tree->subtree($name)->merge($node);
+ } else {
+ $tree->subtree($name => $node);
+ }
+ return $node;
+ }
+
+ my $v = $node->value;
+
if (ref($x) eq 'HASH') {
my $errstr;
my $prev_val;
- if ($node->has_key($name)) {
+ if ($tree->has_key($name)) {
# FIXME: is_value?
- $prev_val = $node->subtree($name)->value;
+ $prev_val = $tree->subtree($name)->value;
}
if (exists($x->{re})) {
if ($v !~ /$x->{re}/) {
$self->error("invalid value for $name",
locus => $locus);
$self->{_error_count}++;
@@ -582,27 +595,31 @@ sub add_node {
} else {
$v = [ @{$prev_val}, $v ];
}
}
}
- $node->locus->add($locus->clone);
+ $tree->locus->add($locus->clone);
my $newnode;
- if ($newnode = $node->subtree($name)) {
+ if ($newnode = $tree->subtree($name)) {
$newnode->locus->add($locus);
} else {
- $newnode = $node->subtree(
- $name => new Config::Tree::Node::Value(locus => $locus)
- );
+ $newnode = $tree->subtree($name => $node);
}
$newnode->order($self->{order}++);
$newnode->value($v);
return $newnode;
}
+sub add_value {
+ my ($self, $path, $value, $locus) = @_;
+ $self->add_node($path, new Config::Tree::Node::Value(value => $value,
+ locus => $locus));
+}
+
sub commit {
my ($self) = @_;
# FIXME
$self->_fixup($self->tree, $self->{_parameters})
if exists $self->{_parameters};
return $self->{_error_count} == 0;
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
index de1ade9..847ff0c 100644
--- a/t/TestConfig.pm
+++ b/t/TestConfig.pm
@@ -16,13 +16,13 @@ sub new {
my $self = $class->SUPER::new(%_);
$self->{_expected_errors} = $exp // [];
my $i = 1;
while ((my $k = shift @$config) && (my $v = shift @$config)) {
# while (my ($k,$v) = each %$config) {
- $self->add_node($k, $v, new Config::Tree::Locus('input', $i++));
+ $self->add_value($k, $v, new Config::Tree::Locus('input', $i++));
}
$self->commit;
if (@{$self->{_expected_errors}}) {
$self->{_status} = 0;
$self->report("not all expected errors reported: @{$self->{_expected_errors}}");
}
diff --git a/t/conf11.t b/t/conf11.t
index 13516b8..07a94cf 100644
--- a/t/conf11.t
+++ b/t/conf11.t
@@ -9,9 +9,9 @@ plan(tests => 3);
my $cfg = new TestConfig(
config => [
'core.retain-interval' => 10,
'core.tempdir' => '/tmp'
]
);
-ok(join(',', $cfg->getnode('core')->keys), 'retain-interval,tempdir');
+ok(join(',', sort $cfg->getnode('core')->keys), 'retain-interval,tempdir');
ok($cfg->getnode('core')->keys, 2);
ok(join(',', sort $cfg->names_of('core')), 'retain-interval,tempdir');

Return to:

Send suggestions and report system problems to the System administrator.