diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-12-03 14:14:21 +0100 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-12-03 14:14:21 +0100 |
commit | 9f89acb180d22d30bb4ffed659969d57cf5cabce (patch) | |
tree | 9dfe0b30b92cccd45b28158f4442c242dd988968 | |
parent | ceb4bd03d48d161548e00f1db170b376583894a8 (diff) | |
download | config-ast-9f89acb180d22d30bb4ffed659969d57cf5cabce.tar.gz config-ast-9f89acb180d22d30bb4ffed659969d57cf5cabce.tar.bz2 |
Implement add_node and add_value methods
-rw-r--r-- | lib/Config/Tree.pm | 43 | ||||
-rw-r--r-- | t/TestConfig.pm | 2 | ||||
-rw-r--r-- | t/conf11.t | 2 |
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 | ||
509 | sub add_node { | 509 | sub 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 | ||
614 | sub 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 | |||
603 | sub commit { | 620 | sub 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 | ||
613 | Sets the configuration variable B<@path> to B<$value>. | 630 | Sets 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'; | |||
10 | sub new { | 10 | sub 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; |