From 6daf6b93ff54569ec3f1caf68a1a408fe95b51fc Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Sat, 5 May 2018 10:28:37 +0200 Subject: Rewrite the value method of Node::Value. * lib/Config/Tree.pm (get): Simplify. Context dependency moved to Value. (canonical): New method. * lib/Config/Tree/Node.pm (canonical): New method. * lib/Config/Tree/Node/Value.pm (value): In list context, return dereferenced value (if appropriate). * t/02merge.t: Use the canonical method. * t/TestConfig.pm (canonical): Rewrite using method from the superclass. --- lib/Config/Tree.pm | 23 ++++++++++----- lib/Config/Tree/Node.pm | 63 +++++++++++++++++++++++++++++++++++++++-- lib/Config/Tree/Node/Section.pm | 2 +- lib/Config/Tree/Node/Value.pm | 8 ++++++ t/02merge.t | 8 +----- t/TestConfig.pm | 14 +-------- 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. + +=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, which must be an instance of B or its derived class. -=item - =item B> I 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 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 >I + +Use I to delimit statements, instead of the newline. + +=item B 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 { -- cgit v1.2.1