summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Config/Tree.pm23
-rw-r--r--lib/Config/Tree/Node.pm63
-rw-r--r--lib/Config/Tree/Node/Section.pm2
-rw-r--r--lib/Config/Tree/Node/Value.pm8
-rw-r--r--t/02merge.t8
-rw-r--r--t/TestConfig.pm14
6 files changed, 88 insertions, 30 deletions
diff --git a/lib/Config/Tree.pm b/lib/Config/Tree.pm
index dbb7f1a..bb36d07 100644
--- a/lib/Config/Tree.pm
+++ b/lib/Config/Tree.pm
@@ -452,14 +452,9 @@ is
sub get {
my $self = shift;
croak "no variable to get" unless @_;
- my $node = $self->getnode(@_) or return undef;
- my $value = $node->value;
- if (ref($value) eq 'ARRAY') {
- return wantarray ? @$value : $value;
- } elsif (ref($value) eq 'HASH') {
- return wantarray ? %$value : $value;
+ if (my $node = $self->getnode(@_)) {
+ return $node->value;
}
- return $value;
}
=head2 $cfg->is_set(@path)
@@ -842,6 +837,20 @@ sub as_hash {
$self->tree->as_hash(@_);
}
+=head2 $cfg->canonical(%args)
+
+Returns the canonical string representation of the configuration tree.
+For details, please refer to the documentation of the eponymous method
+in class B<Config::Tree::Node>.
+
+=cut
+
+sub canonical {
+ my $self = shift;
+ $self->tree->canonical(@_);
+}
+
+
sub __lint {
my ($self, $syntax, $node, @path) = @_;
diff --git a/lib/Config/Tree/Node.pm b/lib/Config/Tree/Node.pm
index 79e105f..f836edf 100644
--- a/lib/Config/Tree/Node.pm
+++ b/lib/Config/Tree/Node.pm
@@ -3,6 +3,7 @@ package Config::Tree::Node;
use strict;
use warnings;
use parent 'Exporter';
+use Config::Tree::Locus;
use Clone 'clone';
use Carp;
@@ -37,8 +38,6 @@ Creates new object. Recognized arguments are:
Clone object I<OBJ>, which must be an instance of B<Config::Tree::Node>
or its derived class.
-=item
-
=item B<default =E<gt>> I<VAL>
Sets default value.
@@ -244,6 +243,66 @@ sub flatten {
return &{$sort}(grep { $_->[1]->is_value } @ar);
}
+=head2 $cfg->canonical(%args)
+
+Returns the canonical string representation of the configuration node.
+For value nodes, canonical representation is:
+
+ QVAR=VALUE
+
+where QVAR is fully qualified variable name, and VALUE is the corresponding
+value.
+
+For sections, canonical representation is a list of canonical representations
+of the underlying nodes, delimited by newlines (or another character - see the
+description of the B<delim> argument, below). The list is sorted by QVAR in
+ascending lexicographical order.
+
+B<%args> are zero or more of the following keywords:
+
+=over 4
+
+=item B<delim =E<gt> >I<STR>
+
+Use I<STR> to delimit statements, instead of the newline.
+
+=item B<locus =E<gt> 1>
+
+Prefix each statement with its location.
+
+=back
+
+=cut
+
+sub canonical {
+ my $self = shift;
+ local %_ = @_;
+ my $delim;
+ unless (defined($delim = delete $_{delim})) {
+ $delim = "\n";
+ }
+ my $prloc = delete $_{locus};
+ carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_));
+
+ return join $delim, map {
+ ($prloc ? '[' . $_->[1]->locus . ']: ' : '')
+ . join('.', map {
+ if (/[\.="]/) {
+ s/\"/\\"/;
+ '"'.$_.'"'
+ } else {
+ $_
+ }
+ } @{$_->[0]})
+ . "="
+ . Data::Dumper->new([scalar $_->[1]->value])
+ ->Useqq(1)
+ ->Terse(1)
+ ->Indent(0)
+ ->Dump
+ } $self->flatten(sort => SORT_PATH);
+}
+
use overload
bool => sub { 1 },
'""' => sub { shift->as_string },
diff --git a/lib/Config/Tree/Node/Section.pm b/lib/Config/Tree/Node/Section.pm
index 25b1bd5..9a888c0 100644
--- a/lib/Config/Tree/Node/Section.pm
+++ b/lib/Config/Tree/Node/Section.pm
@@ -105,7 +105,7 @@ sub as_hash {
push @ar, [ $kw, $val, $hr ];
}
} else {
- my ($name, $value) = &{$map}('value', $elt->[0], $elt->[1]->value);
+ my ($name, $value) = &{$map}('value', $elt->[0], scalar($elt->[1]->value));
$elt->[2]{$name} = $value;
}
}
diff --git a/lib/Config/Tree/Node/Value.pm b/lib/Config/Tree/Node/Value.pm
index c46a139..d9961c0 100644
--- a/lib/Config/Tree/Node/Value.pm
+++ b/lib/Config/Tree/Node/Value.pm
@@ -25,6 +25,14 @@ sub value {
if (ref($val) eq 'CODE') {
$val = &$val;
}
+
+ if (wantarray) {
+ if (ref($val) eq 'ARRAY') {
+ return @$val
+ } elsif (ref($val) eq 'HASH') {
+ return %$val
+ }
+ }
return $val;
}
diff --git a/t/02merge.t b/t/02merge.t
index 85fd556..4c12ec4 100644
--- a/t/02merge.t
+++ b/t/02merge.t
@@ -35,11 +35,5 @@ $node->subtree(name => new Config::Tree::Node::Value(
locus => new Config::Tree::Locus('input',4)));
$t->add_node(x => $node);
-ok(join(' ', map {
- local $Data::Dumper::Useqq = 1;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Indent = 0;
- '['.$_->[1]->locus . ']: '.
- join('.', @{$_->[0]}) . "=" . Data::Dumper->Dump([$_->[1]->value]);
- } $t->flatten(sort => SORT_PATH)),
+ok($t->canonical(delim => ' ', locus => 1),
q{[input:2]: x.name="bar" [input:1,3]: x.number=[1,2]});
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
index 614cee4..c566ec8 100644
--- a/t/TestConfig.pm
+++ b/t/TestConfig.pm
@@ -37,19 +37,7 @@ sub success {
sub canonical {
my $self = shift;
- local %_ = @_;
- my $delim;
- unless (defined($delim = delete $_{delim})) {
- $delim = " ";
- }
- carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_));
-
- return join $delim, map {
- local $Data::Dumper::Useqq = 1;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Indent = 0;
- join('.', @{$_->[0]}) . "=" . Data::Dumper->Dump([$_->[1]->value]);
- } $self->flatten(sort => SORT_PATH);
+ $self->SUPER::canonical(delim => ' ', @_);
}
sub expected_error {

Return to:

Send suggestions and report system problems to the System administrator.