aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-03-02 20:31:25 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2017-03-02 20:47:26 +0200
commitc437dd558ef7d4e2f3b511d998d100d395c5ba26 (patch)
treec64c5e086466a91a37127e0f378b2cb61b17c99a
parent90cfc43a637d269d05d82653700a2735839129de (diff)
downloadbeam-c437dd558ef7d4e2f3b511d998d100d395c5ba26.tar.gz
beam-c437dd558ef7d4e2f3b511d998d100d395c5ba26.tar.bz2
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.
-rw-r--r--lib/App/Beam/Config.pm203
-rw-r--r--t/TestConfig.pm6
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<error>.
=cut
@@ -647,13 +649,22 @@ is completely equivalent to
If B<$cfg> was created with B<locations> enabled, returns the source
location of this configuration setting (see B<App::Beam::Config::Locus>(3)).
+=item 'order'
+
+If B<$cfg> was created with B<locations> enabled, returns the I<ordinal
+number> 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<locations> enabled, and contains
-a reference to B<App::Beam::Config::Locus>(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<App::Beam::Config::Locus>(3) describing the source location where the
+setting was defined. It is available only if the B<locations> 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<flattened> 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<App::Beam::Config::Locus>(3). It is available only if the B<locations>
+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<sort>
+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<sort>. 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<flattened> 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 {

Return to:

Send suggestions and report system problems to the System administrator.