diff options
-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 | |||
@@ -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 | ||
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 | } |
@@ -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 | ||
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; |
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 | } |
@@ -9,9 +9,9 @@ plan(tests => 3); | |||
9 | my $cfg = new TestConfig( | 9 | my $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 | ); |
15 | ok(join(',', $cfg->getnode('core')->keys), 'retain-interval,tempdir'); | 15 | ok(join(',', sort $cfg->getnode('core')->keys), 'retain-interval,tempdir'); |
16 | ok($cfg->getnode('core')->keys, 2); | 16 | ok($cfg->getnode('core')->keys, 2); |
17 | ok(join(',', sort $cfg->names_of('core')), 'retain-interval,tempdir'); | 17 | ok(join(',', sort $cfg->names_of('core')), 'retain-interval,tempdir'); |