diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-03-02 13:14:10 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-03-02 13:14:10 +0200 |
commit | 90cfc43a637d269d05d82653700a2735839129de (patch) | |
tree | 780a24ca39e6dcf6c4a3aa46a01ede711acac3a8 /lib | |
parent | d84f9c8d98e07b410b387140084bcd1ad02fed29 (diff) | |
download | beam-90cfc43a637d269d05d82653700a2735839129de.tar.gz beam-90cfc43a637d269d05d82653700a2735839129de.tar.bz2 |
Document App::Beam::Config
Rename the isscalar method to isvariable.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/App/Beam/Config.pm | 380 |
1 files changed, 355 insertions, 25 deletions
diff --git a/lib/App/Beam/Config.pm b/lib/App/Beam/Config.pm index f2bf2d8..ab58e38 100644 --- a/lib/App/Beam/Config.pm +++ b/lib/App/Beam/Config.pm @@ -28,20 +28,152 @@ our @ISA = qw(Exporter); our $VERSION = "1.00"; -sub error { - my $self = shift; - my $err = shift; - local %_ = @_; - $err = $_{locus}->format($err) if exists $_{locus}; - print STDERR "$err\n"; -} +=head1 NAME -sub debug { - my $self = shift; - my $lev = shift; - return unless $self->{debug} >= $lev; - $self->logger('debug', "config:", @_); -} +App::Beam::Config - generalized configuration file parser + +=head1 SYNOPSIS + + my $cfg = new App::Beam::Config($filename, %opts); + $cfg->parse() or die; + + if ($cfg->isset('core', 'variable')) { + ... + } + + my $x = $cfg->get('file', 'locking'); + + $cfg->set('file', 'locking', 'true'); + + $cfg->unset('file', 'locking'); + +=head1 DESCRIPTION + +=cut + +=head2 $cfg = new App::Beam::Config($filename, %opts); + +Creates new configuration object for file B<$filename>. Valid +options are: + +=over 4 + +=item B<debug> => I<NUM> + +Sets debug verbosity level. + +=item B<ci> => B<0> | B<1> + +If B<1>, enables case-insensitive keyword matching. Default is B<0>, +i.e. the keywords are case-sensitive. + +=item B<locations> => B<0> | B<1> + +Controls the I<locations> mode. When locations mode is enabled. the +resulting object will store, along with each configuration setting, the +location in the source file where it was set. + +=item B<parameters> => \%hash + +Defines the syntax table. See below for a description of B<%hash>. + +=item B<cachefile> => I<FILENAME> + +Sets the location of the cache file. If passed, the parsed configuration +will be stored in binary form in the I<FILENAME>. Before parsing the +configuration file, the constructor will chech if the cache file exists and +has the same timestamp as the configuration file. If so, the configuration +will be loaded from the cache (using B<Storable>(3)), avoiding parsing +overhead. Otherwise, the cached data will be discarded, and the source file +will be parsed as usual. + +The destructor will first check if the configuration was updated, and if +so will recreate the cache file prior to destructing the object instance. + +=item B<rw> => B<0> | B<1> + +Whether or not the configuration is read-write. This setting is in effect +only if B<cachefile> is also set. + +If set to B<0> (the default) any local changes to the configuration (using +B<set> and B<unset> methods), will not be saved to the cache file upon +exiting. Otherwise, the eventual modifications will be stored in the cache. + +=back + +=head3 Syntax hash + +The hash passed via the B<parameters> keyword defines the keywords and +sections allowed within a configuration file. In a simplest case, a +keyword is described as + + name => 1 + +This means that B<name> is a valid keyword, but does not imply anything +more about it or its value. A most complex declaration is possible, in +which the value is a hash reference, containing on or more of the following +keywords: + +=over 4 + +=item mandatory => 0 | 1 + +Whether or not this setting is mandatory. + +=item array => 0 | 1 + +If B<1>, the value of the setting is an array. Each subsequent occurrence +of the statement appends its value to the end of the array. + +=item re => I<regexp> + +Defines a regular expression to which must be matched by the value of the +setting, otherwise a syntax error will be reported. + +=item check => I<coderef> + +Defines a code which will be called after parsing the statement in order to +verify its value. The I<coderef> is called as + + $err = &{$coderef}($valref, $prev_value) + +where B<$valref> is a reference to its value, and B<$prev_value> is the value +of the previous instance of this setting. The function must return B<undef> +if the value is OK for that setting. In that case, it is allowed to modify +the value, referenced by B<$varlref>. If the value is erroneous, the function +must return a textual error message, which will be printed using B<$cfg->error>. + +=back + +To define a section, use the B<section> keyword, e.g.: + + core => { + section => { + pidfile => { + mandatory => 1 + }, + verbose => { + re => qr/^(?:on|off)/i + } + } + } + +This says that a section B<[core]> can have two variables: B<pidfile>, which +is mandatory, and B<verbose>, whose value must be B<on>, or B<off> (case- +insensitive). + +To allow for arbitrary keywords, use B<*>. For example, the following +declares the B<[code]> section, which must have the B<pidfile> setting +and is allowed to have any other settings as well. + + code => { + section => { + pidfile => { mandatory => 1 }, + '*' => 1 + } + } + +=cut sub new { my $class = shift; @@ -106,6 +238,42 @@ sub DESTROY { $self->writecache(); } +=head2 $cfg->error($message) + +=head2 $cfg->error($message, locus => $loc) + +Prints the B<$message> on STDERR. If <locus> is given, its value must +be a reference to a valid B<App::Beam::Config::Locus>(3) object. In that +case, the object will be formatted first, then followed by a ": " and the +B<$message>. + +=cut + +sub error { + my $self = shift; + my $err = shift; + local %_ = @_; + $err = $_{locus}->format($err) if exists $_{locus}; + print STDERR "$err\n"; +} + +=head2 $cfg->debug($lev, @msg) + +If B<$lev> is greater than or equal to the B<debug> value used when +creating B<$cfg>, outputs on standard error the strings from @msg, +separating them with a single space character. + +Otherwise, does nothing. + +=cut + +sub debug { + my $self = shift; + my $lev = shift; + return unless $self->{debug} >= $lev; + $self->error("DEBUG: " . join(' ', @_)); +} + sub writecache { my $self = shift; return unless exists $self->{cachefile}; @@ -374,6 +542,14 @@ sub file_up_to_date { return $st_conf->mtime <= $st_file->mtime; } +=head2 $cfg->parse() + +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>. + +=cut + sub parse { my ($self) = @_; my %conf; @@ -403,7 +579,7 @@ sub parse { } return !$err; } - + sub getref { my $self = shift; @@ -416,15 +592,76 @@ sub getref { return $ref; } -# 1. get('foo', 'bar', 'baz') -# Returns the value of the variable foo.bar.baz -# 2. get({ variable => [ 'foo', 'bar', 'baz' ], return => 'value' }) -# Ditto. -# 3. get({ variable => [ 'foo', 'bar', 'baz' ], return => 'locus' }) -# Returns location of the foo.bar.baz definition. -# 4. get({ variable => [ 'foo', 'bar', 'baz' ], return => 'all' }) -# or get({ variable => [ 'foo', 'bar', 'baz' ] }) -# Returns both as { value => X, locus => Y } +=head2 $var = $cfg->get(@path); + +Returns the value of the configuration variable represented by its +I<path>, or B<undef> if the variable is not set. The path is a list +of configuration variables leading to the value in question. For example, +the following statement: + + pidfile = /var/run/x.pid + +has the path + + ( 'pidfile' ) + +The path of the B<pidfile> statement in section B<core>, e.g.: + + [core] + pidfile = /var/run/x.pid + +is + + ( 'core', 'pidfile' ) + +Similarly, the path of the B<file> setting in the following configuration +file: + + [item foo] + file = bar + +is + ( 'item', 'foo', 'bar' ) + +=head2 $ret = $cfg->get({ variable => $pathref, return => all | value | locus }) + +I<$pathref> is a reference to the configuration setting path as described +above. This invocation is similar to B<get(@{$pathref})>, except that +it returns additional data as controlled by the B<return> keyword. The +valid values for the B<return> are: + +=over 4 + +=item 'value' + +Returns the value of the variable. The call + + $cfg->get({ variable => \@path, return => 'value' }) + +is completely equivalent to + + $cfg->get(@path); + +=item 'locus' + +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 '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. + +=back + +If the B<return> key is absent, the result is the same as for +return => 'all'. + +=cut + sub get { my $self = shift; croak "no variable to get" unless @_; @@ -455,6 +692,13 @@ sub get { return $ref; } +=head2 $cfg->isset(@path) + +Returns true if the configuration variable addressed by B<@path> is +set. + +=cut + sub isset { my $self = shift; return defined $self->getref(@_); @@ -466,18 +710,38 @@ sub is_section_ref { && !exists($ref->{-value}); } +=head2 $cfg->issection(@path) + +Returns true if the configuration section addressed by B<@path> is +set. + +=cut + sub issection { my $self = shift; my $ref = $self->getref(@_); return defined($ref) && is_section_ref($ref); } -sub isscalar { +=head2 $cfg->isvariable(@path) + +Returns true if the configuration variable addressed by B<@path> is +set. + +=cut + +sub isvariable { my $self = shift; my $ref = $self->getref(@_); return defined($ref) && !is_section_ref($ref); } - + +=head2 $cfg->set(@path, $value) + +Sets the configuration variable B<@path> to B<$value>. + +=cut + sub set { my $self = shift; $self->{conf} = {} unless exists $self->{conf}; @@ -496,6 +760,12 @@ sub set { $self->{updated} = $self->{rw}; } +=head2 cfg->unset(@path) + +Unsets the configuration variable. + +=cut + sub unset { my $self = shift; return unless exists $self->{conf}; @@ -516,6 +786,29 @@ sub unset { $self->{updated} = $self->{rw}; } +=head2 @array = $cfg->names_of(@path) + +If B<@path> refers to an existing configuration section, returns a list +of names of variables and subsections defined within that section. E.g., +if you have + + [item foo] + x = 1 + [item bar] + x = 1 + [item baz] + y = 2 + +the call + + $cfg->names_of('item') + +will return + + ( 'foo', 'bar', 'baz' ) + +=cut + sub names_of { my $self = shift; my $ref = $self->getref(@_); @@ -547,6 +840,23 @@ sub _foreach { } } +=head2 $cfg->foreach($callback, %opts) + +For each configuration settings calls + + &{$callback}($keyword, $value, @path) + +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)>). + +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. + +=cut + sub foreach { my $self = shift; my $cb = shift; @@ -572,6 +882,26 @@ sub foreach { $self->_foreach([], $self->{conf}, $cb, $sort); } +=head2 @array = $cfg->flatten() + +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 + + pidfile = /var/run/x.pid + [item foo] + name = bar + [item foo bar] + lock = On + +is represented as: + + ('item.foo.name', 'bar') + ('item.foo.bar.lock', 'On') + +=cut + sub flatten { my $self = shift; my @dump; |