package Rose::Conf::FileBased;
use strict;
use Carp();
use File::Spec;
use Rose::Conf;
require Tie::Hash;
our @ISA = qw(Rose::Conf Tie::StdHash);
our($CONF_ROOT, %Refresh_Time, $APACHE_CONF_PATH);
our $REFRESH_TIMEOUT = 60 * 15; # in seconds
our $CONF_SUFFIX = '.conf';
our $LOCAL_CONF_FILE = 'local' . $CONF_SUFFIX;
use constant PRIVATE_PREFIX => '__' . __PACKAGE__ . '::';
our $VERSION = '0.02';
our $Debug = 0;
sub import
{
my($class) = shift;
local $Rose::Conf::ExportLevel;
$Rose::Conf::ExportLevel++;
$class->Rose::Conf::import(@_) if(@_);
my $conf = $class->conf_hash;
my %save = %$conf;
tie(%$conf, $class);
%$conf = %save;
}
sub refresh
{
my($class) = shift;
#return if(time < $Refresh_Time{$class} + $class->refresh_timeout);
$class->_get_conf_root();
if($CONF_ROOT && -d $CONF_ROOT)
{
#$Refresh_Time{$class} ||= 0;
# Local conf file
my $local_conf = File::Spec->catfile($CONF_ROOT, $LOCAL_CONF_FILE);
if(-s $local_conf)
{
$class->_read_combined_conf($local_conf);
}
# Package-specific conf file
my $class_conf = File::Spec->catfile($CONF_ROOT, $class . $CONF_SUFFIX);
if(-s $class_conf)
{
$class->_read_class_conf($class_conf);
}
else
{
my $mod_class = $class;
$mod_class =~ s/::/-/g;
$class_conf = $CONF_ROOT . '/' . $mod_class . $CONF_SUFFIX;
if(-s $class_conf)
{
$class->_read_class_conf($class_conf);
}
}
}
}
sub FETCH
{
my($hash, $key) = @_;
unless(exists $hash->{PRIVATE_PREFIX . 'IMPORTED'} ||
exists $hash->{PRIVATE_PREFIX . 'IMPORTING'})
{
$Debug && warn "FETCH $hash { $key }\n";
$hash->{PRIVATE_PREFIX . 'IMPORTING'} = 1;
my $class = ref($hash);
$class->refresh();
delete $hash->{PRIVATE_PREFIX . 'IMPORTING'};
$hash->{PRIVATE_PREFIX . 'IMPORTED'}++;
}
##
## This is broken for now...
##
# Do not try refresh when looking up private keys
# unless(index($key, PRIVATE_PREFIX) == 0)
# {
# my $class = ref $hash;
#
# if(my $timeout = $class->refresh_timeout)
# {
# $Refresh_Time{$class} ||= 0;
#
# if(time > $Refresh_Time{$class} + $timeout)
# {
# $class->refresh;
# }
# }
# }
Carp::croak "No such conf parameter: '$key'\n"
unless(index($key, PRIVATE_PREFIX) == 0 || exists $hash->{$key});
return $hash->{$key};
}
sub _get_conf_root
{
$CONF_ROOT = $ENV{'ROSE_CONF_FILE_ROOT'};
if(!$CONF_ROOT && exists $ENV{'MOD_PERL'} && require mod_perl && $mod_perl::VERSION < 1.99)
{
$CONF_ROOT = Apache->server_root_relative($APACHE_CONF_PATH);
$CONF_ROOT = undef unless(-d $CONF_ROOT);
}
}
sub refresh_timeout
{
my($class) = shift;
no strict 'refs';
if(@_)
{
return ${$class . '::REFRESH_TIMEOUT'} = shift;
}
my $timeout = ${$class . '::REFRESH_TIMEOUT'};
$timeout = $REFRESH_TIMEOUT unless(defined $timeout);
return $timeout;
}
sub _parse_line
{
my($class, $conf, $line, $file, $line_num) = @_;
return unless($line =~ /\S/);
my($key, $val);
if($line =~ /^((?:[^\\ \t]+|\\.)+)\s*=\s*(\S.*|$)/)
{
$key = $1;
$val = $2;
}
elsif($line !~ /^(#|$)/)
{
die "Syntax error in $file on line $line_num: $line\n";
}
else { return }
if(length($key) && length($val))
{
if($val =~ s/(['"])(.*)\1$/$2/)
{
if($1 eq '"' && index($val, '\\') >= 0)
{
$val = eval qq("$val");
if($@)
{
die qq(Invalid value "$val" in $file on line $line_num: $@\n);
}
}
}
# Hash sub-key access
if($key =~ m/^(?:[^\\: \t]+|\\.)+:/)
{
my $original_key = $key;
if($key =~ /^(?:[^\\: \t]+|\\.)+:$/)
{
Carp::croak qq($class - Invalid hash sub-key access: "$key", ),
qq(missing key name after final ':' in $file line $line_num);
}
my @parts;
my $param = $conf;
my $prev_param;
while($key =~ m/\G((?:[^\\: \t]+|\\.)+)(?::|$)/g)
{
$prev_param = $param;
$param = $param->{$1} ||= {};
push(@parts, $1);
$parts[-1] =~ s{\\(.)}{$1}g;
}
$Debug && warn "\$${class}::CONF{", join('}{', @parts), "} = $val\n";
$prev_param->{$parts[-1]} = $val;
$key = $original_key;
}
else
{
$key =~ s{\\(.)}{$1}g;
$Debug && warn "\$${class}::CONF{$key} = $val\n";
$conf->{$key} = $val;
$key =~ s{:}{\\:}g;
}
}
else
{
$Debug && warn "\$${class}::CONF{$key} = undef\n";
$conf->{$key} = undef;
$key =~ s{:}{\\:}g;
}
$conf->{PRIVATE_PREFIX . 'MODIFIED'}{$key} =
{
file => $file,
line_number => $line_num,
#time => time(),
};
}
sub _read_class_conf
{
my($class, $file) = @_;
unless(open(CONF, $file))
{
warn "Could not open $file: $!";
return;
}
#$Refresh_Time{$class} = time;
my $conf = $class->conf_hash;
while(<CONF>)
{
s/^\s+//;
s/\s+$//;
$class->_parse_line($conf, $_, $file, $.);
}
close(CONF);
}
sub _read_combined_conf
{
my($class, $file) = @_;
my $conf_fh;
unless(open($conf_fh, $file))
{
warn "Could not open $file: $!";
return;
}
#$Refresh_Time{$class} = time;
my $conf = $class->conf_hash;
my $in_domain = 0;
my $in_domain_re = qr(^CLASS\s+$class$);
my $out_domain_re = qr(^CLASS\s*(?!=));
while(<$conf_fh>)
{
s/^\s+//;
s/\s+$//;
if(/$in_domain_re/)
{
$in_domain = 1;
next;
}
elsif($in_domain && /$out_domain_re/)
{
$in_domain = 0;
}
next unless($in_domain);
$class->_parse_line($conf, $_, $file, $.);
}
close($conf_fh);
}
sub local_conf_keys
{
my($class) = shift;
my $conf = $class->conf_hash;
return keys(%{$conf->{PRIVATE_PREFIX . 'MODIFIED'}});
}
sub local_conf_setting
{
my($class, $key) = @_;
Carp::croak "Cannot get setting without $key" unless(defined($key));
my $conf = $class->conf_hash;
return unless($conf->{PRIVATE_PREFIX . 'MODIFIED'}{$key});
return bless($conf->{PRIVATE_PREFIX . 'MODIFIED'}{$key}, 'Rose::Conf::File::Setting');
}
sub local_conf_value
{
my($class, $key) = @_;
Carp::croak "Cannot get setting without $key" unless(defined($key));
$class->local_conf_setting($key) || return undef;
if($key =~ m/^(?:[^\\: \t]+|\\.)+:/)
{
if($key =~ /^(?:[^\\: \t]+|\\.)+:$/)
{
Carp::croak qq($class - Invalid hash sub-key access: "$key" - missing key name after final ':');
}
my @parts;
my $param = $class->conf_hash;
my $prev_param;
while($key =~ m/\G((?:[^\\: \t]+|\\.)+)(?::|$)/g)
{
$prev_param = $param;
$param = $param->{$1} ||= {};
push(@parts, $1);
$parts[-1] =~ s{\\(.)}{$1}g;
}
$Debug && warn "Get local conf value for \$${class}::CONF{", join('}{', @parts), "}\n";
return $prev_param->{$parts[-1]};
}
$key =~ s{\\:}{:}g;
return $class->param($key);
}
BEGIN
{
$APACHE_CONF_PATH = 'conf/perl';
#_get_conf_root();
require Rose::Object;
@Rose::Conf::File::Setting::ISA = qw(Rose::Object);
}
1;
# =item B<refresh_timeout SECS>
#
# If an argument is provided, sets the class's refresh timeout to SECS
# seconds. Returns the class's current refresh timeout in seconds.
#
# The refresh timeout is used to determine when (if ever) to refresh the
# configuration hash by re-reading the (possibly changed) configuration
# file(s). The configuration file(s) will only be re-read if they have
# been modified since they were last read (as determined by the files'
# "mtime").
#
# If the refresh timeout is zero, the files are never re-read. The
# default refresh timeout is 15 minutes.
__END__
=head1 NAME
Rose::Conf::FileBased - File-based configuration module base class.
=head1 SYNOPSIS
# File: My/System/Conf.pm
package My::System::Conf;
use Rose::Conf::FileBased;
our @ISA = qw(Rose::Conf::FileBased);
our %CONF =
(
KEY1 => 'value1',
KEY2 => 'value2',
KEY3 =>
{
foo => 5,
bar => 6,
}
...
);
...
# File: My/System.pm
use My::System::Conf qw(%SYS_CONF); # import hash
...
# File: My/System/Foo.pm
use My::System::Conf; # do not import hash
...
# File: $ENV{'ROSE_CONF_FILE_ROOT'}/local.conf
CLASS My::System::Conf
KEY1 = "new value"
KEY2 = "new two"
KEY3:foo = 55
KEY3:bar = 66
...
# File: $ENV{'ROSE_CONF_FILE_ROOT'}/My::System::Conf.conf
KEY1 = "the final value"
KEY3:bar = 10
...
# File: somefile.pl
use My::System::Conf qw(%SYS_CONF);
print $SYS_CONF{'KEY1'}; # prints "the final value"
print $SYS_CONF{'KEY2'}; # prints "new two"
print $SYS_CONF{'KEY3'}{'foo'}; # prints "55"
print $SYS_CONF{'KEY3'}{'bar'}; # prints "10"
=head1 DESCRIPTION
C<Rose::Conf::FileBased> inherits from C<Rose::Conf> and provides the same
functionality, with the additional ability to read and incorporate text
configuration files which override the values hard-coded into the
configuration module.
Text configuration files must be located in the file-based configuration file
root ("conf root") directory. This directory is set as follows:
If the environment variable C<ROSE_CONF_FILE_ROOT> exists, it is used to set
the conf root. The C<Rose::Conf::Root> module is the recommended way to set
this environment variable from within Perl code. Setting the environment
variable directly using the C<%ENV> hash from within Perl code may become
unsupported at some point in the future.
If C<ROSE_CONF_FILE_ROOT> is not set and if running in a mod_perl 1.x
environment, the conf root is set to the "conf/perl" directory relative to the
web server's "server root" directory. That is:
Apache->server_root_relative('conf/perl')
If no conf root is defined, C<Rose::Conf::FileBased> behaves like C<Rose::Conf>,
except that trying to access a nonexistent parameter name through a hash alias
or reference to the conf hash results in a fatal error.
=head1 CONFIGURATION FILES
There are two types of configuration files: "combined" and "class-specific."
As described above, all configuration files must be stored in the "conf root"
directory. In cases of conflict, entries in a "class-specific" configuration
file override entries in a "combined" configuration file.
=head2 THE "COMBINED" CONFIGURATION FILE
The "combined" configuration file must be named "local.conf". This file name
is case sensitive. The format of the "local.conf" file is as follows:
CLASS Some::Package::Conf
KEY1 = "value1"
KEY2 = 'value2'
KEY3 = 5
# This is a comment
CLASS Some::Other::Package::Conf
KEY1 = "value1"
KEY2 = 'value2'
KEY3 = 5
The C<CLASS> directive sets the context for all the key/value pairs that
follow it. The C<KEY>s are keys in C<CLASS>'s C<%CONF> hash.
Values may optionally be enclosed in single or double quotes. Only simple
scalar values are supported at this time, and the values must be on one line.
If a value is in double quotes and contains a backslash character ("\"), then
it is C<eval()>ed as a string. Example:
# This value will contain an actual newline
KEY1 = "one\ntwo"
# These will both contain a literal backslash and an "n"
KEY2 = 'one\ntwo'
KEY2 = one\ntwo
Blank lines, lines that begin with the comment character "#", and leading and
trailing spaces are ignored.
If a parameter name contains a ":" character, it must be escaped with a
backslash:
CLASS My::Conf
# $My::Conf::CONF{'FOO:BAR'} = 5
FOO\:BAR = 5
Backslash characters in parameter names must be escaped as well:
CLASS My::Conf
# $My::Conf::CONF{'A\B'} = 10
A\\B = 10
Any other character in a parameter name also may be safely escaped with a
backslash:
CLASS My::Conf
# $My::Conf::CONF{'hello'} = 20
h\e\l\lo = 20
Unescaped ":" characters are used to address nested hashes:
CLASS My::Conf
# $My::Conf::CONF{'KEY'}{'subkey'} = 123
KEY:subkey = 123
Keys can be nested to an arbitrary depth using a series of ":" characters:
# $My::Conf::CONF{'A'}{'b'}{'c'}{'d'}{'e'} = 456
A:b:c:d:e = 456
In order to avoid conflicting with any future "special" characters like ":",
key names should contain only letters, numbers, and underscores. Any other
characters may take on special meaning in future versions of this module and
may therefore need to be backslash-escaped in configuration files like
"local.conf".
=head2 "CLASS-SPECIFIC" CONFIGURATION FILES
"Class-specific" configurations file must have a name equal to the
concatenation of the configuration package name and ".conf". For example, the
class-specific configuration file for the C<My::Class::Conf> package would be
"My::Class::Conf.conf". This file name is case sensitive.
If your operating system or volume format does not allow ":" characters in
file names, you can use "-" instead: "My-Class-Conf.conf"
The format of each class-specific configuration file is identical to that of
the "local.conf" file (described above) except that the CLASS declaration is
invalid.
=head1 COMPLEX VALUES
Lists, hashes, and other values that are not simple scalars may be supported
in the future. For now, if you need to include such values, it's a simple
matter to add code to "inflate" simple scalar values as necessary. Example:
# File: local.conf
CLASS My::Conf
# Scalar value will be expanded into an array ref later
NAMES = 'Tom,Dick,Harry'
...
# File: My/Conf.pm
package My::Conf;
use Rose::Conf::FileBased;
our @ISA = qw(Rose::Conf::FileBased);
our %CONF =
(
COLOR => 'blue',
NAMES => [ 'Sue', 'Joe', 'Pam' ],
);
# Override refresh method and auto-expand non-scalar values
# according to whatever format or convention we choose
sub refresh
{
shift->SUPER::refresh(@_);
# Expects a string of comma-separated values,
# then expands it into an array reference
$CONF{'NAMES'} = [ split(',', $CONF{'NAMES'}) ]
unless(ref $CONF{'NAMES'});
}
...
# Some other code somewhere...
use My::Conf;
$names = My::Conf->param('NAMES');
print join(' ', @$names); # 'Tom Dick Harry'
=head1 CLASS METHODS
Unless overridden below, all of C<Rose::Conf>'s class methods are inherited
by C<Rose::Conf::FileBased>.
=over 4
=item B<local_conf_keys>
Returns an unsorted list of configuration keys whose values have been set or
overridden by one or more configuration files. The keys are returned as they
would appear in a configuration file. That means they are escaped as
necessary, and nested hash keys use the ":"-separated syntax. See the
L<CONFIGURATION FILES> section for more information.
=item B<local_conf_value KEY>
Returns the value of the configuration setting KEY if and only if KEY's
value has been set or overridden by a configuration file. Returns false
otherwise.
The KEY argument must be provided in the same syntax as it would appear in a
configuration file. That means that literal ":" characters must be escaped,
and nested hash values must be addressed using the ":"-separated syntax. See
the L<CONFIGURATION FILES> section for more information.
=item B<refresh>
Refreshes the configuration values in the class by re-reading any
configuration files.
=back
=head1 AUTHOR
John C. Siracusa (siracusa@mindspring.com)
=head1 COPYRIGHT
Copyright (c) 2004 by John C. Siracusa. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same terms
as Perl itself.