From c437dd558ef7d4e2f3b511d998d100d395c5ba26 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Thu, 2 Mar 2017 20:31:25 +0200 Subject: Small improvement of the config parser. * lib/App/Beam/Config.pm: Keep ordinal numbers (relative positions in the source file) of statements. (flatten): Rewrite method. * t/TestConfig.pm: Update. --- lib/App/Beam/Config.pm | 203 +++++++++++++++++++++++++++---------------------- t/TestConfig.pm | 6 +- 2 files changed, 115 insertions(+), 94 deletions(-) diff --git a/lib/App/Beam/Config.pm b/lib/App/Beam/Config.pm index ab58e38..bca710a 100644 --- a/lib/App/Beam/Config.pm +++ b/lib/App/Beam/Config.pm @@ -25,7 +25,9 @@ use Data::Dumper; require Exporter; our @ISA = qw(Exporter); - +our %EXPORT_TAGS = ( 'sort' => [ qw(NO_SORT SORT_NATURAL SORT_PATH) ] ); +our @EXPORT_OK = qw(NO_SORT SORT_NATURAL SORT_PATH); + our $VERSION = "1.00"; =head1 NAME @@ -429,6 +431,7 @@ sub readconfig { new App::Beam::Config::Locus($file, $line) unless exists $section->{-locus}; } + $section->{-order} = $self->{order}++; } } elsif (/([\w_-]+)\s*=\s*(.*)/) { my ($k, $v) = ($1, $2); @@ -503,10 +506,9 @@ sub readconfig { new App::Beam::Config::Locus(); } $section->{$k}{-locus}->add($file, $line); - $section->{$k}{-value} = $v; - } else { - $section->{$k} = $v; } + $section->{$k}{-order} = $self->{order}++; + $section->{$k}{-value} = $v; } else { $self->error("malformed line", locus => new App::Beam::Config::Locus($file, $line)); @@ -546,7 +548,7 @@ sub file_up_to_date { Parses the configuration file and stores the data in the object. Returns true on success and false on failure. Eventual errors in the configuration -are reported using B<$cfg->error>. +are reported using B. =cut @@ -647,13 +649,22 @@ is completely equivalent to If B<$cfg> was created with B enabled, returns the source location of this configuration setting (see B(3)). +=item 'order' + +If B<$cfg> was created with B enabled, returns the I of the statement in the configuration file. Ordinal numbers are +integers starting from 0 and assigned in ascending order to each statement. + =item 'all' -Returns a reference to a hash with the following keys: B<-value> and B<-locus>. -The B<$ret{-value}> contains the value of the setting. The B<$ret{-locus}> -is defined only if B<$cfg> was created with B enabled, and contains -a reference to B(3) describing the source location -where the setting was defined. +Returns a reference to a hash with the following keys: B<-value>, B<-locus>. +and B<-order>. + +The B<$ret{-value}> contains the value of the setting. The B<$ret{-order}> +contains its ordinal number. The B<$ret{-locus}> contains a reference to +B(3) describing the source location where the +setting was defined. It is available only if the B mode is +enabled. =back @@ -680,12 +691,10 @@ sub get { } else { $ref = undef; } - } elsif (!exists($ref->{-value})) { - $ref = { '-value' => $ref }; } } else { $ref = $self->getref(@_); - if (defined($ref) && ref($ref) eq 'HASH' && exists($ref->{-value})) { + if (defined($ref) && exists($ref->{-value})) { $ref = $ref->{-value}; } } @@ -752,11 +761,9 @@ sub set { $ref->{$arg} = {} unless exists $ref->{$arg}; $ref = $ref->{$arg}; } - if ($self->{locations}) { - $ref->{$_[0]}{-value} = $_[1]; - } else { - $ref->{$_[0]} = $_[1]; - } + $ref->{$_[0]}{-order} = $self->{order}++ + unless exists $ref->{$_[0]}{-order}; + $ref->{$_[0]}{-value} = $_[1]; $self->{updated} = $self->{rw}; } @@ -821,96 +828,110 @@ sub names_of { # return @{[ each %{$self->{conf}} ]}; #} -sub _foreach { - my ($self, $domain, $aref, $cb, $sort) = @_; - my @keys = keys(%{$aref}); - foreach my $k (defined($sort) ? sort $sort @keys : @keys) { - my $v = $aref->{$k}; - if (ref($v) eq 'HASH') { - if (exists($v->{-value})) { - &{$cb}($k, $v->{-value}, @{$domain}); - } else { - push @{$domain}, $k; - $self->_foreach($domain, $v, $cb, $sort); - pop @{$domain}; - } - } elsif ($k !~ /^-/) { - &{$cb}($k, $v, @{$domain}); - } - } -} +use constant { + NO_SORT => 0, + SORT_NATURAL => 1, + SORT_PATH => 2 +}; + +=head2 @array = $cfg->flatten() + +=head2 @array = $cfg->flatten(sort => $sort) + +Returns a I representation of the configuration, as a +list of pairs B<[ $path, $value ]>, where B<$path> is a reference +to the variable pathname, and B<$value> is a reference to a hash +containing the following keys: + +=over 4 + +=item B<-value> + +The value of the setting. + +=item B<-order> + +The ordinal number of the setting. + +=item B<-locus> + +Location of the setting in the configuration file. See +B(3). It is available only if the B +mode is enabled. + +=back -=head2 $cfg->foreach($callback, %opts) +The I<$sort> argument controls the ordering of the entries in the returned +B<@array>. It is either a code reference suitable to pass to the Perl B +function, or one of the following constants: -For each configuration settings calls +=over 4 + +=item NO_SORT + +Don't sort the array. Statements will be placed in an apparently random +order. + +=item SORT_NATURAL - &{$callback}($keyword, $value, @path) +Preserve relative positions of the statements. Entries in the array will +be in the same order as they appeared in the configuration file. This is +the default. + +=item SORT_PATH + +Sort by pathname. + +=back -where B<$keyword> is the configuration keyword, B<$value> is its value, and -B<@path> is the path to the section within which the setting occurred (in -other words, the full path to the configuration keyword is -B<(@path, $keyword)>). +These constants are not exported by default. You can either import the +ones you need, or use the B<:sort> keyword to import them all, e.g.: -Only one option is defined: B. If its value is B<1>, the keywords will -be passed to B<$callback> in lexicographical order. It can also refer to -a user-defined sorting function. + use App::Beam::Config qw(:sort); + @array = $cfg->flatten(sort => SORT_PATH); =cut -sub foreach { +sub flatten { my $self = shift; - my $cb = shift; - local %_ = @_; - my $sort = delete $_{sort}; - - if (defined($sort) && ref($sort) ne 'CODE') { - if ($sort == 1) { - $sort = sub { $a cmp $b }; - } else { - carp "sort must refer to a CODE"; - return; + my $sort = delete($_{sort}) || SORT_NATURAL; + my @ar; + my $i; + + croak "unrecognized keyworf arguments: ". join(',', keys %_) + if keys %_; + + push @ar, [ [], $self->{conf} ]; + foreach my $elt (@ar) { + next if exists $elt->[1]{-value}; + while (my ($kw, $val) = each %{$elt->[1]}) { + next if $kw =~ /^-/; + push @ar, [ [@{$elt->[0]}, $kw], $val ]; } } - if (keys(%_)) { - foreach my $k (keys %_) { - carp "unknown parameter $k"; - } - return; + + if (ref($sort) eq 'CODE') { + $sort = sub { sort $sort @_ }; + } elsif ($sort == SORT_PATH) { + $sort = sub { sort { join('.',@{$a->[0]}) cmp join('.', @{$b->[0]}) } @_ }; + } elsif ($sort == SORT_NATURAL) { + $sort = sub { sort { $a->[1]{-order} <=> $b->[1]{-order} } @_ }; + } elsif ($sort == NO_SORT) { + $sort = sub { @_ }; + } else { + croak "unsupported sort value"; } - - $self->_foreach([], $self->{conf}, $cb, $sort); -} -=head2 @array = $cfg->flatten() + return &{$sort}(map { exists($_->[1]{-value}) ? $_ : () } @ar); +} -Returns a I representation of the configuration, as a -list of pairs B<[ $dottedpath, $value ]>, where B<$dottedpath> is -a dot-separated keyword path, and B<$value> is the value of that -setting. E.g., the following configuration +=head2 $cfg->lint(\%synt) - pidfile = /var/run/x.pid - [item foo] - name = bar - [item foo bar] - lock = On +=cut -is represented as: +sub lint { + my ($self, $synt) = @_; - ('item.foo.name', 'bar') - ('item.foo.bar.lock', 'On') -=cut - -sub flatten { - my $self = shift; - my @dump; - $self->foreach(sub { - my $k = shift; - my $v = shift; - push @_, $k; - push @dump, [ join('.', @_), $v ]; - }, - sort => 1); - return @dump; } diff --git a/t/TestConfig.pm b/t/TestConfig.pm index daafe56..63b9d06 100644 --- a/t/TestConfig.pm +++ b/t/TestConfig.pm @@ -4,7 +4,7 @@ use strict; use Carp; use File::Temp; -require App::Beam::Config; +use App::Beam::Config qw(:sort); our @ISA = qw(App::Beam::Config); sub new { @@ -52,8 +52,8 @@ sub canonical { local $Data::Dumper::Useqq = 1; local $Data::Dumper::Terse = 1; local $Data::Dumper::Indent = 0; - $_->[0] . "=" . Data::Dumper->Dump([$_->[1]]); - } $self->flatten(); + join('.', @{$_->[0]}) . "=" . Data::Dumper->Dump([$_->[1]{-value}]); + } $self->flatten(sort => SORT_PATH); } sub expected_error { -- cgit v1.2.1