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
@@ -498,76 +498,89 @@ sub _get_section_synt {
498 return $synt->{section}; 498 return $synt->{section};
499 } 499 }
500 } 500 }
501 } 501 }
502 return 502 return
503} 503}
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 }
546 547
547 $name = ${$path}[-1]; 548 $name = ${$path}[-1];
548 549
549 my $x = $kw->{$name} // $kw->{'*'}; 550 my $x = $kw->{$name} // $kw->{'*'};
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}++;
568 return; 581 return;
569 } 582 }
570 } 583 }
571 584
572 if (my $ck = $x->{check}) { 585 if (my $ck = $x->{check}) {
573 unless ($self->$ck(\$v, $prev_val, $locus)) { 586 unless ($self->$ck(\$v, $prev_val, $locus)) {
@@ -576,39 +589,43 @@ sub add_node {
576 } 589 }
577 } 590 }
578 591
579 if ($x->{array}) { 592 if ($x->{array}) {
580 if (!defined($prev_val)) { 593 if (!defined($prev_val)) {
581 $v = [ $v ]; 594 $v = [ $v ];
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;
609} 626}
610 627
611=head2 $cfg->set(@path, $value) 628=head2 $cfg->set(@path, $value)
612 629
613Sets the configuration variable B<@path> to B<$value>. 630Sets the configuration variable B<@path> to B<$value>.
614 631
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
index de1ade9..847ff0c 100644
--- a/t/TestConfig.pm
+++ b/t/TestConfig.pm
@@ -10,25 +10,25 @@ use parent 'Config::Tree';
10sub new { 10sub new {
11 my $class = shift; 11 my $class = shift;
12 local %_ = @_; 12 local %_ = @_;
13 13
14 my $config = delete $_{config}; 14 my $config = delete $_{config};
15 my $exp = delete $_{expect}; 15 my $exp = delete $_{expect};
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 }
29 return $self; 29 return $self;