aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/App/Beam/Config.pm380
-rw-r--r--t/conf02.t2
-rw-r--r--t/conf02l.t2
3 files changed, 357 insertions, 27 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;
diff --git a/t/conf02.t b/t/conf02.t
index 9447060..55e7b86 100644
--- a/t/conf02.t
+++ b/t/conf02.t
@@ -23,7 +23,7 @@ my %keywords = (
my $cfg = new TestConfig(parameters => \%keywords);
ok($cfg->isset('backend','foo','file'));
-ok($cfg->isscalar('backend','foo','file'));
+ok($cfg->isvariable('backend','foo','file'));
ok($cfg->get('backend','foo','file'), 'foo');
ok($cfg->isset('core', 'verbose') == 0);
diff --git a/t/conf02l.t b/t/conf02l.t
index c57b0ae..da4920a 100644
--- a/t/conf02l.t
+++ b/t/conf02l.t
@@ -23,7 +23,7 @@ my %keywords = (
my $cfg = new TestConfig(parameters => \%keywords, locations => 1);
ok($cfg->isset('backend','foo','file'));
-ok($cfg->isscalar('backend','foo','file'));
+ok($cfg->isvariable('backend','foo','file'));
ok($cfg->get('backend','foo','file'), 'foo');
ok($cfg->isset('core', 'verbose') == 0);

Return to:

Send suggestions and report system problems to the System administrator.