summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2017-12-03 13:14:21 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2017-12-03 13:14:21 (GMT)
commit9f89acb180d22d30bb4ffed659969d57cf5cabce (patch) (unidiff)
tree9dfe0b30b92cccd45b28158f4442c242dd988968
parentceb4bd03d48d161548e00f1db170b376583894a8 (diff)
downloadconfig-ast-9f89acb180d22d30bb4ffed659969d57cf5cabce.tar.gz
config-ast-9f89acb180d22d30bb4ffed659969d57cf5cabce.tar.bz2
Implement add_node and add_value methods
Diffstat (more/less context) (ignore whitespace changes)
-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 {
504 504
505=head2 add_node($node, $path) 505=head2 add_node($node, $path)
506 506
507=cut 507=cut
508 508
509sub add_node { 509sub add_node {
510 my ($self, $path, $v, $locus) = @_; 510 my ($self, $path, $node) = @_;
511 511
512 unless (ref($path) eq 'ARRAY') { 512 unless (ref($path) eq 'ARRAY') {
513 $path = [ split(/\./, $path) ] 513 $path = [ split(/\./, $path) ]
514 } 514 }
515 515
516 my $kw = $self->{_parameters} // { '*' => '*' }; 516 my $kw = $self->{_parameters} // { '*' => '*' };
517 my $node = $self->tree; 517 my $tree = $self->tree;
518 my $pn = $#{$path}; 518 my $pn = $#{$path};
519 my $name; 519 my $name;
520 my $locus = $node->locus;
520 for (my $i = 0; $i < $pn; $i++) { 521 for (my $i = 0; $i < $pn; $i++) {
521 $name = ${$path}[$i]; 522 $name = ${$path}[$i];
522 523
523 unless ($node->is_section) { 524 unless ($tree->is_section) {
524 $self->error(join('.', @{$path}[0..$i]) . ": not a section"); 525 $self->error(join('.', @{$path}[0..$i]) . ": not a section");
525 $self->{_error_count}++; 526 $self->{_error_count}++;
526 return; 527 return;
527 } 528 }
528 529
529 $kw = $self->_get_section_synt($kw, $name); 530 $kw = $self->_get_section_synt($kw, $name);
530 unless ($kw) { 531 unless ($kw) {
531 $self->error(join('.', @{$path}[0..$i]) . ": unknown section"); 532 $self->error(join('.', @{$path}[0..$i]) . ": unknown section");
532 $self->{_error_count}++; 533 $self->{_error_count}++;
533 return; 534 return;
534 } 535 }
535 536
536 if (my $subtree = $node->subtree($name)) { 537 if (my $subtree = $tree->subtree($name)) {
537 $node = $subtree; 538 $tree = $subtree;
538 } else { 539 } else {
539 $node = $node->subtree( 540 $tree = $tree->subtree(
540 $name => new Config::Tree::Node::Section( 541 $name => new Config::Tree::Node::Section(
541 order => $self->{_order}++, 542 order => $self->{_order}++,
542 locus => $locus->clone) 543 locus => $locus->clone)
543 ); 544 );
544 } 545 }
545 } 546 }
@@ -550,18 +551,30 @@ sub add_node {
550 if (!defined($x)) { 551 if (!defined($x)) {
551 $self->error("keyword \"$name\" is unknown", locus => $locus); 552 $self->error("keyword \"$name\" is unknown", locus => $locus);
552 $self->{_error_count}++; 553 $self->{_error_count}++;
553 return; 554 return;
554 } 555 }
555 556
557 if ($node->is_section) {
558 if ($tree->has_key($name)) {
559 $tree->locus->add($locus);
560 $tree->subtree($name)->merge($node);
561 } else {
562 $tree->subtree($name => $node);
563 }
564 return $node;
565 }
566
567 my $v = $node->value;
568
556 if (ref($x) eq 'HASH') { 569 if (ref($x) eq 'HASH') {
557 my $errstr; 570 my $errstr;
558 my $prev_val; 571 my $prev_val;
559 if ($node->has_key($name)) { 572 if ($tree->has_key($name)) {
560 # FIXME: is_value? 573 # FIXME: is_value?
561 $prev_val = $node->subtree($name)->value; 574 $prev_val = $tree->subtree($name)->value;
562 } 575 }
563 if (exists($x->{re})) { 576 if (exists($x->{re})) {
564 if ($v !~ /$x->{re}/) { 577 if ($v !~ /$x->{re}/) {
565 $self->error("invalid value for $name", 578 $self->error("invalid value for $name",
566 locus => $locus); 579 locus => $locus);
567 $self->{_error_count}++; 580 $self->{_error_count}++;
@@ -582,27 +595,31 @@ sub add_node {
582 } else { 595 } else {
583 $v = [ @{$prev_val}, $v ]; 596 $v = [ @{$prev_val}, $v ];
584 } 597 }
585 } 598 }
586 } 599 }
587 600
588 $node->locus->add($locus->clone); 601 $tree->locus->add($locus->clone);
589 602
590 my $newnode; 603 my $newnode;
591 if ($newnode = $node->subtree($name)) { 604 if ($newnode = $tree->subtree($name)) {
592 $newnode->locus->add($locus); 605 $newnode->locus->add($locus);
593 } else { 606 } else {
594 $newnode = $node->subtree( 607 $newnode = $tree->subtree($name => $node);
595 $name => new Config::Tree::Node::Value(locus => $locus)
596 );
597 } 608 }
598 $newnode->order($self->{order}++); 609 $newnode->order($self->{order}++);
599 $newnode->value($v); 610 $newnode->value($v);
600 return $newnode; 611 return $newnode;
601} 612}
602 613
614sub add_value {
615 my ($self, $path, $value, $locus) = @_;
616 $self->add_node($path, new Config::Tree::Node::Value(value => $value,
617 locus => $locus));
618}
619
603sub commit { 620sub commit {
604 my ($self) = @_; 621 my ($self) = @_;
605 # FIXME 622 # FIXME
606 $self->_fixup($self->tree, $self->{_parameters}) 623 $self->_fixup($self->tree, $self->{_parameters})
607 if exists $self->{_parameters}; 624 if exists $self->{_parameters};
608 return $self->{_error_count} == 0; 625 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 {
16 16
17 my $self = $class->SUPER::new(%_); 17 my $self = $class->SUPER::new(%_);
18 $self->{_expected_errors} = $exp // []; 18 $self->{_expected_errors} = $exp // [];
19 my $i = 1; 19 my $i = 1;
20 while ((my $k = shift @$config) && (my $v = shift @$config)) { 20 while ((my $k = shift @$config) && (my $v = shift @$config)) {
21# while (my ($k,$v) = each %$config) { 21# while (my ($k,$v) = each %$config) {
22 $self->add_node($k, $v, new Config::Tree::Locus('input', $i++)); 22 $self->add_value($k, $v, new Config::Tree::Locus('input', $i++));
23 } 23 }
24 $self->commit; 24 $self->commit;
25 if (@{$self->{_expected_errors}}) { 25 if (@{$self->{_expected_errors}}) {
26 $self->{_status} = 0; 26 $self->{_status} = 0;
27 $self->report("not all expected errors reported: @{$self->{_expected_errors}}"); 27 $self->report("not all expected errors reported: @{$self->{_expected_errors}}");
28 } 28 }
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);
9my $cfg = new TestConfig( 9my $cfg = new TestConfig(
10 config => [ 10 config => [
11 'core.retain-interval' => 10, 11 'core.retain-interval' => 10,
12 'core.tempdir' => '/tmp' 12 'core.tempdir' => '/tmp'
13 ] 13 ]
14 ); 14 );
15ok(join(',', $cfg->getnode('core')->keys), 'retain-interval,tempdir'); 15ok(join(',', sort $cfg->getnode('core')->keys), 'retain-interval,tempdir');
16ok($cfg->getnode('core')->keys, 2); 16ok($cfg->getnode('core')->keys, 2);
17ok(join(',', sort $cfg->names_of('core')), 'retain-interval,tempdir'); 17ok(join(',', sort $cfg->names_of('core')), 'retain-interval,tempdir');

Return to:

Send suggestions and report system problems to the System administrator.